六狼论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

新浪微博账号登陆

只需一步,快速开始

搜索
查看: 1902|回复: 0

Delphi线程同步(SendMessage)

[复制链接]

升级  16%

2

主题

2

主题

2

主题

童生

Rank: 1

积分
8
 楼主| 发表于 2013-1-1 22:28:33 | 显示全部楼层 |阅读模式
<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.
您需要登录后才可以回帖 登录 | 立即注册 新浪微博账号登陆

本版积分规则

快速回复 返回顶部 返回列表