program Projekt1;
uses
SysUtils, Windows, Messages, Classes;
type TMyApp = Class
FWnd: HWND;
Constructor Create;
Destructor Destroy; override;
Procedure WndProc(var Msg: TMessage);
end;
{ TMyApp }
Constructor TMyApp.create;
begin
FWnd := AllocateHWnd(WndProc); //unsichtbares Fenster erzeugen
end;
Destructor TMyApp.Destroy;
begin
DeallocateHWnd(FWnd);
inherited;
end;
procedure TMyApp.WndProc(var Msg: TMessage);
begin
//hier kommen die Messages an (SendMessage direkt, PostMessage über Funktion DispatchMessage)
case Msg.Msg of
WM_USER: case Msg.WParam of
1: Messagebox(FWnd, 'catched WM_USER Msg!', 'PostMessage Catched', MB_ICONINFORMATION or MB_OK);
2: Messagebox(FWnd, 'catched WM_USER Msg!', 'SendMessage Catched', MB_ICONINFORMATION or MB_OK);
else Messagebox(FWnd, 'catched WM_USER Msg!', 'Unknown Message Catched', MB_ICONINFORMATION or MB_OK);
end;
WM_QUIT: case Msg.WParam of
1: Messagebox(FWnd, 'catched WM_QUIT Msg!', 'PostMessage Catched', MB_ICONWARNING or MB_OK);
2: Messagebox(FWnd, 'catched WM_QUIT Msg!', 'SendMessage Catched', MB_ICONWARNING or MB_OK);
else Messagebox(FWnd, 'catched WM_QUIT Msg!', 'Unknown Message Catched', MB_ICONWARNING or MB_OK);
end;
end; // case
Dispatch(Msg); // Das besagt das Msg abgearbeitet wurde und aus der Queue entfernt wird.
end;
function ThreadProc(Wnd :HWND): Integer;
begin
Sleep(50);
PostMessage(Wnd, WM_USER, 1, 0);
SendMessage(Wnd, WM_USER, 2, 0);
Sleep(5000);
PostMessage(Wnd, WM_QUIT, 1, 0); //Programm beenden
SendMessage(Wnd, WM_QUIT, 2, 0); //Programm beenden
Sleep(1000);
end;
procedure Start;
var
Msg: TMsg;
App: TMyApp;
Id: Cardinal;
begin
App := TMyapp.Create;
CloseHandle(BeginThread(nil, 0, @ThreadProc, Pointer(App.FWnd), 0, Id));
while GetMessage(Msg, 0, 0, 0) do //auf message in der Queue warten
begin
//Message an Fenster verteilen
DispatchMessage(Msg);
end;
App.Free;
end;
begin
Start;
end.