Новые сообщения · Правила  
  • Страница 1 из 1
  • 1
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №12 (Анимация графики)
Лабораторная работа №12
Цель работы - научиться строить простейшие анимационные рисунки. Это задание творческое, без конкретных вариантов. Ваша задача - написать программу, которая выводит анимационное (меняющееся изображение). Чем оригинальнее и сложнее будет изображение - тем лучше. Есть только одно условие - анимация должна иметь отношение к математике или программированию. И еще - надо придумать, как вы здесь выложите вашу анимацию. За оригинальность могут быть бонусы :)
1 | Автор: admin | 2014-11-10, 22:20   |  Репутация: [ + 22 ]
5. Рисует синусоиду

Код
uses graphABC;
var
    X, Y, h: real;
begin
    h := 0.001;
    X := -Pi;
while X <= 4 * Pi do begin
     Y := -cos(X);
     PutPixel(trunc(round((X + pi) * 50)), trunc(round(Y * 50 + 200)), clBlue);
     X:=X+h;   
     sleep(1);
    end;
    SetPenColor(clBlack);
    SetPenWidth(2);
    {ось X}
    Line(trunc(round(pi * 50)), -WindowHeight, trunc(round(pi * 50)), WindowHeight);
    {ось Y}
    Line(-WindowWidth, 200, WindowWidth, 200);
end.



Selena
2 | Автор: Selena | 2014-11-17, 17:38 | Изменено: Selena - Пн, 2014-11-17, 17:43   |  Репутация: [ + 2 ]
Код

uses GraphABC;
var y0,x0,yt,xt,k: integer;
y,x: real;
begin
setWindowSize(800,300);
y0:=0; x0:=150; k:=30;
setPenColor(clgreen);
while y>=0 do
       begin
       if y<=0 then
       else
       setPenColor(clgreen);
       x:=tan(y);
       yt:=trunc(y0+y*k);
       xt:=trunc(x0-x*k);
       circle(yt,xt,1);
       x:=y+0.001;
        if y<=0 then
       else
       setPenColor(clblue);
       x:=sin(y);
       yt:=trunc(y0+y*k);
       xt:=trunc(x0-x*k);
       circle(yt,xt,1);
       y:=y+0.001;
        if y<=0 then
       else
       setPenColor(clred);
       x:=cos(y);
       yt:=trunc(y0+y*k);
       xt:=trunc(x0-x*k);
       circle(yt,xt,1);
       y:=y+0.001;
        
          if y<=0 then
       else
       setPenColor(clblack);
       x:=1/tan(y);
       yt:=trunc(y0+y*k);
       xt:=trunc(x0-x*k);
       circle(yt,xt,1);
       y:=y+0.001;
        
       end;
      
end.



AlenaKit♥
3 | Автор: AlenaKit | 2014-11-17, 19:55   |  Репутация: [ + 12 ]
Код
Program qwerty159;
uses GraphABC;
Var x,y,x1,x2,d,i: integer;
Begin
x:=30;
y:=150;
x1:=300;
x2:=500;
d:=100;
LockDrawing;
for i:=1 to x1-d do
// жёлтый шар движется, оранжевый стоит на месте
Begin
ClearWindow;
SetBrushColor(clYellow);
Ellipse(x+i,y,x+i+d,y+d);
SetBrushColor(clOrange);
Ellipse(x+x1,y,x+x1+d,y+d);
Redraw;
Sleep(1);
end;
for i:=x1 to x2 do
// жёлтый шар стоит на месте, оранжевый шар движется
Begin
ClearWindow;
SetBrushColor(clYellow);
Ellipse(x+x1-d,y,x+x1,y+d);
SetBrushColor(clOrange);
Ellipse(x+i,y,x+i+d,y+d);
Redraw;
Sleep(1);
end;
end.

$IMAGE1$

Добавлено (19.11.14, 22:17)
---------------------------------------------
$IMAGE1$

4 | Автор: @qwerty159 | 2014-11-19, 22:17   |  Репутация: [ + 0 ]
5 | Автор: @qwerty159 | 2014-11-19, 22:25   |  Репутация: [ + 0 ]
Код
Program ira_butenko97;
Uses GraphABC;
var i:integer;
Begin
LockDrawing;
For i:=1 to 1000 do
begin
ClearWindow;

SetBrushColor(clwhite);
TextOut(300-i,55,'12');
TextOut(10+i,185,'134');
TextOut(300,370+i,'6');
TextOut(100,405-i,'110');

SetBrushColor(clblue);
Circle (50+i,100,50);
SetBrushColor(clblack);
Circle (50,100+i,50);
SetBrushColor(clred);
Circle (300+i,200,90);
SetBrushColor(clgreen);
Circle (100+i,400,30);
SetBrushColor(clOrange);
Rectangle (100-i,100,330-i,200);
SetBrushColor(clpink);
Rectangle (400-i,250,300-i,350);
SetBrushColor(clyellow);
Circle (400,100+i,50);

