home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d3456 / PICSHOW.ZIP / DBDemo / Splash.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-09-23  |  2.8 KB  |  110 lines
  1. // If forms of your application appears fast on the screen, the splash of the
  2. // other demo is better. In this example, because ADOConnection is slow, I used
  3. // the following way to show the splash screen.
  4.  
  5. unit Splash;
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  11.   PicShow, ExtCtrls, jpeg;
  12.  
  13. type
  14.   TSplashForm = class(TForm)
  15.     PicShow: TPicShow;
  16.     procedure PicShowProgress(Sender: TObject);
  17.   private
  18.     procedure Init;
  19.   public
  20.     class procedure ShowSplash;
  21.     class procedure HideSplash;
  22.   end;
  23.  
  24. implementation
  25.  
  26. {$R *.DFM}
  27.  
  28. var
  29.   SplashForm: TSplashForm;
  30.  
  31. function CaptureScreen(Left, Top, Width, Height: Integer): TBitmap;
  32. var
  33.   DC: HDC;
  34. begin
  35.   // We create a bitmap object for storing the screen behind the form.
  36.   Result := TBitmap.Create;
  37.   Result.Width := Width;
  38.   Result.Height := Height;
  39.   // We get device context of the screen and copy the screen behind the form
  40.   // to the created bitmap.
  41.   DC := GetDC(0);
  42.   try
  43.     BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, Left, Top, SRCCOPY);
  44.   finally
  45.     ReleaseDC(0, DC);
  46.   end;
  47. end;
  48.  
  49. procedure TSplashForm.Init;
  50. var
  51.   Scr: TBitmap;
  52. begin
  53.   // First we set position of the form on the center of desktop.
  54.   // We set Position property of the form to poDesigned because we
  55.   // need the form's position before showing it.
  56.   Left := (Screen.Width - Width) div 2;
  57.   Top := (Screen.Height - Height) div 2;
  58.   // Then to give a transparent look to picshow, we capture the screen image
  59.   Scr := CaptureScreen(Left, Top, Width, Height);
  60.   try
  61.     // and assign it to PicShow's background
  62.     PicShow.BgPicture.Assign(Scr);
  63.     // To reduce chance of flickering (only when PicShow is used as non-windowed
  64.     // control we may sometime have flickers) we set background color of the form
  65.     // to color of upper left pixel of the captured screen.
  66.     Color := Scr.Canvas.Pixels[0,0];
  67.   finally
  68.     // We don't need the bitmap object, so we free it.
  69.     Scr.Free;
  70.   end;
  71.   // Selects randomly a transition effect.
  72.   Randomize;
  73.   PicShow.Style := Random(High(TShowStyle)) + 1;
  74. end;
  75.  
  76. class procedure TSplashForm.ShowSplash;
  77. begin
  78.   if SplashForm = nil then
  79.   begin
  80.     SplashForm := TSplashForm.Create(nil);
  81.     SplashForm.Init;
  82.     SplashForm.Show;
  83.     SplashForm.Update;
  84.     SplashForm.PicShow.Execute;
  85.   end;
  86. end;
  87.  
  88. class procedure TSplashForm.HideSplash;
  89. begin
  90.   if SplashForm <> nil then
  91.   begin
  92.     SplashForm.PicShow.Reverse := True;
  93.     SplashForm.PicShow.Manual := False;
  94.     SplashForm.Free;
  95.     SplashForm := nil;
  96.     Sleep(500);
  97.   end;
  98. end;
  99.  
  100. procedure TSplashForm.PicShowProgress(Sender: TObject);
  101. begin
  102.   if PicShow.Progress = 100 then
  103.   begin
  104.     PicShow.Style := Random(High(TShowStyle)) + 1;
  105.     PicShow.Manual := True;
  106.   end;
  107. end;
  108.  
  109. end.
  110.