|
<div id="cnblogs_post_body">Delphi线程同种的方法有很多种,除了常用的Synchronize方法,也可以使用SendMessage向主窗口发送消息,因为SendMessage是阻塞的,可以达到同步的效果。主线程可以直接定义消息类型的procedure接收消息,也可以重写TControl类的WndProc窗口过程,在窗口过程里面截取自己想要的消息。
<div class="cnblogs_code" > Thread<div id="cnblogs_code_open_5d790498-b2fb-4d23-80fd-22af3a465578" class="cnblogs_code_hide">{*******************************************************}{ }{ Delphi Thread Sample 5 }{ Creation Date 2012.12.30 }{ Created By: ming }{ }{*******************************************************}unit unitWorkThread;interfaceuses Classes,Windows, Messages, SysUtils, Graphics, StdCtrls;type TWorkThread = class(TThread) private { Private declarations } FEvent: HWND; FMsg: string; FMemo: TMemo; FInterval,FTickTimes,FCount: 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 MainFromHandle: HWND; DoUpdateUI: procedure(const value: string) of object; property Interval:Cardinal read FInterval write FInterval; end;const {0x0400 - 0x7FFF} WM_UPDATE_UI1 = WM_USER + $1001; WM_UPDATE_UI2 = WM_USER + $1002; WM_UPDATE_UI3 = WM_USER + $1003;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)); Inc(FCount); FCount := FCount mod 100000; SendMessage(MainFromHandle,WM_UPDATE_UI1,0,FCount); SendMessage(MainFromHandle,WM_UPDATE_UI2,0,FCount); SendMessage(MainFromHandle,WM_UPDATE_UI3,0,FCount);// doSyncProc1;end;procedure TWorkThread.doSyncProc1;begin DoUpdateUI(IntToStr(FCount));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. |
|