如何实现一个简单的消息队列

Question

我想在一个新线程中实现一个消息队列，就像主线程一样。我在这里找到了一个例子，但我不需要显示窗口。所以，示例中的RegisterClass和CreateWindow对我来说是不需要的。无论如何，我没有这些信息可以传递给这些过程。我只想注册一个窗口过程AllocateHWnd(PrivateWndProc);，然后用GetMessage和DispatchMessage进行循环。我不知道这是否有意义。。。

Answer 1

我构建了一个演示，向您展示如何创建一个工作线程，它的工作方式与主线程非常相似。

要使用演示，请创建一个包含3个按钮和一个备忘录的表单。然后粘贴下面的代码。查看我为组件指定的名称，以便执行相同的操作并关联正确的事件处理程序。

您可能需要添加更多的错误检查。我制作了一些快捷方式，使代码更易于阅读。你可能应该检查所有可能失败的东西。

在实际应用程序中，如果您有多个工作线程，请从TMyThread类派生所有线程，以便它们继承消息队列和消息泵。

由于线程无法访问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.