home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap01 / howto01 / ccscreen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-30  |  12.9 KB  |  311 lines
  1. unit Ccscreen;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls;
  8.  
  9. const
  10.  
  11.   CCSaverJumpIncrement = 5; { This controls the speed of bitmap motion }
  12.                             { 1=crawl; 10+=jerky                       }
  13. type
  14.   TCCScreenSaverForm = class(TForm)
  15.     CCSSTImer: TTimer;
  16.     procedure FormShow(Sender: TObject);
  17.     procedure FormHide(Sender: TObject);
  18.     procedure FormActivate(Sender: TObject);
  19.     procedure CCSSTImerTimer(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.     CurrentXLocation ,            { Position of the bitmap onscreen X }
  25.     CurrentYLocation ,            { Position of the bitmap onscreen Y }
  26.     CurrentDeltaX ,               { Amount to move left or right (-x) }
  27.     CurrentDeltaY : Integer;      { Amount to move up or down (-y)    }
  28.     TheDisplayBitmap : TBitmap;    { Bitmap to use in the saver        }
  29.     TheSavedBackgroundBitmap ,    { Portion of BgBMP saved each time  }
  30.     TheWorkSpaceBitmap : TBitmap; { Offscreen workspace to avoid flikr}
  31.     procedure ShutDownTheScreenSaver( var Msg : TMsg;
  32.      var Handled : boolean );            { This handles checking to shut down }
  33.   end;
  34.  
  35. var
  36.   CCScreenSaverForm: TCCScreenSaverForm;
  37.   StartingMousePosition : TPoint;    { This is where the mouse is when saver invoked   }
  38.   TestingInProgress : Boolean;       { This is used to inform when a test is being run }
  39.   FWPC : array[0..255] of char;      { PChar lookalike for use in FindWindow API call  }
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. uses
  46.   Ccsavrsu, { This is the setup unit; used if /c in paramaters at startup }
  47.   CCErrors; { This is the custom error handling unit.                     }
  48.  
  49. { This procedure is used to check any incoming message for a keyboard/mouse }
  50. { event; if one is found the saver is deactivated; otherwise the message is }
  51. { passed through.                                                           }
  52. procedure TCCScreenSaverForm.ShutDownTheScreenSaver(var Msg : TMsg; var Handled : boolean);
  53. var
  54.   Finished : boolean; { This is a flag to tell whether to quit }
  55. begin
  56.   { Assume the saver will continue to run }
  57.   Finished := false;
  58.   { If the mouse is moved more than 5 pixels from start then kill the saver }
  59.   if Msg.message = WM_MOUSEMOVE then
  60.   begin
  61.     { Obtain an absolute value of difference between X and Y positions }
  62.     { which are in the Lo and Hi parameter words respectively.         }
  63.     if ( Abs( LoWord( Msg.lParam ) - StartingMousePosition.X ) > 5 ) then
  64.      Finished := true;
  65.     if ( Abs( HiWord( Msg.lParam ) - StartingMousePosition.Y ) > 5 ) then
  66.      Finished := true;
  67.   end
  68.   else
  69.   begin
  70.     { Check for a plethora of possible keyboard/mousebutton event messages }
  71.     case Msg.message of
  72.       WM_ACTIVATE    : Finished := true;
  73.       WM_ACTIVATEAPP : Finished := true;
  74.       WM_KEYDOWN     : Finished := true;
  75.       WM_KEYUP       : Finished := true;
  76.       WM_LBUTTONDOWN : Finished := true;
  77.       WM_MBUTTONDOWN : Finished := true;
  78.       WM_NCACTIVATE  : Finished := true;
  79.       WM_RBUTTONDOWN : Finished := true;
  80.       WM_SYSKEYDOWN  : Finished := true;
  81.       WM_SYSKEYUP    : Finished := true;
  82.     end;
  83.   end;
  84.   { If any appropriate message found kill the screen saver! }
  85.   if Finished then Close;
  86. end;
  87.  
  88. { This code is written by Delphi; put in the calls to set up the starting }
  89. { mouse position, the speed of the bitmap motion, and the starting bitmap }
  90. { coordinates chosen randomly. Also set up the message hook and hide the  }
  91. { cursor for neatness sake. Finally, get the necessary canvases to show   }
  92. { the moving bitmap smoothly. Last, load the bitmap to use as an image!   }
  93. procedure TCCScreenSaverForm.FormShow(Sender: TObject);
  94. begin
  95.   { Seed the random number generator }
  96.   Randomize;
  97.   { Use an API call to get the position of the mouse cursor at startup }
  98.   GetCursorPos( StartingMousePosition );
  99.   { Reset timer due to Win 95 startup }
  100.   CCSSTimer.Interval := 305 - ( SetupDialog.TheImageSpeed * 3 );
  101.   { Start the timer }
  102.   CCSSTimer.Enabled := true;
  103.   { Hook the message processing call into the Application object }
  104.   Application.OnMessage := ShutDownTheScreenSaver;
  105.   { Use an API call to hide the cursor for neatness! }
  106.   ShowCursor( false );
  107.   TheDisplayBitmap := TBitmap.Create;
  108.   { Load the image file name and signal an error if unable to }
  109.   {$I+}
  110.   try
  111.     TheDisplayBitmap.LoadFromFile( SetupDialog.TheImageFilename );
  112.   except
  113.     { abort on any io error at all! }
  114.     on E:EInOutError do
  115.     begin
  116.       { Signal the error condition }
  117.       ErrorDialog( SetupDialog.TheImageFileName + ' ' +
  118.        GetIOErrorMessage( E.ErrorCode ) + '! Aborting Saver!' );
  119.       { abort the saver }
  120.       exit;
  121.     end;
  122.   end;
  123.   { Get a Position where the image can move at least a little }
  124.   CurrentXLocation := Random(( Screen.Width - ( TheDisplayBitmap.Width * 2 ))) + 1;
  125.   CurrentYLocation := Random(( Screen.Height - ( TheDisplayBitmap.Height * 2 ))) + 1;
  126.   { Start out moving right and down }
  127.   CurrentDeltaX := CCSaverJumpIncrement;
  128.   CurrentDeltaY := CCSaverJumpIncrement;
  129.   { Create the two bitmaps to handle smooth animation }
  130.   TheSavedBackgroundBitmap := TBitmap.Create;
  131.   TheWorkspaceBitmap := TBitmap.Create;
  132.   { Set the bitmaps to appropriate height and width values }
  133.   TheWorkspaceBitmap.Width := Screen.Width;
  134.   TheWorkSpaceBitmap.Height := Screen.Height;
  135.   TheSavedBackgroundBitmap.Width := TheDisplayBitmap.Width;
  136.   TheSavedBackgroundBitmap.Height := TheDisplayBitmap.Height;
  137.   { Blank out the workspace's canvas }
  138.   with TheWorkspaceBitmap.Canvas do
  139.   begin
  140.     brush.color := clblack;
  141.     pen.color := clblack;
  142.     Brush.style := bsSolid;
  143.     Rectangle( 0 , 0 , Screen.Width , Screen.Height );
  144.   end;
  145.   { Put the background behind the saved bitmap into the save buffer }
  146.   TheSavedBackgroundBitmap.Canvas.Copyrect( Rect( 0 , 0 , TheDisplayBitmap.Width ,
  147.    TheDisplayBitmap.Height ) , TheWorkSpacebitmap.canvas , Rect( CurrentXLocation ,
  148.    CurrentYLocation , CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation +
  149.     TheDisplayBitmap.Height ));
  150.   { Put the image in the workspace }
  151.   TheWorkspaceBitmap.Canvas.Copyrect( Rect( CurrentXLocation , CurrentYLocation ,
  152.    CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ) ,
  153.     TheDisplayBitmap.Canvas , Rect( 0 , 0 , TheDisplayBitmap.Width , TheDisplayBitmap.Height ));
  154.   { And blas it to the screen to start off }
  155.   CCScreenSaverForm.Canvas.CopyRect( Rect( CurrentXLocation , CurrentYLocation ,
  156.    CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ) ,
  157.    TheWorkspaceBitmap.Canvas , Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  158.     TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ));
  159. end;
  160.  
  161. { Delphi wrote this; put in calls to unhook the message handler and turn off }
  162. { the timer and show the cursor again. Then free all the bitmaps.            }
  163. procedure TCCScreenSaverForm.FormHide(Sender: TObject);
  164. begin
  165.   { Set the message handler hook to nil to abort message processing }
  166.   Application.OnMessage := nil;
  167.   { Turn off the timer until needed again }
  168.   CCSSTimer.Enabled := false;
  169.   { Make an API call to turn on the cursor again }
  170.   ShowCursor( true );
  171.   { Free all the bitmaps till next time }
  172.   TheDisplayBitmap.Free;
  173.   TheSavedBackGroundBitmap.Free;
  174.   TheWorkspaceBitmap.Free;
  175. end;
  176.  
  177. { Delphi wrote this; use it to maximize the window to the whole screen }
  178. procedure TCCScreenSaverForm.FormActivate(Sender: TObject);
  179. begin
  180.   if ( ParamCount > 0) and ( UpperCase( ParamStr( 1 )) = '/S') then
  181.   begin
  182.     { Maximize to the whole screen }
  183.     WindowState := wsMaximized;
  184.     CCSSTimer.Enabled := true;
  185.   end
  186.   else
  187.   begin
  188.     if TestingInProgress then
  189.     begin
  190.       { Maximize to the whole screen }
  191.       WindowState := wsMaximized;
  192.       CCSSTimer.Enabled := true;
  193.     end
  194.     else Visible := false;
  195.   end;
  196.   if ( ParamCount > 0) and ( UpperCase( ParamStr( 1 )) = '/S') then
  197.   begin
  198.     { Maximize to the whole screen }
  199.     WindowState := wsMaximized;
  200.     CCSSTimer.Enabled := true;
  201.   end
  202.   else
  203.   begin
  204.     if TestingInProgress then
  205.     begin
  206.       { Maximize to the whole screen }
  207.       WindowState := wsMaximized;
  208.       CCSSTimer.Enabled := true;
  209.     end
  210.     else Visible := false;
  211.   end;
  212. end;
  213.  
  214. { Delphi wrote this; use it to actually move the bitmap around to clear }
  215. { the screen during the operation of the screen saver form              }
  216. procedure TCCScreenSaverForm.CCSSTImerTimer(Sender: TObject);
  217. var OldXLocation ,
  218.     OldYLocation   : Integer;
  219.     ComputedXLocation ,
  220.     ComputedYLocation : Integer;
  221. begin
  222.   { Move the bitmap along the chosen coordinate until it hits an edge }
  223.   with TheWorkSpaceBitmap.Canvas do
  224.   begin
  225.     {Erase bitmap by copying in saved background}
  226.     CopyMode := cmSrcCopy;
  227.     CopyRect( Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  228.      TheDisplayBitmap.Width, CurrentYLocation + TheDisplayBitmap.Height ) ,
  229.       TheSavedBackgroundBitmap.Canvas, Rect( 0 , 0 , TheDisplayBitmap.Width ,
  230.        TheDisplayBitmap.Height ));
  231.     OldXLocation := CurrentXLocation;
  232.     OldYLocation := CurrentYLocation;
  233.     { set new bitmap position}
  234.     { first increment the position by current counters }
  235.     CurrentXLocation := CurrentXLocation + CurrentDeltaX;
  236.     CurrentYLocation := CurrentYLocation + CurrentDeltaY;
  237.     { If at the right edge, move left and randomly set the up/down move }
  238.     if ( CurrentXLocation + TheDisplayBitmap.Width ) >= Screen.Width then
  239.     begin
  240.       CurrentDeltaX := -CCSaverJumpIncrement;
  241.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  242.       case CurrentDeltaY of
  243.         -CCSaverJumpIncrement : CurrentDeltaY := 0;
  244.          0                    : CurrentDeltaY := CCSaverJumpIncrement;
  245.          CCSaverJumpIncrement  : CurrentDeltaY := -CCSaverJumpIncrement;
  246.       end;
  247.     end;
  248.     { If at the bottom, move up and randomly set the right/left move }
  249.     if ( CurrentYLocation + TheDisplayBitmap.Height ) >= Screen.Height then
  250.     begin
  251.       CurrentDeltaY := -CCSaverJumpIncrement;
  252.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  253.       case CurrentDeltaX of
  254.         -CCSaverJumpIncrement : CurrentDeltaX := 0;
  255.          0                    : CurrentDeltaX := CCSaverJumpIncrement;
  256.          CCSaverJumpIncrement : CurrentDeltaX := -CCSaverJumpIncrement;
  257.       end;
  258.     end;
  259.     { If at the left move right and randomly set the up/down move }
  260.     if CurrentXLocation  <= 1 then
  261.     begin
  262.       CurrentDeltaX := CCSaverJumpIncrement;
  263.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  264.       case CurrentDeltaY of
  265.         -CCSaverJumpIncrement : CurrentDeltaY := 0;
  266.          0                    : CurrentDeltaY := CCSaverJumpIncrement;
  267.          CCSaverJumpIncrement : CurrentDeltaY := -CCSaverJumpIncrement;
  268.       end;
  269.     end;
  270.     { If at the top move down and randomly set the right/left move }
  271.     if CurrentYLocation <= 1 then
  272.     begin
  273.       CurrentDeltaY := CCSaverJumpIncrement;
  274.       if Random( 10 ) > 7 then    { 3 out of ten times go either reverse or flat }
  275.       case CurrentDeltaX of
  276.         -CCSaverJumpIncrement : CurrentDeltaX := 0;
  277.          0                    : CurrentDeltaX := CCSaverJumpIncrement;
  278.          CCSaverJumpIncrement : CurrentDeltaX := -CCSaverJumpIncrement;
  279.       end;
  280.     end;
  281.     {save background at new bitmap position}
  282.     TheSavedBackgroundBitmap.Canvas.CopyRect( Rect( 0 , 0 , TheDisplayBitmap.Width ,
  283.      TheDisplayBitmap.Height), TheWorkSpaceBitmap.Canvas, Rect( CurrentXLocation ,
  284.       CurrentYLocation , CurrentXLocation + TheDisplayBitmap.Width, CurrentYLocation +
  285.        TheDisplayBitmap.Height ));
  286.     {copy the bitmap into place}
  287.     CopyRect( Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  288.      TheDisplayBitmap.Width, CurrentYLocation + TheDisplayBitmap.Height ) ,
  289.       TheDisplayBitmap.Canvas, Rect( 0 , 0 , TheDisplayBitmap.Width ,
  290.        TheDisplayBitmap.Height ));
  291.   end;
  292.   {Now blast the finished image to the screen!}
  293.   with CCScreenSaverForm.Canvas do
  294.   begin
  295.     if CurrentXLocation < OldXLocation then
  296.      ComputedXLocation := CurrentXLocation else
  297.       ComputedXLocation := OldXLocation;
  298.     if CurrentYLocation < OldYLocation then
  299.      ComputedYLocation := CurrentYLocation else
  300.       ComputedYLocation := OldYLocation;
  301.     CopyRect( Rect( ComputedXLocation , ComputedYLocation , ComputedXLocation +
  302.      TheDisplayBitmap.Width + CCSaverJumpIncrement + 2, ComputedYLocation +
  303.       TheDisplayBitmap.Height + CCSaverJumpIncrement + 2 ) , TheWorkSpaceBitmap.Canvas,
  304.        Rect( ComputedXLocation , ComputedYLocation ,
  305.        ComputedXLocation + TheDisplayBitmap.Width + CCSaverJumpIncrement + 2,
  306.         ComputedYLocation + TheDisplayBitmap.Height + CCSaverJumpIncrement + 2));
  307.   end;
  308. end;
  309.  
  310. end.
  311.