| 标题 | Delphi线程同步(SendMessage) |
| 内容 | Delphi线程同种的方法有很多种，除了常用的Synchronize方法，也可以使用SendMessage向主窗口发送消息，因为 SendMessage是阻塞的，可以达到同步的效果。主线程可以直接定义消息类型的procedure接收消息，也可以重写TControl类的 WndProc窗口过程，在窗口过程里面截取自己想要的消息。 Thread {*******************************************************} { } { Delphi Thread Sample 5 } { Creation Date 2012.12.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,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. Main form unit main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, unitWorkThread; type TfrmMain = class(TForm) Memo1: TMemo; btnStart: TButton; btnPause: TButton; btnStop: TButton; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure btnStartClick(Sender: TObject); procedure btnPauseClick(Sender: TObject); procedure btnStopClick(Sender: TObject); private { Private declarations } procedure UpdateUI(const value: string); protected procedure On_WM_UPDATE_UI(var msg: TMessage);message WM_UPDATE_UI1; procedure WndProc(var Message: TMessage); override; public { Public declarations } end; var frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.btnPauseClick(Sender: TObject); begin WorkThread.ThreadPause; end; procedure TfrmMain.btnStartClick(Sender: TObject); begin WorkThread.ThreadStart; end; procedure TfrmMain.btnStopClick(Sender: TObject); begin WorkThread.ThreadStop; end; procedure TfrmMain.FormCreate(Sender: TObject); begin WorkThread := TWorkThread.Create(True,Memo1); WorkThread.MainFromHandle := Self.Handle; WorkThread.DoUpdateUI := UpdateUI; end; procedure TfrmMain.FormDestroy(Sender: TObject); begin WorkThread.ThreadTerminate; end; procedure TfrmMain.On_WM_UPDATE_UI(var msg: TMessage); begin Edit1.Text := IntToStr(msg.lParam); end; procedure TfrmMain.UpdateUI(const value: string); begin Edit1.Text := value; end; procedure TfrmMain.WndProc(var Message: TMessage); begin case Message.Msg of WM_UPDATE_UI2: begin Edit2.Text := IntToStr(Message.lParam); end; WM_UPDATE_UI3: begin Edit3.Text := IntToStr(Message.lParam); end; else inherited; end; end; end. |
| 随便看 |
|
在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。