home *** CD-ROM | disk | FTP | other *** search
- (***************************************
- * *
- * Grafikanimation für das Programm *
- * SCREENSV.PAS *
- * *
- *--------------------------------------*
- * (c) Borland International / M.Scholz *
- ***************************************)
-
- {$I COMPILER.INC}
- {$F+,O+}
-
- UNIT ARTY;
-
- INTERFACE
-
- uses crt,
- graph;
-
- procedure DoArt;
-
- IMPLEMENTATION
-
- type ColorList=array[1..4] of integer;
-
- var Line:array[1..100] of record
- LX1,LY1: integer;
- LX2,LY2: integer;
- LColor : ColorList;
- end;
- X1,X2,Y1,Y2,
- CurrentLine,
- ColorCount,
- IncrementCount,
- DeltaX1,DeltaY1,DeltaX2,DeltaY2:integer;
- i,MaxDelta:integer;
- Colors:ColorList;
- ChangeColors:boolean;
-
- procedure DoArt;
- var kb:char;
-
- procedure AdjustX(var X,DeltaX:integer);
- var TestX:integer;
- begin
- TestX:=X+DeltaX;
- if (TestX<1) or (TestX>640) then
- begin
- TestX:=X;
- DeltaX:=-DeltaX;
- end;
- X:=TestX;
- end;
-
- procedure AdjustY(var Y,DeltaY:integer);
- var TestY:integer;
- begin
- TestY:=Y+DeltaY;
- if (TestY<1) or (TestY>480) then
- begin
- TestY:=Y;
- DeltaY:=-DeltaY;
- end;
- Y:=TestY;
- end;
-
- procedure SelectNewColors;
- begin
- if not ChangeColors then Exit;
- Colors[1]:=Random(16)+1;
- Colors[2]:=Random(16)+1;
- Colors[3]:=Random(16)+1;
- Colors[4]:=Random(16)+1;
- ColorCount:=3*(1+Random(5));
- end;
-
- procedure SelectNewDeltaValues;
- begin
- DeltaX1 := Random(MaxDelta)-(MaxDelta Div 2);
- DeltaX2 := Random(MaxDelta)-(MaxDelta Div 2);
- DeltaY1 := Random(MaxDelta)-(MaxDelta Div 2);
- DeltaY2 := Random(MaxDelta)-(MaxDelta Div 2);
- IncrementCount := 2*(1+Random(4));
- end;
-
- procedure SaveCurrentLine(CurrentColors:ColorList);
- begin
- with Line[CurrentLine] do
- begin
- LX1:=X1; LY1:=Y1;
- LX2:=X2; LY2:=Y2;
- LColor:=CurrentColors;
- end;
- end;
-
- procedure Draw(x1,y1,x2,y2,color:word);
- begin
- SetColor(color);
- graph.line(x1,y1,x2,y2);
- end;
-
- procedure Updateline;
- begin
- Inc(CurrentLine);
- if CurrentLine>100 then CurrentLine:=1;
- Dec(ColorCount);
- Dec(IncrementCount);
- end;
-
- procedure DrawCurrentLine;
- var c1,c2,c3,c4:integer;
- begin
- c1:=Colors[1];
- c2:=Colors[2];
- c3:=Colors[3];
- c4:=Colors[4];
- Draw(X1,Y1,X2,Y2,c1);
- Draw(640-X1,Y1,640-X2,Y2,c2);
- Draw(X1,480-Y1,X2,480-Y2,c3);
- Draw(640-X1,480-Y1,640-X2,480-Y2,c4);
- SaveCurrentLine(Colors);
- end;
-
- procedure EraseCurrentLine;
- begin
- with Line[CurrentLine] do
- begin
- Draw(LX1,LY1,LX2,LY2,0);
- Draw(640-LX1,LY1,640-LX2,LY2,0);
- Draw(LX1,480-LY1,LX2,480-LY2,0);
- Draw(640-LX1,480-LY1,640-LX2,480-LY2,0);
- end;
- end;
-
- {-------------------}
-
- begin
- CurrentLine:=1; ColorCount:=0;
- IncrementCount:=0; ChangeColors:=true;
- MaxDelta:=16;
- for i := 1 to 100 do
- with Line[i] do
- begin
- LX1:=320; LX2:=320;
- LY1:=240; LY2:=240;
- end;
- X1:=320; X2:=320; Y1:=240; Y2:=240;
- ClearViewport;
- SelectNewColors;
- repeat
- EraseCurrentLine;
- if ColorCount=0 then SelectNewColors;
- if IncrementCount=0 then SelectNewDeltaValues;
- AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
- AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);
- if Random(5)=3 then
- begin
- x1:=(x1+x2) div 2;
- y2:=(y1+y2) div 2;
- end;
- DrawCurrentLine;
- Updateline;
- until keypressed;
- if keypressed then kb:=ReadKey;
- end;
-
-
- end.
-