home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / delphi / SAVESCRN / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-06-30  |  3.0 KB  |  137 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Box, ExtCtrls;
  8.  
  9. type
  10.   TfrmScrnSave = class(TForm)
  11.  
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  14.       Shift: TShiftState);
  15.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  16.       Shift: TShiftState; X, Y: Integer);
  17.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  18.       Y: Integer);
  19.     procedure FormShow(Sender: TObject);
  20.     procedure FormPaint(Sender: TObject);
  21.   private
  22.     bFirst, bConfig: Boolean;
  23.     bDrawing: Boolean;
  24.     Box: TBox;
  25.  
  26.     procedure TerminateScrnSave;
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.   end;
  31.  
  32. var
  33.   frmScrnSave: TfrmScrnSave;
  34.  
  35. implementation
  36.  
  37. uses
  38.   Config;
  39.  
  40. {$R *.DFM}
  41.  
  42. procedure TfrmScrnSave.TerminateScrnSave;
  43. begin
  44.   Box.Free;
  45.   Halt(0);
  46. end;
  47.  
  48. procedure TfrmScrnSave.FormCreate(Sender: TObject);
  49. var
  50.   i: integer;
  51. begin
  52.   bFirst := true;
  53.   bConfig := false;
  54.   bDrawing := false;
  55.  
  56.   SetBounds (0, 0, 0, 0);     { Avoid the blinking effect }
  57.  
  58.   for i:=1 to ParamCount do
  59.     if ParamStr(i)='/c' then bConfig := true;
  60.  
  61.   if not bConfig then
  62.   begin
  63.     WindowState := wsMaximized;      { Make the window BIG }
  64.   end;
  65. end;
  66.  
  67. procedure TfrmScrnSave.FormKeyDown(Sender: TObject; var Key: Word;
  68.   Shift: TShiftState);
  69. begin
  70.   TerminateScrnSave;
  71. end;
  72.  
  73. procedure TfrmScrnSave.FormMouseDown(Sender: TObject; Button: TMouseButton;
  74.   Shift: TShiftState; X, Y: Integer);
  75. begin
  76.   TerminateScrnSave;
  77. end;
  78.  
  79. procedure TfrmScrnSave.FormMouseMove(Sender: TObject; Shift: TShiftState;
  80.   X, Y: Integer);
  81. begin
  82.   if not bFirst then TerminateScrnSave;
  83.   bFirst := false;
  84. end;
  85.  
  86. procedure TfrmScrnSave.FormShow(Sender: TObject);
  87. begin
  88.   if bConfig then
  89.   begin
  90.     frmConfig.ShowModal;
  91.     Close;
  92.   end
  93.   else
  94.   begin
  95.     { Hide tbe cursor }
  96.     SetCursorPos(Screen.Width,Screen.Height);
  97.  
  98.     { Make a box object and let it draw itself on the forms Canvas }
  99.     Box := TBox.Init(Canvas, 100);
  100.  
  101.     { Make a timer so that the image will be updated regularly }
  102. {    Timer1.Enabled := true;}
  103.   end
  104.  
  105. end;
  106.  
  107. { Could have used a timer instead of this but Timers are
  108.   valuable resources not to be wasted. However the Clock is
  109.   very in acurate in the PC so no real accuracy can be
  110.   expected }
  111. procedure TfrmScrnSave.FormPaint(Sender: TObject);
  112. var
  113.   lastTime, Fract: Real;
  114. begin
  115.   { Want to make sure I am only running one instance }
  116.   if not bDrawing then
  117.     bDrawing:= true;
  118.  
  119.     { 10 ms fraction (1000ms * 60s * 60m * 24h /10 ms = 8640000 }
  120.     Fract := 50/86400000; { 50 ms About as accurate as the PC clock can be }
  121.  
  122.     Box.Draw;
  123.     lastTime := Time;
  124.     while true do
  125.     begin
  126.       Application.ProcessMessages;
  127.       if Time > lastTime+Fract then
  128.       begin
  129.         Box.Rotate;
  130.         lastTime := Time;
  131.       end;
  132.     end;
  133. end;
  134.  
  135.  
  136. end.
  137.