home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG08.ZIP / SCRLLX03.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-30  |  2.2 KB  |  105 lines
  1. Program Prllx03;
  2.  
  3. Uses Mode13h,Crt;
  4.  
  5. Var Xcloud1,Width1:Integer;
  6.     Xcloud2,Width2:Integer;
  7.  
  8. Var Xland,Width:Integer;
  9.  
  10. Procedure ScrollUpLand;
  11. Begin
  12.      WaitVbl;
  13.      Move(Mem[Vp[2]:320],Mem[Vp[2]:0],63680);
  14.  
  15.      Line(0,199,319,199,2,Vp[2]);
  16.  
  17.      Line(Xland,199,Xland+Width,199,1,Vp[2]);
  18.      Xland:=Xland+Random(5)-2;
  19.      If Xland<0 Then Xland:=0;
  20.      If Xland>319 Then Xland:=319;
  21.      Width:=Width+Random(5)-2;
  22.      If Width+Xland>319 Then Width:=319-Xland;
  23. End;
  24.  
  25. Procedure ScrollUpClouds;
  26. Begin
  27.      Move(Mem[Vp[1]:320],Mem[Vp[1]:0],63680);
  28.  
  29.      Line(0,199,319,199,0,Vp[1]);
  30.  
  31.      { Cloud number one }
  32.      Line(Xcloud1,199,Xcloud1+Width1,199,3,Vp[1]);
  33.      Xcloud1:=Xcloud1+Random(5)-2;
  34.      If Xcloud1<0 Then Xcloud1:=0;
  35.      If Xcloud1>319 Then Xcloud1:=319;
  36.      Width1:=Width1+Random(5)-2;
  37.      If Width1+Xcloud1>319 Then Width1:=319-Xcloud1;
  38.      { Cloud number two }
  39.      Line(Xcloud2,199,Xcloud2+Width2,199,3,Vp[1]);
  40.      Xcloud2:=Xcloud2+Random(5)-2;
  41.      If Xcloud2<0 Then Xcloud2:=0;
  42.      If Xcloud2>319 Then Xcloud2:=319;
  43.      Width2:=Width2+Random(5)-2;
  44.      If Width2+Xcloud2>319 Then Width2:=319-Xcloud2;
  45. End;
  46.  
  47. Procedure GlobalInit;
  48. Begin
  49.      Randomize;
  50.      Initgraph;
  51.      InitVirt;
  52. End;
  53.  
  54. Procedure GlobalClose;
  55. Begin
  56.      Closegraph;
  57.      Closevirt;
  58. End;
  59.  
  60. Procedure CloudInit;
  61. Begin
  62.      SetColor(0,0,0,0);
  63.      SetColor(3,55,55,55);
  64.      Width1:=50; Width2:=50;
  65.      Xcloud1:=50; Xcloud2:=250;
  66.      Cls(0,Vp[1]);
  67. End;
  68.  
  69. Procedure LandInit;
  70. Begin
  71.      SetColor(0,0,0,0);
  72.      SetColor(1,0,50,0);
  73.      SetColor(2,0,25,63);
  74.      Width:=150;
  75.      Xland:=50;
  76.      Cls(0,Vp[2]);
  77. End;
  78.  
  79. Procedure CopyPage_T(From,Too:Word);
  80. Var Offs:Word;
  81. Begin
  82.      For Offs:=0 To 63999 Do
  83.        If Mem[From:Offs]<>0 Then Mem[Too:Offs]:=Mem[From:Offs];
  84. End;
  85.  
  86. Begin
  87.      GlobalInit;
  88.      CloudInit;
  89.      LandInit;
  90.  
  91.      Repeat
  92.            ScrollUpLand;
  93.            CopyPage(Vp[2],Vp[3]);
  94.            ScrollUpClouds;
  95.            CopyPage_T(Vp[1],Vp[3]);
  96.            CopyPage(Vp[3],Vga);
  97.            CopyPage(Vp[2],Vp[3]);
  98.            ScrollUpClouds;
  99.            CopyPage_T(Vp[1],Vp[3]);
  100.            CopyPage(Vp[3],Vga);
  101.      Until Keypressed;
  102.  
  103.      GlobalClose;
  104. End.
  105.