SetBrushColor(clwhite);
TextOut(100,450-i,'МАТЕМАТИКА - ЭТО ВЕСЕЛО!!!');
RedRaw;
end;
End.

6 | Автор: ira_butenko97 | 2014-11-19, 23:13   |  Репутация: [ + 4 ]

Код
Uses Crt, Graph;
Var
GrDriver, GrMode: Integer;
   BEGIN
GrDriver := Detect;
InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
SetColor(red);
Rectangle(150, 150, 460, 370);
Randomize;
Repeat
SetFillStyle(Random(4), Random(16));
Bar(160, 160, 450, 360);
delay(random(1000));
until KeyPressed;
CloseGraph; ReadLn;
END.
7 | Автор: Forzorezor | 2014-11-20, 00:10 | Изменено: Forzorezor - Чт, 2014-11-20, 00:11   |  Репутация: [ + 4 ]
6.

Код
Uses GraphABC;
var a,b:integer;
Begin
LockDrawing;
SetWindowSize (1000,500);
while b<=250 do
while a<=2000 do
begin
Window.Clear;
Brush.Color:=clBlue;
Circle (50+a,250,50+b);
RedRaw;
b:=b+1;
a:=a+5;
end;
End.



El_Magnifico with <3
8 | Автор: El_MAgnifico | 2014-11-20, 19:04   |  Репутация: [ + 8 ]


El_Magnifico with <3
8 | Автор: El_MAgnifico | 2014-11-20, 19:04   |  Репутация: [ + 8 ]
Код
program torres;
uses graphabc;
var x,y,x1,y1,i: integer;
     k: real;
begin
SetWindowSize(600,400);
lockdrawing;
setPenWidth(6);
     x:=300;
     y:=200;
for i:=1 to 1000 do
     begin
     clearwindow;
     k:=-0.01*i;
     x1:=x+Round(50*cos(k)-50*sin(k));
     y1:=y+Round(50*sin(k)+50*cos(k));
     line(x,y,x1,y1);
     Sleep(10);
     redraw;
     end;
end.

9 | Автор: torres | 2014-11-20, 21:56   |  Репутация: [ + 0 ]
График ф-ции $$\rho = a*\sin (n*\varphi )$$ $$0\leq \varphi \leq 2*\pi$$  в полярной системе координат.
Код
program dimeshion;
uses graphABC;
var a,r,f:real;
     n,x0,y0,x,y:integer;
begin
a:=200;
n:=6;
x0:=windowwidth div 2;
y0:=windowheight div 2;
line(0,y0,windowwidth,y0);
line(x0,0,x0,windowheight);
f:=0;
while f<=2*pi do
  begin
   r:=a*sin(n*f);
   x:=x0+round(r*cos(f));
   y:=y0-round(r*sin(f));
   setpixel(x,y,clblue);
   f:=f+0.001;
   sleep(1);
  end;
end.

10 | Автор: dimeshion | 2014-11-21, 00:22 | Изменено: dimeshion - Пт, 2014-11-21, 00:23   |  Репутация: [ + 2 ]
Код
uses crt, GraphABC;
var a1,b1,а,b,r1,r2,n,k: integer;
begin
HideCursor;
SetWindowSize(550,550);
write('R1=');
readln(r1);
write('R2=');
readln(r2);
lockdrawing;
a1:=260; b1:=260; n:=0;
for k:=1 to 1000 do
begin
ClearWindow;
SetPenWidth(4);
Setbrushcolor(clblue);
Circle(a1,b1,r1);
n:=n+1;
a:=a1+Round(r1*sin(Pi*n/180));
b:=b1-Round(r1*cos(Pi*n/180));
SetPenWidth(2);
SetBrushColor(clyellow);
Circle(a,b,r2);
Sleep(10);
Redraw;
end;
end.

11 | Автор: Awesome | 2014-11-21, 18:59 | Изменено: Awesome - Пт, 2014-11-21, 19:00   |  Репутация: [ + 2 ]
11 | Автор: Awesome | 2014-11-21, 18:59 | Изменено: Awesome - Пт, 2014-11-21, 19:00   |  Репутация: [ + 2 ]

Код
program Mr_pozitiv;
      //('*****************************************************');
      //('*       laba #12  file: laba12.pas == ver.1.0       *');
      //('*                     exercise                      *');
      //('*   Malevanny V. A.  Group I-14-1 Date:22/11/14     *');
      //('*****************************************************');
