unit Main;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
const
MyMesage =
{WM_QUIT} WM_USER;
//test also WM_USER message to see the full functionality
type
TMainForm =
class(TForm)
SendBtn: TButton;
PostBtn: TButton;
procedure SendBtnClick(Sender: TObject);
procedure PostBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
OldWndProc: Pointer;
WndProcPtr: Pointer;
procedure HandleAppIdleState(Sender: TObject;
var Done: Boolean);
procedure WndMethod(
var Msg: TMessage);
procedure HandleAppMessage(
var Msg: TMsg;
var Handled: Boolean);
procedure AppDeactivate(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
var
WProc: Pointer;
function NewWndProc(
Handle: hWnd; Msg, wParam, lParam: Longint): Longint;
stdcall;
{Description:
This is a Win32 API-level window procedure. It handles the messages
received by the Application window.
}
begin
{If it's our user-defined message, then alert the user.
}
if Msg = MyMesage
then
MessageBox(0, PChar(Format('
Message seen by NewWndProc! Value is: %u', [Msg])),
PChar('
Check WM_QUIT Message'), MB_OK);
{Pass message on to old window procedure
}
Result := CallWindowProc(WProc,
Handle, Msg, wParam, lParam);
end;
procedure TMainForm.HandleAppMessage(
var Msg: TMsg;
var Handled: Boolean);
{Description:
OnMessage handler for Application object.
}
begin
{if it's the user-defined message, then alert the user.
}
if Msg.
Message = MyMesage
then
MessageBox(0, PChar(Format('
Message seen by OnMessage! Value is: %u', [Msg.
Message])),
PChar('
Check WM_QUIT Message'), MB_OK);
end;
procedure TMainForm.WndMethod(
var Msg: TMessage);
begin
{if it's the user-defined message, then alert the user.
}
if Msg.Msg = MyMesage
then
MessageBox(0, PChar(Format('
Message seen by WndMethod! Value is: %u', [Msg.Msg])),
PChar('
Check WM_QUIT Message'), MB_OK);
{Pass message on to old window procedure.
}
with Msg
do
Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam, lParam);
end;
procedure TMainForm.HandleAppIdleState(Sender: TObject;
var Done: Boolean);
var Msg: TMsg;
begin
{Get the message from the queue.
}
if PeekMessage(Msg, 0, 0, 0, PM_NoREMOVE)
then
begin
if Msg.
Message = MyMesage
then
MessageBox(0, PChar(Format('
Message seen by HandleAppIdleState! Value is: %u', [Msg.
Message])),
PChar('
Check WM_QUIT Message'), MB_OK);
end;
end;
procedure TMainForm.AppDeactivate(Sender: TObject);
begin
if Application.Terminated
then
MessageBox(0, PChar('
Message seen by AppDeactivate! WM_QUIT'),
PChar('
Check WM_QUIT Message'), MB_OK);
end;
procedure TMainForm.SendBtnClick(Sender: TObject);
begin
{The SendMessage function sends the specified message to a window or windows. The
function calls the window procedure for the specified window and does not return
until the window procedure has processed the message. The PostMessage function, in
contrast, posts a message to a thread's message queue and returns immediately.
}
SendMessage(Application.Handle, MyMesage
{WM_QUIT}, 0, 0);
end;
procedure TMainForm.PostBtnClick(Sender: TObject);
begin
{The PostMessage function places (posts) a message in the message queue associated
with the thread that created the specified window and then returns without waiting
for the thread to process the message.
}
PostMessage(Application.Handle, MyMesage
{WM_QUIT}, 0, 0);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnDeactivate := AppDeactivate;
Application.OnIdle := HandleAppIdleState;
Application.OnMessage := HandleAppMessage;
// set OnMessage handler
WndProcPtr := MakeObjectInstance(WndMethod);
// make window proc
{Set window procedure of application window.
}
OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,
Integer(WndProcPtr)));
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if Application.Terminated
then
MessageBox(0, PChar('
Message seen by FormDestroy! WM_QUIT'),
PChar('
Check WM_QUIT Message'), MB_OK);
{Restore old window procedure for Application window
}
SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
{Free our user-created window procedure
}
FreeObjectInstance(WndProcPtr);
end;
initialization
{Set window procedure of Application window.
}
WProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,
Integer(@NewWndProc)));
end.