home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / vrac / savers_.zip / COLORS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-29  |  3KB  |  117 lines
  1. program Colors;
  2.  
  3. (* The following 3 lines are not comments. *)
  4.  
  5. {$N-,E-,Q-,S-,R+,I-,O-,F-,P+,T-,X-,V-,B-,A+,G-,D-,L-,Y-}
  6. {$M 8192,0,65536}
  7. {$L Bgi256}  (* <──── Links the graphics object file (into the code segment). *)
  8.  
  9. (* Compiled in Borland Turbo Pascal 7.0 for DOS. Bgi256.Obj is a non-Borland
  10.    aftermarket add-on file. It is "registered", meaning the Bgi256.Obj file
  11.    itself isn't needed to run Colors.exe. *)
  12.  
  13. uses crt,drivers,graph;
  14.  
  15. var
  16. Gd, Gm, Error, Milliseconds : integer;                  
  17. Adjuster : char;
  18.  
  19. label Top, Start;
  20.  
  21. (* Gm := 0 is 320x200x256, 1 is 640x400x256, 2 is 640x480x256,
  22.          3 is 800x600x256, 4 is 1024x768x256, 5 is 1280x1024x256 *)
  23.  
  24. procedure Bgi256proc; external; (* The "public" name as declared by BinObj.exe. *)
  25.  
  26. procedure InitBgi256;
  27. begin
  28. Gd := installuserdriver('Bgi256',nil);
  29. Error := registerbgidriver(@Bgi256proc);
  30. Gm := 0;  (* Run in 320x200x256 mode *)
  31. end;
  32.  
  33. procedure Exit_Program;
  34. begin
  35. closegraph;
  36. textcolor(7);
  37. textbackground(0);
  38. clrscr;
  39. gotoxy(1,3);
  40. textcolor(9);
  41. writeln('I hope you like playing this screen saver; Colors....');
  42. writeln;
  43. donesyserror;
  44. halt;
  45. end;
  46.  
  47. begin
  48. initsyserror;   (* Turns off ctrl-break, in drivers unit. *)
  49. Adjuster := 'A';
  50. textcolor(7);
  51. textbackground(1);
  52. randomize;
  53. Top:
  54. clrscr;
  55. gotoxy(1,3);
  56. writeln(' This program is a simple screen saver. What it does is put up one of up to');
  57. writeln(' 262,144 shades of color from black to white. It randomly chooses the color');
  58. writeln(' using 6 bits each for red green and blue (18-bit color). It holds each color');
  59. writeln(' for a random timeframe up to your millisecond entry. Requires only an 8088');
  60. writeln(' or up and 256k of ram on the video card, and a color monitor. Below you will');
  61. writeln(' determine the longest interval of time Colors can leave up any certain color.');
  62. writeln(' Your entry is in milliseconds, from 100 to 2000 (0.1 second to 2.0 seconds).');
  63. writeln(' Lower numbers will produce more rapid flickering. Colors will choose a random');
  64. writeln(' value between 0 milliseconds and your entry to show each color. If you press');
  65. writeln(' the N key (for New screen), you return to the menu to enter a new upper delay');
  66. writeln(' value. It randomly chooses to display each color from 0 milliseconds to your');
  67. write(' your entry for milliseconds. Any other key exits Colors. Have fun');
  68. textcolor(135);
  69. writeln('!');
  70. textcolor(7);
  71. writeln;
  72. writeln(' Enter a whole number between 100 and 2000 (or 0 to exit)');
  73. write(' ────>  ');
  74. reset(input);
  75. if not eoln(input) then
  76. read(Milliseconds) else goto Top;
  77.  
  78. if ioresult = 106 then goto Top;
  79.  
  80. if Milliseconds = 0 then Exit_Program;
  81.  
  82. if (Milliseconds < 100) or (Milliseconds > 2000) then goto Top;
  83.  
  84. if Adjuster = 'A' then InitBgi256;
  85.  
  86. initgraph(Gd,Gm,'');
  87. Error := graphresult;
  88. if Error <> 0 then
  89. begin
  90. closegraph;
  91. textcolor(7);
  92. textbackground(0);
  93. clrscr;
  94. textcolor(9);
  95. gotoxy(1,3);
  96. writeln(' Sorry, your display and/or video card is incompatible');
  97. writeln(' with this screen saver program. Oh, well; No harm done.');
  98. writeln;
  99. exit;
  100. end;
  101.  
  102. Start:
  103. repeat
  104. setrgbpalette(0, Random(64), Random(64), Random(64));
  105. delay(Random(Milliseconds));
  106. delay(1);
  107. until keypressed;
  108.  
  109. Adjuster := readkey;
  110.  
  111. if (Adjuster = 'n') or (Adjuster = 'N') then
  112. begin
  113. closegraph;
  114. goto Top;
  115. end else Exit_Program;
  116.  
  117. end.