Delphi线程类(二)

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 .

转载于:https://www.cnblogs.com/Jekhn/archive/2011/06/30/2094190.html