Delphi - API Thread-Demo
// API Thread-Demo
// Michael Puff [http://www.michael-puff.de]
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmMain = class(TForm)
Label1: TLabel;
btnStart: TButton;
btnAbort: TButton;
procedure btnAbortClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
private
{ Private-Deklarationen }
protected
procedure WndProc(var Message: TMessage); override;
public
{ Public-Deklarationen }
end;
type
PThreadParams = ^TThreadParams;
TThreadParams = record
ParentHandle: THandle;
end;
const
CM_STATUS = WM_USER + 1;
CM_FINISHED = WM_USER + 2;
CM_ABORT = WM_USER + 3;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
var
Abort: Boolean;
function DemoThread(p: Pointer): Integer;
var
i: Integer;
ParentHandle: THandle;
label CLEANUP;
begin
ParentHandle := PThreadParams(p)^.ParentHandle;
for i := 0 to 9 do
begin
if Abort then
begin
SendMessage(ParentHandle, CM_ABORT, 0 , 0);
goto CLEANUP;
end;
SendMessage(ParentHandle, CM_STATUS, Integer(PChar('Durchlauf:')), i);
Sleep(500);
end;
SendMessage(ParentHandle, CM_FINISHED, 0, 0);
CLEANUP:
Dispose(p);
Result := 0;
end;
procedure TfrmMain.btnAbortClick(Sender: TObject);
begin
Abort := True;
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
var
ThreadID: Cardinal;
ThreadParams: PThreadParams;
begin
Abort := False;
New(ThreadParams);
ThreadParams.ParentHandle := Self.Handle;
CloseHandle(BeginThread(nil, 0, @DemoThread, ThreadParams, 0, ThreadID));
end;
procedure TfrmMain.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
CM_STATUS:
begin
Label1.Caption := PChar(Message.WParam) + ' ' + IntToStr(Message.LParam);
end;
CM_FINISHED:
begin
Label1.Caption := 'Thread fertig';
end;
CM_ABORT:
begin
label1.Caption := 'Abbruch durch Benutzer';
end;
end;
end;
end.