如何实现一个简单的消息队列？
How to implement a simple message queue?
我想在一个新线程中实现一个消息队列，就像主线程一样。我在这里找到 an example 但我不需要显示 window。因此，示例中的 RegisterClass 和 CreateWindow 对我来说不是必需的。无论如何，我没有要传递给那些程序的信息。我只想注册一个 window 过程 AllocateHWnd(PrivateWndProc); 然后用 GetMessage 和 DispatchMessage 做一个循环。不知道有没有道理...
我构建了一个演示来向您展示如何创建工作线程，它的工作方式与主线程大致相同。
要使用该演示，请创建一个包含 3 个按钮和一个备忘录的表单。然后粘贴下面的代码。查看我为组件指定的名称以执行相同的操作并关联正确的事件处理程序。
您可能想要添加更多错误检查。我制作了一些快捷方式以使代码更易于阅读。您可能应该检查所有可能失败的内容。
在实际的应用程序中，如果您有多个工作线程，请从我的 TMyThread class 派生所有线程，以便它们继承消息队列和消息泵。
由于线程无法访问 VCL 并且为了简单起见，我使用 OutputDebugString 使工作线程显示消息。当您在 Delphi 调试器下 运行 演示时，消息显示在事件视图 (Ctrl+Alt+V) 中。
unit ThreadDemoMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMyThread = class(TThread)
private
FWinHandle : HWND;
procedure AllocateHWnd; virtual;
procedure DeallocateHWnd; virtual;
procedure WndProc(var MsgRec: TMessage); virtual;
public
procedure Execute; override;
property WinHandle : HWND read FWinHandle;
end;
TThreadDemoForm = class(TForm)
StartThreadButton: TButton;
Memo1: TMemo;
StopThreadButton: TButton;
PostMessageButton: TButton;
Label1: TLabel;
procedure StartThreadButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure StopThreadButtonClick(Sender: TObject);
procedure PostMessageButtonClick(Sender: TObject);
private
FWorkerThread : TMyThread;
procedure WorkerThreadTerminate(Sender: TObject);
end;
var
ThreadDemoForm: TThreadDemoForm;
implementation
{$R *.dfm}
procedure TThreadDemoForm.PostMessageButtonClick(Sender: TObject);
begin
if not Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread not running');
Exit;
end;
PostMessage(FWorkerThread.FWinHandle, WM_USER + 2, 0, 0);
end;
procedure TThreadDemoForm.StartThreadButtonClick(Sender: TObject);
begin
if Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread already running');
Exit;
end;
Memo1.Lines.Add('Ask worker thread to start...');
FWorkerThread := TMyThread.Create(TRUE);
FWorkerThread.FreeOnTerminate := TRUE;
FWorkerThread.OnTerminate := WorkerThreadTerminate;
FWorkerThread.Start;
end;
procedure TThreadDemoForm.StopThreadButtonClick(Sender: TObject);
begin
if not Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread not running');
Exit;
end;
Memo1.Lines.Add('Asking the worker thread to terminate...');
PostMessage(FWorkerThread.FWinHandle, WM_QUIT, 0, 0);
end;
procedure TThreadDemoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FWorkerThread) then begin
FWorkerThread.OnTerminate := nil; // Cancel event handling
// Ask the worker thread to terminate
PostMessage(FWorkerThread.FWinHandle, WM_QUIT, 0, 0);
FWorkerThread := nil;
// Let the workerthread breath
Sleep(250);
end;
end;
procedure TThreadDemoForm.WorkerThreadTerminate(Sender : TObject);
begin
Memo1.Lines.Add('Worker thread Terminated');
FWorkerThread := nil;
end;
{ TMyThread }
var
GWndHandlerCritSect : TRTLCriticalSection;
const
WorkerThreadWindowClassName = 'WorkerThreadWindowClass';
// WndControlWindowsProc is a callback function used for message handling
function WndControlWindowsProc(
ahWnd : HWND;
auMsg : UINT;
awParam : WPARAM;
alParam : LPARAM): LRESULT; stdcall;
var
Obj : TObject;
MsgRec : TMessage;
begin
// When the window was created, we stored a reference to the object
// into the storage space we asked windows to have
{$IFDEF WIN64}
Obj := TObject(GetWindowLongPtr(ahWnd, 0));
{$ELSE}
Obj := TObject(GetWindowLong(ahWnd, 0));
{$ENDIF}
// Check if the reference is actually our object type
if not (Obj is TMyThread) then
Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
else begin
// Internally, Delphi use TMessage to pass parameters to his
// message handlers.
MsgRec.Msg := auMsg;
MsgRec.wParam := awParam;
MsgRec.lParam := alParam;
TMyThread(Obj).WndProc(MsgRec);
Result := MsgRec.Result;
end;
end;
procedure TMyThread.AllocateHWnd;
var
TempClass : TWndClass;
NewWndClass : TWndClass;
ClassRegistered : Boolean;
begin
// Nothing to do if hidden window is already created
if FWinHandle <> 0 then
Exit;
// We use a critical section to be sure only one thread can check if a
// class is registered and register it if needed.
// We must also be sure that the class is not unregistered by another
// thread which just destroyed a previous window.
EnterCriticalSection(GWndHandlerCritSect);
try
// Check if the window class is already registered
NewWndClass.hInstance := HInstance;
NewWndClass.lpszClassName := WorkerThreadWindowClassName;
ClassRegistered := GetClassInfo(HInstance,
NewWndClass.lpszClassName,
TempClass);
if not ClassRegistered then begin
// Not registered yet, do it right now !
NewWndClass.style := 0;
NewWndClass.lpfnWndProc := @WndControlWindowsProc;
NewWndClass.cbClsExtra := 0;
NewWndClass.cbWndExtra := SizeOf(Pointer);
NewWndClass.hIcon := 0;
NewWndClass.hCursor := 0;
NewWndClass.hbrBackground := 0;
NewWndClass.lpszMenuName := nil;
if Winapi.Windows.RegisterClass(NewWndClass) = 0 then
raise Exception.Create(
'Unable to register hidden window class.' +
' Error: ' + SysErrorMessage(GetLastError));
end;
// Now we are sure the class is registered, we can create a window using it
FWinHandle := CreateWindowEx(WS_EX_TOOLWINDOW,
NewWndClass.lpszClassName,
'', // Window name
WS_POPUP, // Window Style
0, 0, // X, Y
0, 0, // Width, Height
0, // hWndParent
0, // hMenu
HInstance, // hInstance
nil); // CreateParam
if FWinHandle = 0 then
raise Exception.Create(
'Unable to create hidden window. ' +
' Error: ' + SysErrorMessage(GetLastError)); { V8.62 tell user real error. probably no memory }
// We have a window. In the associated data, we record a reference
// to our object. This will later allow to call the WndProc method to
// handle messages sent to the window.
{$IFDEF WIN64}
SetWindowLongPtr(FWinHandle, 0, INT_PTR(Self));
{$ELSE}
SetWindowLong(FWinHandle, 0, Longint(Self));
{$ENDIF}
finally
LeaveCriticalSection(GWndHandlerCritSect);
end;
end;
procedure TMyThread.DeallocateHWnd;
begin
if FWinHandle = 0 then
Exit; // Already done
{$IFDEF WIN64}
SetWindowLongPtr(FWinHandle, 0, 0);
{$ELSE}
SetWindowLong(FWinHandle, 0, 0);
{$ENDIF}
DestroyWindow(FWinHandle);
FWinHandle := 0;
end;
procedure TMyThread.Execute;
var
MsgRec : TMsg;
begin
// We cannot access the VCL from a thread, so use system function.
// The message will be shown in the debugger in the events view.
OutputDebugString('Thread Starting');
AllocateHWnd;
// Put a first message into the message queue
PostMessage(FWinHandle, WM_USER + 1, 0, 0);
// Message loop
// If GetMessage retrieves the WM_QUIT, the return value is FALSE and
// the message loop is broken.
while (not Terminated) and GetMessage(MsgRec, 0, 0, 0) do begin
TranslateMessage(MsgRec);
DispatchMessage(MsgRec)
end;
DeallocateHWnd;
OutputDebugString('Thread Ending');
end;
procedure TMyThread.WndProc(var MsgRec: TMessage);
begin
case MsgRec.Msg of
WM_USER + 1 : OutputDebugString('WM_USER + 1');
WM_USER + 2 : OutputDebugString('WM_USER + 2');
else
MsgRec.Result := DefWindowProc(FWinHandle, MsgRec.Msg,
MsgRec.wParam, MsgRec.lParam);
end;
end;
initialization
InitializeCriticalSection(GWndHandlerCritSect);
finalization
DeleteCriticalSection(GWndHandlerCritSect);
end.
我想在一个新线程中实现一个消息队列，就像主线程一样。我在这里找到 an example 但我不需要显示 window。因此，示例中的 RegisterClass 和 CreateWindow 对我来说不是必需的。无论如何，我没有要传递给那些程序的信息。我只想注册一个 window 过程 AllocateHWnd(PrivateWndProc); 然后用 GetMessage 和 DispatchMessage 做一个循环。不知道有没有道理...
我构建了一个演示来向您展示如何创建工作线程，它的工作方式与主线程大致相同。
要使用该演示，请创建一个包含 3 个按钮和一个备忘录的表单。然后粘贴下面的代码。查看我为组件指定的名称以执行相同的操作并关联正确的事件处理程序。
您可能想要添加更多错误检查。我制作了一些快捷方式以使代码更易于阅读。您可能应该检查所有可能失败的内容。
在实际的应用程序中，如果您有多个工作线程，请从我的 TMyThread class 派生所有线程，以便它们继承消息队列和消息泵。
由于线程无法访问 VCL 并且为了简单起见，我使用 OutputDebugString 使工作线程显示消息。当您在 Delphi 调试器下 运行 演示时，消息显示在事件视图 (Ctrl+Alt+V) 中。
unit ThreadDemoMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMyThread = class(TThread)
private
FWinHandle : HWND;
procedure AllocateHWnd; virtual;
procedure DeallocateHWnd; virtual;
procedure WndProc(var MsgRec: TMessage); virtual;
public
procedure Execute; override;
property WinHandle : HWND read FWinHandle;
end;
TThreadDemoForm = class(TForm)
StartThreadButton: TButton;
Memo1: TMemo;
StopThreadButton: TButton;
PostMessageButton: TButton;
Label1: TLabel;
procedure StartThreadButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure StopThreadButtonClick(Sender: TObject);
procedure PostMessageButtonClick(Sender: TObject);
private
FWorkerThread : TMyThread;
procedure WorkerThreadTerminate(Sender: TObject);
end;
var
ThreadDemoForm: TThreadDemoForm;
implementation
{$R *.dfm}
procedure TThreadDemoForm.PostMessageButtonClick(Sender: TObject);
begin
if not Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread not running');
Exit;
end;
PostMessage(FWorkerThread.FWinHandle, WM_USER + 2, 0, 0);
end;
procedure TThreadDemoForm.StartThreadButtonClick(Sender: TObject);
begin
if Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread already running');
Exit;
end;
Memo1.Lines.Add('Ask worker thread to start...');
FWorkerThread := TMyThread.Create(TRUE);
FWorkerThread.FreeOnTerminate := TRUE;
FWorkerThread.OnTerminate := WorkerThreadTerminate;
FWorkerThread.Start;
end;
procedure TThreadDemoForm.StopThreadButtonClick(Sender: TObject);
begin
if not Assigned(FWorkerThread) then begin
Memo1.Lines.Add('Worker thread not running');
Exit;
end;
Memo1.Lines.Add('Asking the worker thread to terminate...');
PostMessage(FWorkerThread.FWinHandle, WM_QUIT, 0, 0);
end;
procedure TThreadDemoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FWorkerThread) then begin
FWorkerThread.OnTerminate := nil; // Cancel event handling
// Ask the worker thread to terminate
PostMessage(FWorkerThread.FWinHandle, WM_QUIT, 0, 0);
FWorkerThread := nil;
// Let the workerthread breath
Sleep(250);
end;
end;
procedure TThreadDemoForm.WorkerThreadTerminate(Sender : TObject);
begin
Memo1.Lines.Add('Worker thread Terminated');
FWorkerThread := nil;
end;
{ TMyThread }
var
GWndHandlerCritSect : TRTLCriticalSection;
const
WorkerThreadWindowClassName = 'WorkerThreadWindowClass';
// WndControlWindowsProc is a callback function used for message handling
function WndControlWindowsProc(
ahWnd : HWND;
auMsg : UINT;
awParam : WPARAM;
alParam : LPARAM): LRESULT; stdcall;
var
Obj : TObject;
MsgRec : TMessage;
begin
// When the window was created, we stored a reference to the object
// into the storage space we asked windows to have
{$IFDEF WIN64}
Obj := TObject(GetWindowLongPtr(ahWnd, 0));
{$ELSE}
Obj := TObject(GetWindowLong(ahWnd, 0));
{$ENDIF}
// Check if the reference is actually our object type
if not (Obj is TMyThread) then
Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
else begin
// Internally, Delphi use TMessage to pass parameters to his
// message handlers.
MsgRec.Msg := auMsg;
MsgRec.wParam := awParam;
MsgRec.lParam := alParam;
TMyThread(Obj).WndProc(MsgRec);
Result := MsgRec.Result;
end;
end;
procedure TMyThread.AllocateHWnd;
var
TempClass : TWndClass;
NewWndClass : TWndClass;
ClassRegistered : Boolean;
begin
// Nothing to do if hidden window is already created
if FWinHandle <> 0 then
Exit;
// We use a critical section to be sure only one thread can check if a
// class is registered and register it if needed.
// We must also be sure that the class is not unregistered by another
// thread which just destroyed a previous window.
EnterCriticalSection(GWndHandlerCritSect);
try
// Check if the window class is already registered
NewWndClass.hInstance := HInstance;
NewWndClass.lpszClassName := WorkerThreadWindowClassName;
ClassRegistered := GetClassInfo(HInstance,
NewWndClass.lpszClassName,
TempClass);
if not ClassRegistered then begin
// Not registered yet, do it right now !
NewWndClass.style := 0;
NewWndClass.lpfnWndProc := @WndControlWindowsProc;
NewWndClass.cbClsExtra := 0;
NewWndClass.cbWndExtra := SizeOf(Pointer);
NewWndClass.hIcon := 0;
NewWndClass.hCursor := 0;
NewWndClass.hbrBackground := 0;
NewWndClass.lpszMenuName := nil;
if Winapi.Windows.RegisterClass(NewWndClass) = 0 then
raise Exception.Create(
'Unable to register hidden window class.' +
' Error: ' + SysErrorMessage(GetLastError));
end;
// Now we are sure the class is registered, we can create a window using it
FWinHandle := CreateWindowEx(WS_EX_TOOLWINDOW,
NewWndClass.lpszClassName,
'', // Window name
WS_POPUP, // Window Style
0, 0, // X, Y
0, 0, // Width, Height
0, // hWndParent
0, // hMenu
HInstance, // hInstance
nil); // CreateParam
if FWinHandle = 0 then
raise Exception.Create(
'Unable to create hidden window. ' +
' Error: ' + SysErrorMessage(GetLastError)); { V8.62 tell user real error. probably no memory }
// We have a window. In the associated data, we record a reference
// to our object. This will later allow to call the WndProc method to
// handle messages sent to the window.
{$IFDEF WIN64}
SetWindowLongPtr(FWinHandle, 0, INT_PTR(Self));
{$ELSE}
SetWindowLong(FWinHandle, 0, Longint(Self));
{$ENDIF}
finally
LeaveCriticalSection(GWndHandlerCritSect);
end;
end;
procedure TMyThread.DeallocateHWnd;
begin
if FWinHandle = 0 then
Exit; // Already done
{$IFDEF WIN64}
SetWindowLongPtr(FWinHandle, 0, 0);
{$ELSE}
SetWindowLong(FWinHandle, 0, 0);
{$ENDIF}
DestroyWindow(FWinHandle);
FWinHandle := 0;
end;
procedure TMyThread.Execute;
var
MsgRec : TMsg;
begin
// We cannot access the VCL from a thread, so use system function.
// The message will be shown in the debugger in the events view.
OutputDebugString('Thread Starting');
AllocateHWnd;
// Put a first message into the message queue
PostMessage(FWinHandle, WM_USER + 1, 0, 0);
// Message loop
// If GetMessage retrieves the WM_QUIT, the return value is FALSE and
// the message loop is broken.
while (not Terminated) and GetMessage(MsgRec, 0, 0, 0) do begin
TranslateMessage(MsgRec);
DispatchMessage(MsgRec)
end;
DeallocateHWnd;
OutputDebugString('Thread Ending');
end;
procedure TMyThread.WndProc(var MsgRec: TMessage);
begin
case MsgRec.Msg of
WM_USER + 1 : OutputDebugString('WM_USER + 1');
WM_USER + 2 : OutputDebugString('WM_USER + 2');
else
MsgRec.Result := DefWindowProc(FWinHandle, MsgRec.Msg,
MsgRec.wParam, MsgRec.lParam);
end;
end;
initialization
InitializeCriticalSection(GWndHandlerCritSect);
finalization
DeleteCriticalSection(GWndHandlerCritSect);
end.