Marus Gradinaru
Reputation: 3022
How to implement a simple message queue?
I want to implement a message queue in a new thread, just like main thread is. I found here an example but I don't need to display a window. So, RegisterClass and CreateWindow from the exemple, are not needed for me. I don't have that info to pass to those procedures, anyway. I just want to register a window procedure AllocateHWnd(PrivateWndProc); and then make a loop with GetMessage and DispatchMessage. I don't know if this makes sense...
Upvotes: 0
Views: 1604
Answers (1)
fpiette
Reputation: 12292
I built a demo to show you how to create a worker thread which works mostly like the main thread.
To use the demo, create a form with 3 buttons and a memo. Then paste the code below. Look at the names I gave to the components to do the same and associate correct event handlers.
You may want to add more error checking. I made some shortcuts to make code easier to read. You should probably check everything which could fail.
In a real application, if you have several worker threads, derive all thread from my TMyThread class so that they inherit the message queue and message pump.
Since a thread cannot access the VCL and to keep things simple, I made the worker thread display messages using OutputDebugString. The messages are shown in the event view (Ctrl+Alt+V) when you run the demo under Delphi debugger.
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.
Upvotes: 4