uses graphAbc;
var x0,y0,o :integer;
procedure pion; //открываем
      var i :integer;
      begin
         for i:=0 to 70 do
         begin
            clearWindow;
            SetBrushColor(clGainsboro);
             rectangle (x0-170-i,y0+140,x0-i,y0+240);
             rectangle (x0+170+i,y0+140,x0+i,y0+240);
             redRaw;
          end;
      end;
procedure visp; //закрываем
      var i :integer;
      begin
         for i:=0 to 70 do
         begin
            clearWindow;
            SetBrushColor(clGainsboro);
              rectangle (x0-240+i,y0+140,x0-70+i,y0+240);
              rectangle (x0+240-i,y0+140,x0+70-i,y0+240);
              redRaw;
           end;
       end;
procedure lisk; //круг
      var i :integer;
      begin
         for i:=0 to 500 do
         begin
            clearWindow;
            SetBrushColor(clGainsboro);
            rectangle (x0-240,y0+140,x0-70,y0+240);
             rectangle (x0+240,y0+140,x0+70,y0+240);
            SetBrushColor(clIndigo);
              Ellipse(x0-50,y0-50+i,x0+50,y0+50+i);
              redRaw;
           end;
       end;
    begin
      x0 := WindowWidth div 2;
      y0 := WindowHeight div 2;
      repeat //продолжаем до бесконечности
         o:=0;
          pion;
          lisk;
          visp;
       until o=1;
    end.


perfect ;)
12 | Автор: Mr_Pozitiv | 2014-11-22, 23:28 | Изменено: Mr_Pozitiv - Сб, 2014-11-22, 23:29   |  Репутация: [ + 6 ]

Код
uses graphabc;
var i: integer;
begin
Randomize;
Lockdrawing;
For i:=1 to 600 do begin
clearwindow;
circle( i+130, 200, 23);                           //колеса
circle( i+200, 200, 23);
circle( i+270, 200, 23);
rectangle (i+100, 200, i+300,100);                //Корпус
rectangle( i+265,40, i+250,70);
rectangle( i+300, 70, i+250,200);
circle( i+200, 15+random(5), 8+random(5));        //Начало дыма
circle( i+220, 25+random(5), 8+random(5));
circle( i+240, 35+random(5), 8+random(5));
sleep(40);
redraw;
end;
end.


13 | Автор: Bun_Frith | 2014-11-23, 14:24   |  Репутация: [ + 4 ]
Код
uses crt,Graphabc;
var s:string;
     n,x,y:integer;
begin
clrscr;
s:='**********************для программиста монитор-это реальный рабочий стол,а клавиатура обеденный************';
n:=length(s);
Textbackground(9);
Textcolor(14);
repeat
x:=-1;
y:=20;
while (x<80)and not keypressed do
  begin
   x:=x+3;
   y:=y-1;
   gotoXY(x,y);
   write(s);
   gotoXY(60,40);
   delay(650);
   clrscr;
  end;
until keypressed;
readln
end.



25101996
14 | Автор: OlgaFrolova | 2014-11-23, 16:39   |  Репутация: [ + 0 ]
2. С помощью 3-х окружностей стоятся 3 синусоиды, которые образуют интересную картину


Код
uses GraphABC;
var y0,t0,y1,t1,k,u: integer; y,t,i: real;
begin
lockdrawing;
setWindowSize(640,400);
y0:=0; t0:=200; k:=65;
lockdrawing;
for u:=1 to 12 do
       begin
        while y<=10 do
         begin
                
           t:=sin(y+i);
           y1:=trunc(y0+y*k);
           t1:=trunc(t0-t*k);
           setPenColor(clred);
           circle(y1,t1,6);
           setPenColor(clyellow);
           circle(y1,t1,5);
           setPenColor(clBlue);
           circle(y1+10,t1+10,5);           
           y:=y+0.02;
           sleep(1);
           redraw;
         end;
y:=0; i:=i+0.5;
end;
end.

Результат работы программы:

  
15 | Автор: beznoschenko | 2014-11-24, 15:58 | Изменено: beznoschenko - Пн, 2014-11-24, 16:19   |  Репутация: [ + 2 ]
15 | Автор: beznoschenko | 2014-11-24, 15:58 | Изменено: beznoschenko - Пн, 2014-11-24, 16:19   |  Репутация: [ + 2 ]
Код
Program ProjectX;
uses GraphABC;
var k:integer;
begin
           LockDrawing;
           For k:=1 to 1000 do
           begin
            Window.Clear;
            SetBrushColor(clgreen);
             TextOut(150,500-k,'Programming is cool');
             SetBrushColor(clwhite);
             TextOut(50,70+k,'We are a programmers!!!');
             RedRaw;
             Brush.Color := clyellow;
             Ellipse(k,150,k+150,300);
             RedRaw;
             Sleep(3);
             RedRaw;
           end;
end.


