unit ThreadProgress;
interface
uses
Classes, Sysutils,
VCL.Dialogs,
VCL.Forms,
VCL.ComCtrls,
VCL.ExtCtrls,
VCL.Controls;
var
ShowProgress: boolean;
type
TProgressThread =
class(TThread)
constructor Create;
destructor Destroy;
override;
private
SplashForm: TForm;
ProgressRand: TPanel;
sb, sh: integer;
step: integer;
protected
procedure Execute();
override;
public
end;
var
Thread_Progress: TProgressThread;
implementation
constructor TProgressThread.Create;
begin
FreeOnTerminate := True;
// Suspended starten
inherited Create(True);
ShowProgress := True;
SplashForm := TForm.Create(
nil);
sb := 200;
sh := 50;
step := 0;
SplashForm.Width := sb;
SplashForm.Height := sh;
SplashForm.BorderStyle := bsNone;
ProgressRand := TPanel.Create(SplashForm);
ProgressRand.Margins.Left := 5;
ProgressRand.Margins.Top := 5;
ProgressRand.Margins.Right := 5;
ProgressRand.Margins.Bottom := 5;
ProgressRand.AlignWithMargins := True;
ProgressRand.Parent := SplashForm;
ProgressRand.Caption := '
Bitte warten';
ProgressRand.ShowCaption := True;
ProgressRand.Align := alClient;
ProgressRand.BorderStyle := bsSingle;
ProgressRand.BevelOuter := bvNone;
ProgressRand.StyleElements := [];
SplashForm.Position := poMainFormCenter;
SplashForm.Visible := True;
SplashForm.BringToFront;
end;
destructor TProgressThread.Destroy;
begin
// globale Variable rücksetzen
Thread_Progress :=
nil;
inherited;
end;
procedure TProgressThread.Execute;
begin
while ShowProgress
do
begin
SplashForm.BringToFront;
inc(step);
if step = 5
then
step := 0;
ProgressRand.Caption := '
Bitte warten' + StringOfChar('
.', step);
Application.ProcessMessages;
sleep(500);
end;
end;
end.