Delphi线程同步(SendMessage)

Delphi线程同种的方法有很多种，除了常用的Synchronize方法，也可以使用SendMessage向主窗口发送消息，因为SendMessage是阻塞的，可以达到同步的效果。主线程可以直接定义消息类型的procedure接收消息，也可以重写TControl类的WndProc窗口过程，在窗口过程里面截取自己想要的消息。

{*******************************************************}
{                                                       }
{       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.

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.