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

我想在一个新线程中实现一个消息队列，就像主线程一样。我在这里找到了，但我不需要显示窗口。因此，示例中的

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, 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.

unitthreaddemomain；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.class、，
图形、控件、窗体、对话框、stdctrl；
类型
TMyThread=class（TThread）
私有的
FWinHandle:HWND；
程序分配wnd；事实上的
程序DeallocateHWnd；事实上的
程序WndProc（var MsgRec:TMessage）；事实上的
公众的
程序执行；推翻
属性WinHandle:HWND read FWinHandle；
结束；
tthreademoform=class（TForm）
开始线程按钮：t按钮；
备忘录1:TMemo；
停止线程按钮：t按钮；
PostMessageButton:TButton；
标签1:TLabel；
过程开始线程按钮单击（发送方：ToObject）；
过程FormClose（发送方：ToObject；var操作：TCloseAction）；
程序停止线程按钮单击（发送方：ToObject）；
过程PostMessageButton单击（发件人：ToObject）；
私有的
FWorkerThread:TMyThread；
程序WorkerThreadTerminate（发送方：ToObject）；
结束；
变量
ThreadDemoForm:tthreademoform；
实施
{$R*.dfm}
过程TThreadDemoForm.PostMessageButtonClick（发件人：ToObject）；
开始
如果未分配（FWorkerThread），则开始
Memo1.Lines.Add（'工作线程未运行'）；
出口
结束；
PostMessage（FWorkerThread.FWinHandle，WM_USER+2,0,0）；
结束；
过程TThreadDemoForm.StartThreadButtonClick（发送方：ToObject）；
开始
如果已分配（FWorkerThread），则开始
Memo1.Lines.Add（'工作线程已在运行'）；
出口
结束；
Memo1.Lines.Add（'Ask worker thread to start…'）；
FWorkerThread:=TMyThread.Create（TRUE）；
FWorkerThread.FreeOnTerminate:=真；
FWorkerThread.OnTerminate:=WorkerThreadTerminate；
FWorkerThread.启动；
结束；
过程TThreadDemoForm.StopThreadButton单击（发送方：ToObject）；
开始
如果未分配（FWorkerThread），则开始
Memo1.Lines.Add（'工作线程未运行'）；
出口
结束；
Memo1.Lines.Add（'请求工作线程终止…'）；
PostMessage（FWorkerThread.FWinHandle，WM_QUIT，0,0）；
结束；
过程TThreadDemoForm.FormClose（发送方：ToObject；变量操作：TCloseAction）；
开始
如果已分配（FWorkerThread），则开始
FWorkerThread.OnTerminate:=nil；//取消事件处理
//请求工作线程终止
PostMessage（FWorkerThread.FWinHandle，WM_QUIT，0,0）；
FWorkerThread:=零；
//让工作线程呼吸
睡眠（250）；
结束；
结束；
过程TThreadDemoForm.WorkerThreadTerminate（发送方：ToObject）；
开始
Memo1.Lines.Add（'Worker thread Terminated'）；
FWorkerThread:=零；
结束；
{TMyThread}
变量
GWndHandlerCritSect:TRTLCriticalSection；
常数
WorkerThreadWindowClassName='WorkerThreadWindowClass'；
//WndControlWindowsProc是用于消息处理的回调函数
函数WndControlWindowsProc(
ahWnd:HWND；
auMsg:UINT；
awParam:WPARAM；
alParam:LPARAM）：LRESULT；stdcall；
变量
对象：对象；
MsgRec:TMessage；
开始
//创建窗口时，我们存储了对对象的引用
//进入我们要求windows提供的存储空间
{$IFDEF WIN64}
对象：=TObject（GetWindowLongPtr（ahWnd，0））；
{$ELSE}
Obj:=TObject（GetWindowLong（ahWnd，0））；
{$ENDIF}
//检查引用是否实际上是我们的对象类型
如果不是（Obj是TMyThread），则
结果：=DefWindowProc（ahWnd、auMsg、awParam、alParam）
否则开始
//在内部，Delphi使用TMessage将参数传递给his
//消息处理程序。
MsgRec.Msg:=auMsg；
MsgRec.wParam:=awParam；
MsgRec.lParam:=alParam；
TMyThread（Obj）.WndProc（MsgRec）；
结果：=MsgRec.Result；
结束；
结束；
程序TMyThread.AllocateHWnd；
变量
临时班：TWndClass；
NewWndClass:TWndClass；
类注册：布尔；
开始
//如果已创建隐藏窗口，则无需执行任何操作
如果FWinHandle为0，则
出口
//我们使用临界部分来确保只有一个线程可以检查
//类进行注册，并在需要时进行注册。
//我们还必须确保该类没有被其他类注销
//刚刚破坏前一个窗口的线程。
肠危重科（GWndHandlerCritSect）；
尝试
//检查窗口类是否已注册
NewWndClass.hInstance:=hInstance；
NewWndClass.lpszClassName:=WorkerThreadWindowClassName；
ClassRegistered:=GetClassInfo（HInstance，