| 
				
				Лабораторная работа №12
				 | 
 | 
| 
 Цель работы - научиться строить простейшие анимационные рисунки. Это задание творческое, без конкретных вариантов. Ваша задача - написать программу, которая выводит анимационное (меняющееся изображение). Чем оригинальнее и сложнее будет изображение - тем лучше. Есть только одно условие - анимация должна иметь отношение к математике или программированию. И еще - надо придумать, как вы здесь выложите вашу анимацию. За оригинальность могут быть бонусы :) 
 
 |  
| 
 | 
  
 | 
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♥
 
 |  
| 
 | 
  
 | 
Код 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$ 
 
 |  
| 
 | 
  
 | 
| 
 | 
Код 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.      
 
 |  
| 
 | 
  
 | 
Код 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
 
 |  
| 
 | 
  
 
 | 
Код 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.      
 
 |  
| 
 | 
  
 | 
График ф-ции $$\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.   
    
 
 |  
| 
 | 
  
 | 
Код 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
 
 |  
| 
 | 
  
 | 
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 ] 
  
 |  
| 
 | 
  
 |