Delphi线程同步(SendMessage)
<div id="cnblogs_post_body">Delphi线程同种的方法有很多种，除了常用的Synchronize方法，也可以使用SendMessage向主窗口发送消息，因为SendMessage是阻塞的，可以达到同步的效果。主线程可以直接定义消息类型的procedure接收消息，也可以重写TControl类的WndProc窗口过程，在窗口过程里面截取自己想要的消息。<div class="cnblogs_code" >http://images.cnblogs.com/OutliningIndicators/ContractedBlock.gifhttp://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gifThread<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;interfaceusesClasses,Windows, Messages, SysUtils, Graphics, StdCtrls;typeTWorkThread = 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;varWorkThread: TWorkThread;implementation{ TWorkThread }constructor TWorkThread.Create(Suspend: boolean);begininherited Create(Suspend);FEvent := CreateEvent(nil,True,False,nil);FreeOnTerminate := True;FInterval := 1000;end;procedure TWorkThread.addLog(const msg: string);beginFMsg := msg;Synchronize(syncOutputMsg);end;procedure TWorkThread.addLog(const fmtStr: string;const params: array of const);beginFMsg := Format(fmtStr,params);Synchronize(syncOutputMsg);end;constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);begininherited Create(Suspend);FEvent := CreateEvent(nil,True,False,nil);FreeOnTerminate := True;FInterval := 1000;FMemo := mmoOutput;end;destructor TWorkThread.Destroy;beginCloseHandle(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;beginDoUpdateUI(IntToStr(FCount));end;procedure TWorkThread.syncOutputMsg;vardt: string;begindt := FormatDateTime('hh:nn:ss',now);FMsg := Format('[%s] - ',) + FMsg;if Assigned(FMemo) then FMemo.Lines.Add(FMsg);end;procedure TWorkThread.Execute;begininherited;while not Terminated dobegin 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;beginFThreadStop := False;if Suspended then Resume;end;function TWorkThread.ThreadPause: Boolean;beginFThreadPause := True;if not Suspended then Suspend;end;function TWorkThread.ThreadStop: Boolean;beginFThreadPause := False;FThreadStop := True;if Suspended then Resume;end;procedure TWorkThread.ThreadTerminate;beginFThreadStop := False;if FEvent>0 thenbegin SetEvent(FEvent); if Suspended then Resume;end;end;procedure TWorkThread._sleep(millisecond: Cardinal);begin//WaitForSingleObject(Self.Handle,millisecond);WaitForSingleObject(FEvent,millisecond);end;end.
页:
[1]