unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
var
WM_SHUTDOWN_THREADS: Cardinal; //无符号32位
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure WndProc(var Message: TMessage); override;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TTestThread = class(TThread)
Private
FWinHandle: THandle;
FSignalShutdown: Boolean;
public
constructor Create;
Procedure Execute(); Override;
Destructor Destroy; Override;
procedure WndProc(var Message: TMessage);
Procedure PrntMsg(msg: String);
end;
var
Form1: TForm1;
implementation
var
TestThread: TTestThread;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Clear;
//创建消息标志符
WM_SHUTDOWN_THREADS := RegisterWindowMessage('MyMessage');
if WM_SHUTDOWN_THREADS = 0 then
Begin
Raise Exception.Create('获取消息句柄失败!');
end;
end;
{ TTestThread }
constructor TTestThread.Create;
begin
Inherited Create(False);
FSignalShutdown := False;
//建立窗口句柄
FWinHandle := AllocateHwnd(WndProc);
end;
destructor TTestThread.Destroy;
begin
//释放窗口句柄
DeAllocateHwnd(FWinHandle);
inherited;
end;
procedure TTestThread.Execute;
begin
inherited;
while (not FSignalShutdown) do
Begin
sleep(1000);
end;
PrntMsg('');
end;
procedure TTestThread.PrntMsg(msg: String);
begin
Form1.Memo1.Lines.Add('线程' + IntToStr(ThreadID) + '关闭!');
end;
procedure TTestThread.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_SHUTDOWN_THREADS then
FSignalShutdown := True
else
Message.Result := DefWindowProc(FWinHandle, Message.Msg, Message.WParam, Message.LParam);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//广播消息
SendMessage(wnd_Broadcast, WM_SHUTDOWN_THREADS, 0, 0);
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
if Message.Msg = WM_SHUTDOWN_THREADS then
ShowMessage('消息到了!');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TestThread := TTestThread.Create;
end;
end.