unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
const
CM_Progress=WM_User+1;
type
TForm1 =
class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
TProgressThread=class(TThread)
protected
procedure execute;
override;
private
FParameter:
String;
FProgressWindowHandle:hwnd;
FResult:
String;
FStatusReady: boolean;
procedure SetParameter(
const Value:
String);
procedure SetProgressWindowHandle(
const Value: hwnd);
public
property ProgressWindowHandle:hwnd
read FProgressWindowHandle
write SetProgressWindowHandle;
property Parameter:
String read FParameter
write SetParameter;
property StatusReady:boolean
read FStatusReady;
property Result:
String read FResult;
end;
TProgressform=class(TCustomForm)
constructor CreateNew(AOwner: TComponent;dummy:Integer);
override;
private
FProgressbar:TProgressbar;
FAbbruchButton:TButton;
FProgressThread:TProgressThread;
FLabel:TLabel;
FResult:
String;
FParameter:
String;
procedure AbbruchButtonClick(Sender:TObject);
procedure CMProgress(
var msg:TMessage);
message CM_Progress;
procedure SetParameter(
const Value:
String);
procedure StarteThread(Parameter:
String);
procedure ProgressThreadTerminate(Sender:TObject);
protected
procedure DoShow;
override;
public
property Parameter:
String read FParameter
write SetParameter;
property Result:
String read FResult;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var Progressform:TProgressform;
begin
//Form dynamisch erstellen
Progressform:=TProgressform.CreateNew(
nil,0);
try
//Eingansgparameter setzen
ProgressForm.Parameter:=Edit1.Text;
//Fenster Modal öffnen und Rückgabewert prüfen
case Progressform.ShowModal
of
mrOK: Memo1.Lines.Add('
Fertsch: '+ProgressForm.Result);
mrCancel: Memo1.Lines.Add('
Abbruch: '+ ProgressForm.Result);
end;
finally
//finito
Progressform.Free;
end;
end;
{ TProgressform }
procedure TProgressform.AbbruchButtonClick(Sender: TObject);
begin
//einfach nur Abbruch des Threads erzwingen
//um auch einen konsistenten Zustand aller Werte des Threads zu haben
FProgressThread.Terminate;
end;
procedure TProgressform.CMProgress(
var msg: TMessage);
begin
//zum Aktualisieren der
//Wenn Postmessage an dieses Fenster gesendet wird... (siehe TProgressthread.execute)
FProgressbar.StepBy(msg.LParam);
//lparam ist der letzte Wert in Postmessage
FLabel.Caption:=
inttostr(FProgressbar.Position)+'
von '+inttostr(FProgressbar.Max);
//lparam und wParam dürfen frei verwendet werden
end;
constructor TProgressform.CreateNew(AOwner: TComponent;dummy:Integer);
begin
//hier wird ein fesnter ohne formulardesigner erstellt
//kann man aber auch mit designer machen (der Code aus Methode DoShow muss dan zum Ereignis onShow)
inherited;
//lustige Elemente zusammenbasteln
Caption:='
please hold the line...';
Width:=400;
Height:=150;
FProgressbar:=TProgressbar.Create(self);
FProgressbar.Parent:=self;
FProgressbar.Height:=20;
FProgressbar.Width:=300;
FProgressbar.Left:=50;
FProgressbar.Top:=20;
FProgressbar.Visible:=true;
FPRogressbar.Min:=0;
FPRogressbar.Max:=100;
FProgressbar.Position:=0;
FAbbruchButton:=TButton.Create(self);
FAbbruchButton.Caption:='
A&bbruch';
FAbbruchbutton.Parent:=self;
FAbbruchbutton.Height:=40;
FAbbruchButton.Width:=100;
FAbbruchButton.Left:=150;
FAbbruchButton.Top:=60;
FAbbruchButton.Show;
FAbbruchButton.OnClick:=AbbruchButtonClick;
FLabel:=TLabel.Create(self);
FLabel.Parent:=self;
FLabel.Visible:=true;
FLabel.Caption:='
ich muss mal kurz rechnen';
FLabel.Left:=50;
FLabel.Top:=5;
end;
procedure TProgressform.DoShow;
//oder als Ereignis in onShow
begin
inherited;
BringToFront;
if FParameter<>'
'
then
StarteThread(FParameter)
//wenn Fenster angezeigt wird, soll der Thread gestartet werden
else
raise Exception.Create('
keine Parameter');
//aber nur bei gültigen Eingabewerten ;-)
end;
procedure TProgressform.ProgressThreadTerminate(Sender: TObject);
begin
//wenn der Thread beendet wird, landen wir hier
FResult:=(Sender
as TProgressThread).Result;
if (Sender
as TProgressThread).StatusReady
then
modalResult:=mrOk
else
modalResult:=mrCancel;
//das setzen von modalresult bewirkt, dass dieses Fenster automatisch geschlossen wird
// wir landen hinter dem Aufruf von ShowModal
end;
procedure TProgressform.SetParameter(
const Value:
String);
begin
FParameter := Value;
FProgressbar.Max:= length(FParameter);
end;
procedure TProgressform.StarteThread(Parameter:
String);
begin
FProgressThread:=TProgressThread.Create(true);
//Parameter übergeben
FProgressThread.Parameter:=FParameter;
//Windowhandle übergeben, damit wir Messages des Threads über den Fortschritt bekommen können
FProgressThread.ProgressWindowHandle:=self.WindowHandle;
FProgressThread.OnTerminate:=ProgressThreadTerminate;
FProgressThread.FreeOnTerminate:=true;
FProgressThread.Resume;
end;
{ TProgressThread }
procedure TProgressThread.execute;
var i,p:Integer;
begin
FStatusready:=false;
p:=1;
//Hauptschleife
while (
not terminated)
and(p<=length(FParameter))
do
begin
//erstmal Message senden, dass wir die nächste Aufgabe abarbeiten
Postmessage(FProgressWindowHandle,CM_Progress,0,1);
//Aufgabe erledigen
FResult:=FResult+inttohex(ord(FParameter[p]),2)+'
';
inc(p);
//simulieren, dass die Aufgabe ca. 1sek braucht
for i:=1
to 10
do
begin
sleep(100);
if terminated
then break;
end;
end;
FStatusReady:= p>length(FParameter);
end;
procedure TProgressThread.SetParameter(
const Value:
String);
begin
FParameter := Value;
end;
procedure TProgressThread.SetProgressWindowHandle(
const Value: hwnd);
begin
FProgressWindowHandle := Value;
end;
end.