View Code
{*******************************************************}
{ }
{ Delphi Thread Sample }
{ Creation Date 2011.06.29 }
{ Created By: ming }
{ }
{*******************************************************}
unit unitWorkThread;
interface
uses
Classes,Windows, Messages, SysUtils, Graphics, StdCtrls;
type
TWorkThread = class(TThread)
private
{ Private declarations }
FEvent: HWND;
FMsg: string;
FMemo: TMemo;
FInterval: Cardinal;
procedure doSyncProc1;
procedure doSomething;
procedure syncOutputMsg;
procedure doOutputMsg(const msg: string);
procedure _sleep(millisecond:Cardinal);
protected
procedure Execute; override;
public
constructor Create(Suspend: boolean); overload;
constructor Create(Suspend: boolean; mmoOutput: TMemo); overload;
destructor Destroy; override;
public
procedure exitThread;
public
property Interval:Cardinal read FInterval write FInterval;
end;
var
WorkThread: TWorkThread;
implementation
{ TWorkThread }
constructor TWorkThread.Create(Suspend: boolean);
begin
inherited Create(Suspend);
FEvent := CreateEvent(nil,False,False,nil);
FreeOnTerminate := True;
FInterval := 100;
end;
constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
begin
inherited Create(Suspend);
FEvent := CreateEvent(nil,False,False,nil);
FreeOnTerminate := True;
FInterval := 100;
FMemo := mmoOutput;
doOutputMsg('Thread Create');
end;
destructor TWorkThread.Destroy;
begin
CloseHandle(FEvent);
doOutputMsg('Thread Destroy');
inherited;
end;
procedure TWorkThread.doSyncProc1;
begin
end;
procedure TWorkThread.doOutputMsg(const msg: string);
begin
FMsg := msg;
Synchronize(syncOutputMsg);
end;
procedure TWorkThread.syncOutputMsg;
begin
if Assigned(FMemo) then
FMemo.Lines.Add(FMsg);
end;
procedure TWorkThread.doSomething;
begin
//Synchronize(doSyncProc1);
doOutputMsg(FormatDateTime('HH:NN:SS',now));
end;
procedure TWorkThread.Execute;
begin
inherited;
while not Terminated do
begin
if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_0 then
begin
Break;
end;
doSomething;
//_sleep(FInterval);
end;
end;
procedure TWorkThread.exitThread;
begin
if FEvent>0 then
begin
SetEvent(FEvent);
if Suspended then Resume;
end;
end;
procedure TWorkThread._sleep(millisecond: Cardinal);
begin
WaitForSingleObject(Self.Handle,millisecond);
end;
{=============================================================}
{ Use TWorkThread
procedure TForm1.btnCreateThreadClick(Sender: TObject);
begin
WorkThread := TWorkThread.Create(False,mmoOutput);
//WorkThread.Interval := 1000;
if WorkThread.Suspended then
WorkThread.Resume;
end;
procedure TForm1.btnDestroyThreadClick(Sender: TObject);
begin
if Assigned(WorkThread) then
WorkThread.exitThread;
end;
}
end.