Delphi--软件启动画面中启动状态的显示
在flashfrm窗體中
unit flash;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Gauges;
type
TFlashfrm = class(TForm)
Image1: TImage;
Gauge1: TGauge;
Label1: TLabel;
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
Flashfrm: TFlashfrm;
implementation
{$R *.dfm}
procedure tFlashfrm.BeginLoad;
begin
label1.Caption := '正在初始化程序...';
Gauge1.Progress := 0;
RepaintForm;
end;
procedure tFlashfrm.EndLoad;
begin
label1.Caption := '初始化完成';
Gauge1.Progress := 100;
RepaintForm;
end;
procedure tFlashfrm.RepaintForm;
begin
Show; Update; Sleep(500);
end;
procedure tFlashfrm.UpdateLoadStatus(const AStatusText: string; AProgress: Integer);
begin
label1.Caption := AStatusText;
Gauge1.Progress := AProgress; Sleep(500);
RepaintForm;
end;
procedure TFlashfrm.FormCreate(Sender: TObject);
begin
label1.Caption := '';
Gauge1.MinValue := 0;
Gauge1.MaxValue := 100;
end;
end.
在dpr窗體中(F8進入)
program Flashexe;
uses
Forms,
Windows,
Controls,
Messages,
flash in 'flash.pas' {Flashfrm},
Main in 'Main.pas' {Mainfrm},
frm1 in 'frm1.pas' {Frmfrm1};
{$R *.res}
var
hMutex: THandle;
FoundWnd: THandle;
ModuleName: string;
function EnumWndProc(hwnd: THandle; Param: Cardinal): Bool; stdcall;
var
ClassName, WinModuleName: string;
WinInstance: THandle;
begin
Result := True;
SetLength(ClassName, 100);
GetClassName (hwnd, PChar (ClassName), Length (ClassName));
ClassName := PChar(ClassName);
if ClassName = Tmainfrm.ClassName then
begin
SetLength(WinModuleName, 200);
WinInstance := GetWindowLong(hwnd, GWL_HINSTANCE);
GetModuleFileName (WinInstance, PChar (WinModuleName),
Length(WinModuleName));
WinModuleName := PChar(WinModuleName);
if WinModuleName = ModuleName then
begin
FoundWnd := Hwnd;
Result := False;
end;
end;
end;
begin
HMutex := CreateMutex(nil, False, 'OneCopyMutex');
if WaitForSingleObject(hMutex, 0) <> WAIT_TIMEOUT then
begin
Application.Initialize;
Flashfrm := tFlashfrm.Create(nil);
try
with Flashfrm do
begin
BeginLoad;
Application.CreateForm(TMainfrm, Mainfrm);
// 加載窗體
UpdateLoadStatus('正在加載模塊1......', 10);
// 加載窗體
Application.CreateForm(TFrmfrm1, Frmfrm1);
UpdateLoadStatus('正在加載模塊2......', 40);
// 加載窗體
UpdateLoadStatus('正在加載模塊3......', 60);
// 加載窗體
UpdateLoadStatus('正在加載模塊4......', 70);
// 加載窗體
UpdateLoadStatus('正在加載模塊5......', 80);
// 加載窗體
UpdateLoadStatus('正在加載模塊6......', 90);
// 加載窗體
Flashfrm.EndLoad;
end;
finally
Flashfrm.Free;
end;
Application.Run;
end
else
begin
SetLength(ModuleName, 200);
GetModuleFileName (HInstance, PChar(ModuleName), Length (ModuleName));
ModuleName := PChar(ModuleName);
EnumWindows(@EnumWndProc, 0);
if FoundWnd <> 0 then
begin
if not IsWindowVisible(FoundWnd) then
PostMessage(FoundWnd, wm_App, 0, 0);
SetForegroundWindow(FoundWnd);
end;
end;
end.