fsplash.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 82 行

unit fSplash;

interface

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

type
  TfmSplash = class(TForm)
    imgSplash: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    FProgress: integer;
    FProgressRect: TRect;
  public
    { Public declarations }
    procedure FlexProgress(Sender: TObject; Progress: integer;
      Process: TFlexFilerProcess);
  end;

var
  fmSplash: TfmSplash;

procedure CreateSplash;
procedure DestroySplash;

implementation

{$R *.DFM}

procedure CreateSplash;
begin
 fmSplash := TfmSplash.Create(Application);
 fmSplash.Show;
 fmSplash.Refresh;
end;

procedure DestroySplash;
begin
 fmSplash.Free;
 fmSplash := Nil;
end;

// TfmSplash //////////////////////////////////////////////////////////////////

procedure TfmSplash.FormCreate(Sender: TObject);
begin
 DoubleBuffered := true;
 FProgressRect := Rect(40, 170, 40 + imgSplash.Width - 80, 177);
end;

procedure TfmSplash.FlexProgress(Sender: TObject; Progress: integer;
  Process: TFlexFilerProcess);
begin
 FProgress := Progress;
 Refresh;
end;

procedure TfmSplash.FormPaint(Sender: TObject);
var R: TRect;
begin
 with Canvas do begin
  Draw(1, 1, imgSplash.Picture.Bitmap);
  // Paint blended progress bar
  Pen.Mode := pmMask;
  Pen.Color := $00E0E0E0; // light gray color for frame for progress bar
  Pen.Style := psSolid;
  Brush.Style := bsClear;
  with FProgressRect do Rectangle(Left, Top, Right, Bottom);
  R := FProgressRect;
  R.Right := R.Left + Round((R.Right - R.Left) * FProgress / 100 );
  Brush.Color := $00FFB062; // blue color for progress bar
  Brush.Style := bsSolid;
  with R do Rectangle(Left, Top, Right, Bottom);
 end;
end;

end.