Delphi线程类(三)

type
  TfrmMain = class(TForm)
    mmoMsg: TMemo;
    btnNewThread: TButton;
    btnShutdownAll: TButton;
    procedure btnNewThreadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnShutdownAllClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTestThread = class(TThread)
  private
    FSignalShutdown: Boolean;
    FWinHandle: HWND;
    FMemo: TMemo;
    FMsg: String;
    procedure DeallocateHwnd(Wnd: HWND);
    procedure OnThreadTerminate(Sender: TObject);
    procedure syncOutputMsg;
    procedure doOutputMsg(const msg: string); overload;
    procedure doOutputMsg(const fmtStr:string; const params: array of const); overload;
  protected
    procedure Execute; override;
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(mmoOutput: TMemo);
    destructor Destroy; override;
  end;

var
  frmMain: TfrmMain;

implementation

var
  WM_SHUTDOWN_THREAD: Cardinal;

{$R *.fmx}

{ TTestThread }

constructor TTestThread.Create(mmoOutput: TMemo);
begin
  FMemo := mmoOutput;
  FSignalShutdown := False;
  FWinHandle := AllocateHWnd(WndProc);
  FreeOnTerminate := True;
  OnTerminate := OnThreadTerminate;
  inherited Create(False);
end;

procedure TTestThread.DeallocateHwnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd,GWL_WNDPROC));
  if Instance <> @DefWindowProc then
    SetWindowLong(Wnd,GWL_WNDPROC,LongInt(@DefWindowProc));
  FreeObjectInstance(Instance);
  DestroyWindow(Wnd);
end;

destructor TTestThread.Destroy;
begin
  DeallocateHwnd(FWinHandle);
  inherited;
end;

procedure TTestThread.OnThreadTerminate(Sender: TObject);
begin
  frmMain.mmoMsg.Lines.Add('Thread ' + IntToStr(ThreadID) + ' shutting down.');
end;

procedure TTestThread.doOutputMsg(const msg: string);
begin
  FMsg := msg;
  Synchronize(syncOutputMsg);
end;

procedure TTestThread.doOutputMsg(const fmtStr:string; const params: array of const);
begin
  FMsg := Format(fmtStr,params);
  Synchronize(syncOutputMsg);
end;

procedure TTestThread.syncOutputMsg;
begin
  if Assigned(FMemo) then FMemo.Lines.Add(FMsg);
end;

procedure TTestThread.Execute;
begin
  inherited;
  while not FSignalShutdown do
  begin
    Sleep(10);
    doOutputMsg('Thid: %d, Time: %s',[ThreadID
      ,FormatDateTime('yyyy-mm-dd hh:nn:ss zzz',now)]);
  end;
end;

procedure TTestThread.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_SHUTDOWN_THREAD then
    FSignalShutdown := True
  else
    Msg.Result := DefWindowProc(FWinHandle,Msg.Msg,Msg.WParam,Msg.LParam);
end;

procedure TfrmMain.btnNewThreadClick(Sender: TObject);
var
  a: TTestThread;
begin
  a := TTestThread.Create(frmMain.mmoMsg);
  frmMain.mmoMsg.Lines.Add('Thread ' + IntToStr(a.ThreadID) + ' created.');
end;

procedure TfrmMain.btnShutdownAllClick(Sender: TObject);
begin
  //SendMessage(wnd_broadcast, WM_SHUTDOWN_THREAD, 0, 0);
  PostMessage(wnd_broadcast, WM_SHUTDOWN_THREAD, 0, 0);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  WM_SHUTDOWN_THREAD := RegisterWindowMessage('WM_SHUTDOWN_THREAD_001');
end;

end.