Поймать сообщение



Автор: Xavier Pacheco

unit CIMain;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Menus;
const
SX_MYMESSAGE = WM_USER; // User-defined message value
MessString = '%s message now in %s.'; // String to alert user of message
type
TMainForm = class(TForm)
GroupBox1: TGroupBox;
PostMessButton: TButton;
WndProcCB: TCheckBox;
MessProcCB: TCheckBox;
DefHandCB: TCheckBox;
SendMessButton: TButton;
AppMsgCB: TCheckBox;
EatMsgCB: TCheckBox;
EatMsgGB: TGroupBox;
OnMsgRB: TRadioButton;
WndProcRB: TRadioButton;
MsgProcRB: TRadioButton;
DefHandlerRB: TRadioButton;
procedure PostMessButtonClick(Sender: TObject);
procedure SendMessButtonClick(Sender: TObject);
procedure EatMsgCBClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AppMsgCBClick(Sender: TObject);
private
{ Handles messages at Application level }
procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
{ Handles messages at WndProc level }
procedure WndProc(var Msg: TMessage); override;
{ Handles message after dispatch }
procedure SXMyMessage(var Msg: TMessage); message SX_MYMESSAGE;
{ Default message handler }
procedure DefaultHandler(var Msg); override;
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
const
// strings which will indicate to user whether a message is sent or posted
SendPostStrings: array[0..1] of string = ('Sent', 'Posted');
procedure TMainForm.FormCreate(Sender: TObject);
{ OnCreate handler for main form }
begin
// set OnMessage to my OnAppMessage method
Application.OnMessage := OnAppMessage;
// use the Tag property of checkboxes to store a reference to their
// associated radio buttons
AppMsgCB.Tag := Longint(OnMsgRB);
WndProcCB.Tag := Longint(WndProcRB);
MessProcCB.Tag := Longint(MsgProcRB);
DefHandCB.Tag := Longint(DefHandlerRB);
// use the Tag property of radio buttons to store a reference to their
// associated checkbox
OnMsgRB.Tag := Longint(AppMsgCB);
WndProcRB.Tag := Longint(WndProcCB);
MsgProcRB.Tag := Longint(MessProcCB);
DefHandlerRB.Tag := Longint(DefHandCB);
end;
procedure TMainForm.OnAppMessage(var Msg: TMsg; var Handled: Boolean);
{ OnMessage handler for Application }
begin
// check to see if message is my user-defined message
if Msg.Message = SX_MYMESSAGE then
begin
if AppMsgCB.Checked then
begin
// Let user know about the message.  Set Handled flag appropriately
ShowMessage(Format(MessString, [SendPostStrings[Msg.WParam],
'Application.OnMessage']));
Handled := OnMsgRB.Checked;
end;
end;
end;
procedure TMainForm.WndProc(var Msg: TMessage);
{ WndProc procedure of form }
var
CallInherited: Boolean;
begin
CallInherited := True; // assume we will call the inherited
if Msg.Msg = SX_MYMESSAGE then // check for our user-defined message
begin
if WndProcCB.Checked then // if WndProcCB checkbox is checked...
begin
// Let user know about the message.
ShowMessage(Format(MessString, [SendPostStrings[Msg.WParam], 'WndProc']));
// Call inherited only if we are not supposed to eat the message.
CallInherited := not WndProcRB.Checked;
end;
end;
if CallInherited then
inherited WndProc(Msg);
end;
procedure TMainForm.SXMyMessage(var Msg: TMessage);
{ Message procedure for user-defined message }
var
CallInherited: Boolean;
begin
CallInherited := True; // assume we will call the inherited
if MessProcCB.Checked then // if MessProcCB checkbox is checked...
begin
// Let user know about the message.
ShowMessage(Format(MessString, [SendPostStrings[Msg.WParam],
'Message Procedure']));
// Call inherited only if we are not supposed to eat the message.
CallInherited := not MsgProcRB.Checked;
end;
if CallInherited then
inherited;
end;
procedure TMainForm.DefaultHandler(var Msg);
{ Default message handler for form }
var
CallInherited: Boolean;
begin
CallInherited := True; // assume we will call the inherited
if TMessage(Msg).Msg = SX_MYMESSAGE then // check for our user-defined message
begin
if DefHandCB.Checked then // if DefHandCB checkbox is checked...
begin
// Let user know about the message.
ShowMessage(Format(MessString, [SendPostStrings[TMessage(Msg).WParam],
'DefaultHandler']));
// Call inherited only if we are not supposed to eat the message.
CallInherited := not DefHandlerRB.Checked;
end;
end;
if CallInherited then
inherited DefaultHandler(Msg);
end;
procedure TMainForm.PostMessButtonClick(Sender: TObject);
{ posts message to form }
begin
PostMessage(Handle, SX_MYMESSAGE, 1, 0);
end;
procedure TMainForm.SendMessButtonClick(Sender: TObject);
{ sends message to form }
begin
SendMessage(Handle, SX_MYMESSAGE, 0, 0); // send message to form
end;
procedure TMainForm.AppMsgCBClick(Sender: TObject);
{ enables/disables proper radio button for checkbox click }
begin
if EatMsgCB.Checked then
begin
with TRadioButton((Sender as TCheckBox).Tag) do
begin
Enabled := TCheckbox(Sender).Checked;
if not Enabled then
Checked := False;
end;
end;
end;
procedure TMainForm.EatMsgCBClick(Sender: TObject);
{ enables/disables radio buttons as appropriate }
var
i: Integer;
DoEnable, EatEnabled: Boolean;
begin
// get enable/disable flag
EatEnabled := EatMsgCB.Checked;
// iterate over child controls of GroupBox in order to
// enable/disable and check/uncheck radio buttons
for i := 0 to EatMsgGB.ControlCount - 1 do
with EatMsgGB.Controls[i] as TRadioButton do
begin
DoEnable := EatEnabled;
if DoEnable then
DoEnable := TCheckbox(Tag).Checked;
if not DoEnable then
Checked := False;
Enabled := DoEnable;
end;
end;
end.

Далее: Получить сообщение о переключении сессии в XP »»