Добавлено (26.11.14, 21:55)
---------------------------------------------
16 | Автор: stx | 2014-11-26, 21:55 | Изменено: stx - Ср, 2014-11-26, 22:06   |  Репутация: [ + 2 ]
Код
program Iren456
{***********************************}
{* laba#12 file iren456.pas==ver1.0 *}
{* Zaznoba Irina I-14-1 27.11.14   *}
{***********************************};
uses GraphABC;
var x,y,ugol,i:integer;
begin
       x:=100;
       y:=100;
       ugol:=30;
       LockDrawing;
       for i:=1 to 50 do
       begin
         Window.Clear;
         x:=x+round(sin(ugol*pi/920));
         y:=y+round(cos(ugol*pi/820));
sleep(100);
         Circle(x,y,20);
         circle(x+24,y+24,10);
         circle(x,y+37,10);
         circle(x-24,y+24,10);
         Circle(2*x,y,20);      
        circle(2*x+24,y+24,10);
         circle(2*x,y+37,10);      
        circle(2*x-24,y+24,10);
         TextOut(300,175,'Уйдём,исчезнем без следа,');
         TextOut(300,200,'Уйдём,исчезнем-не беда:');
         TextOut(300,225,'Мир сохранится в том же виде,');
         TextOut(300,250,'В каком и был,и есть-всегда!');
         TextOut(400,275,'Омар Хайям');
         Redraw;
       end;
end.


Ирина Зазноба
17 | Автор: iren456 | 2014-11-27, 19:31 | Изменено: iren456 - Чт, 2014-11-27, 20:58   |  Репутация: [ + 0 ]
Код
uses graphABC;
var a:integer;
       begin
        lockdrawing;
        setwindowsize(600,500);
        clearwindow(clBlack);
        setbrushcolor(clWhite);
         while a<=600 do
          begin
          circle(300,250,1+a);
         redraw;
         a:=a+3;
         end;
        end.


$IMAGE1$
18 | Автор: Бонясик | 2014-11-29, 13:56 | Изменено: Бонясик - Сб, 2014-11-29, 21:10   |  Репутация: [ + 0 ]
Код
uses graphABC;
var xx, i: integer;
         
procedure Parovoz(x: integer);
begin
          //поезд +
         
           line(x+400,300,x+361,329);
           line(x+361,329,x+400,329);
            lineto(x+400,300);
           floodfill(x+399,303,clSilver);  // цвет ковша поезда
         
          line(x+490,240,x+470,260);
          line(x+490,240,x+510,260);
          line(x+510,260,x+470,260);
           floodfill(x+486,245,clSilver);
         
             setbrushcolor(clSilver);
              rectangle(x+470,260,x+510,310);
              Rectangle(x+400,330, x+540, 300);
              rectangle(x+525,300,x+535,250);
              rectangle(x+420,290,x+440,301);
         
               setbrushcolor(clwhite);
               circle(x+430,340,10);      //колеса
                 circle(x+490,340,10);    //колеса
                 line(x+430,340,x+490,340);
                 rectangle(x+480,270,x+500,301);
     //дым
     setbrushcolor(clgray);
     circle(x+540+random(5),220+random(5),10+random(5));
     circle(x+565+random(5),210+random(5),20+random(5));
     circle(x+590+random(5),200+random(5),20+random(5));
     circle(x+615+random(5),190+random(5),10+random(5));
end;
         
procedure Obl (x,y: integer);
begin
// verh
setbrushcolor(clblue);
circle(x+25+random(5),y+random(5),15 +random(5));
circle(x+52+random(5),y+random(5),19 +random(5));
circle(x+80+random(5),y+random(5),15 +random(5));
end;
         
procedure Fon;
begin
           //рельсы +
        line(0,350,640,350);  //верхняя линия
        line(0,360,640,360);//нижняя линия
        lineto(640,350);                       //палочка по бокам рельс
        floodfill(351,359,clbrown);
          //рельсы -
setbrushcolor(clyellow);
circle(520,70,25);
end;
         
begin
xx:=500;
lockdrawing;
while true do
          begin
          clearwindow(clSkyBlue);
          Fon;
          Parovoz(xx);
          for i:=1 to 3 do
              Obl (i*100-50,i*50);
          xx:=xx-5;
          sleep(10);
          redraw;
          if xx<-700 then xx:=500;
          end;
end.


kiriko
19 | Автор: Vincent_Young | 2014-11-30, 18:16 | Изменено: Vincent_Young - Вс, 2014-11-30, 18:21   |  Репутация: [ + 0 ]
Форум ПРОГРАММИСТОВ » КУРС ОПР - ПАСКАЛЬ » Лабораторные работы » Лабораторная работа №12 (Анимация графики)
  • Страница 1 из 1
  • 1
Поиск: