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

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

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

解决方法

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

要使用演示，请创建一个带有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);
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);
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,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,'',// Window name
                                     WS_POPUP,// Window Style
                                     0,// X,Y
                                     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,INT_PTR(Self));
    {$ELSE}
        SetWindowLong(FWinHandle,Longint(Self));
    {$ENDIF}
    finally
        LeaveCriticalSection(GWndHandlerCritSect);
    end;
end;

procedure TMyThread.DeallocateHWnd;
begin
    if FWinHandle = 0 then
        Exit;              // Already done
{$IFDEF WIN64}
    SetWindowLongPtr(FWinHandle,0);
{$ELSE}
    SetWindowLong(FWinHandle,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);

    // 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) 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.