View Code
{*******************************************************}
{ }
{ Delphi Thread Sample 2 }
{ Creation Date 2011.06.30 }
{ 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;
const
WM_TEST1 = WM_USER + 1000; //range (WM_USER - $7FFF)
WM_TEST2 = WM_APP + 100; //range (WM_APP - $BFFF)
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;
{
GetMessage 阻塞模式类似于SendMessage
PeekMessage 非阻塞模式类似于PostMessage
}
{.$DEFINE _BLOCKMSG}
procedure TWorkThread.Execute;
var
aMsg: TMsg;
begin
inherited;
{$IFDEF _BLOCKMSG}
while GetMessage(aMsg,0,0,0) do
begin
case aMsg.message of
WM_QUIT:
begin
Break;
end;
WM_TEST1:
begin
doOutputMsg('Received Msg1');
doSomething;
end;
WM_TEST2:
begin
doOutputMsg('Received Msg2');
doSomething;
end;
end;
end;
{$ELSE}
while not Terminated do
begin
if PeekMessage(aMsg,0,0,0,PM_REMOVE) then
begin
case aMsg.message of
WM_QUIT:
begin
Break;
end;
WM_TEST1:
begin
doOutputMsg('Received Msg1');
end;
WM_TEST2:
begin
doOutputMsg('Received Msg2');
end;
end;
end;
doSomething;
_sleep(FInterval);
end;
{$ENDIF}
end;
procedure TWorkThread.exitThread;
begin
PostThreadMessage(Self.ThreadID,WM_QUIT,0,0);
if Suspended then Resume;
end;
procedure TWorkThread._sleep(millisecond: Cardinal);
begin
WaitForSingleObject(Self.Handle,millisecond);
end;
{=============================================================}
{uses unitWorkThread;
procedure TForm1.btnCreateThreadClick(Sender: TObject);
begin
if Assigned(WorkThread) then exit;
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
begin
WorkThread.exitThread;
WorkThread := nil;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(WorkThread) then
PostThreadMessage(WorkThread.ThreadID,WM_TEST1,0,0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Assigned(WorkThread) then
PostThreadMessage(WorkThread.ThreadID,WM_TEST2,0,0);
end;
}
end.