{*******************************************************}
{ }
{ Delphi Thread Sample }
{ Creation Date 2012.08.25 }
{ Created By: ming }
{ }
{*******************************************************}
unit unitWorkThread;
interface
uses
Classes,Windows, Messages, SysUtils, Graphics, StdCtrls, Controls, DateUtils;
const
WM_UPDATE = WM_USER + $100;
WM_LEFT = WM_USER + $101;
WM_RIGHT = WM_USER + $102;
WM_TOP = WM_USER + $103;
WM_BOTTOM = WM_USER + $104;
WM_DEFAULT = WM_USER + $105;
type
TWorkThread = class(TThread)
private
{ Private declarations }
FEvent,FMainFormHWND: HWND;
FDoTimes,FTickTimes: Integer;
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;
property MainFormHWND: HWND read FMainFormHWND write FMainFormHWND;
property DoTimes:Integer read FDoTimes write FDoTimes;
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;
const
K_SLEEP = 20;
begin
SendMessage(FMainFormHWND,WM_LEFT,0,0); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,0,0);
SendMessage(FMainFormHWND,WM_RIGHT,0,0); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,0,0);
SendMessage(FMainFormHWND,WM_TOP,0,0); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,0,0);
SendMessage(FMainFormHWND,WM_BOTTOM,0,0); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,0,0);
Inc(FTickTimes);
if FTickTimes >= FDoTimes then
begin
FTickTimes := 0;
Self.Suspend;
end;
end;
procedure TWorkThread.Execute;
begin
inherited;
while not Terminated do
begin
if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_0 then
begin
Break;
end;
doSomething;
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.