splash.pas

启动delphi程序技巧

unit Splash;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Gauges, OleCtrls, ShockwaveFlashObjects_TLB;

type
  TfrmSplash = class(TForm)
    lblStatus: TLabel;
    Gauge1: TGauge;
    swfSplash: TShockwaveFlash;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure RepaintForm;
  public
    { Public declarations }
    procedure BeginLoad;
    procedure EndLoad;
    procedure UpdateLoadStatus(const AStatusText: string; AProgress: Integer);
  end;

var
  frmSplash: TfrmSplash;

implementation

{$R *.dfm}

{ TfrmSplash }

procedure TfrmSplash.BeginLoad;
begin
  lblStatus.Caption := '正在装载……';
  Gauge1.Progress := 0;
  RepaintForm;
end;

procedure TfrmSplash.EndLoad;
begin
  lblStatus.Caption := '装载完毕';
  Gauge1.Progress := 100;
  RepaintForm;
end;

procedure TfrmSplash.FormCreate(Sender: TObject);
begin
  swfSplash.Movie := ExtractFilePath(ParamStr(0)) + 'splash.swf';
  lblStatus.Caption := '';
  Gauge1.MinValue := 0;
  Gauge1.MaxValue := 100;
end;

procedure TfrmSplash.RepaintForm;
var
  I: Integer;
begin
  Show;
  Update;

  { 为了演示，特延长时间 }
  I := 5000000;
  while I > 0 do
  begin
    Dec(I);
    Application.ProcessMessages;
  end;
end;

procedure TfrmSplash.UpdateLoadStatus(const AStatusText: string;
  AProgress: Integer);
begin
  lblStatus.Caption := AStatusText;
  Gauge1.Progress := AProgress;
  RepaintForm;
end;

end.