splash.pas

提供 122 种不同图形显示特效的可视构件

unit Splash;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PicShow, ExtCtrls;

type
  TSplashForm = class(TForm)
    PicShow: TPicShow;
    Timer: TTimer;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PicShowComplete(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    procedure Initialize;
  public
    class procedure Execute;
  end;

implementation

{$R *.DFM}

procedure TSplashForm.Initialize;
var
  Background: TBitmap;
  DC: HDC;
begin
  Randomize;
  Left := (Screen.DesktopWidth - Width) div 2;
  Top := (Screen.DesktopHeight - Height) div 2;
  Background := TBitmap.Create;
  Background.Width := Width;
  Background.Height := Height;
  DC := GetDC(0);
  try
    BitBlt(Background.Canvas.Handle, 0, 0, Width, Height, DC, Left, Top, SRCCOPY);
  finally
    ReleaseDC(0, DC);
  end;
  PicShow.BgPicture.Assign(Background);
  PicShow.Style := Random(High(TShowStyle))+1;
end;

procedure TSplashForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := not PicShow.Busy;
end;

procedure TSplashForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TSplashForm.PicShowComplete(Sender: TObject);
begin
  Sleep(500);
  Timer.Enabled := True;
end;

procedure TSplashForm.TimerTimer(Sender: TObject);
begin
  Close;
end;

class procedure TSplashForm.Execute;
begin
  with TSplashForm.Create(Application) do
  begin
    Initialize;
    Show;
    Update;
    PicShow.Execute;
  end;
end;

end.