{*******************************************************}
{ }
{ Delphi Thread Sample 4 }
{ Creation Date 2012.12.21 }
{ 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,FTickTimes: Cardinal;
procedure doSyncProc1;
procedure syncOutputMsg;
procedure addLog(const msg: string); overload;
procedure addLog(const fmtStr:string; const params: array of const); overload;
procedure _sleep(millisecond:Cardinal);
protected
procedure Execute; override;
public
constructor Create(Suspend: boolean); overload;
constructor Create(Suspend: boolean; mmoOutput: TMemo); overload;
destructor Destroy; override;
private
FThreadPause,FThreadStop: Boolean;
procedure doSomething;
public
function ThreadStart: Boolean;
function ThreadPause: Boolean;
function ThreadStop: Boolean;
procedure ThreadTerminate;
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,True,False,nil);
FreeOnTerminate := True;
FInterval := 1000;
end;
procedure TWorkThread.addLog(const msg: string);
begin
FMsg := msg;
Synchronize(syncOutputMsg);
end;
procedure TWorkThread.addLog(const fmtStr: string;
const params: array of const);
begin
FMsg := Format(fmtStr,params);
Synchronize(syncOutputMsg);
end;
constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
begin
inherited Create(Suspend);
FEvent := CreateEvent(nil,True,False,nil);
FreeOnTerminate := True;
FInterval := 1000;
FMemo := mmoOutput;
end;
destructor TWorkThread.Destroy;
begin
CloseHandle(FEvent);
inherited;
end;
procedure TWorkThread.doSomething;
begin
addLog(FormatDateTime('c',now));
end;
procedure TWorkThread.doSyncProc1;
begin
end;
procedure TWorkThread.syncOutputMsg;
var
dt: string;
begin
dt := FormatDateTime('hh:nn:ss',now);
FMsg := Format('[%s] - ',[dt]) + FMsg;
if Assigned(FMemo) then
FMemo.Lines.Add(FMsg);
end;
procedure TWorkThread.Execute;
begin
inherited;
while not Terminated do
begin
if WaitForSingleObject(FEvent,100)=WAIT_OBJECT_0 then
begin
Break;
end;
if (GetTickCount - FTickTimes) >= FInterval then
try
if not FThreadStop then
begin
doSomething;
FTickTimes := GetTickCount;
end;
except on e:Exception do
addLog(e.Message);
end;
if FThreadStop then
Suspend;
end;
end;
function TWorkThread.ThreadStart: Boolean;
begin
FThreadStop := False;
if Suspended then Resume;
end;
function TWorkThread.ThreadPause: Boolean;
begin
FThreadPause := True;
if not Suspended then Suspend;
end;
function TWorkThread.ThreadStop: Boolean;
begin
FThreadPause := False;
FThreadStop := True;
if Suspended then Resume;
end;
procedure TWorkThread.ThreadTerminate;
begin
FThreadStop := False;
if FEvent>0 then
begin
SetEvent(FEvent);
if Suspended then Resume;
end;
end;
procedure TWorkThread._sleep(millisecond: Cardinal);
begin
//WaitForSingleObject(Self.Handle,millisecond);
WaitForSingleObject(FEvent,millisecond);
end;
end.