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

Delphi , ОС и Железо , Сообщения Windows

Автор: 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.

Это приложение на языке Delphi, демонстрирующее обработку Windows-сообщений на различных уровнях, включая уровень приложения, уровень формы и уровень процедуры сообщения. Программа предоставляет чекбоксы и радиobuttons для пользователей выбрать, хотят ли они обрабатывать сообщение на каждом уровне.

Содержание кода:

1. Класс TMainForm наследуется от TForm и имеет несколько компонентов: GroupBox1, PostMessButton, WndProcCB, MessProcCB, DefHandCB, SendMessButton, AppMsgCB, EatMsgGB, OnMsgRB, WndProcRB, MsgProcRB и DefHandlerRB.
2. Процедура PostMessButtonClick отправляет сообщение на форму с помощью PostMessage.
3. Процедура SendMessButtonClick отправляет сообщение на форму с помощью SendMessage.
4. Процедура OnAppMessage обрабатывает сообщения на уровне приложения. Если сообщение - пользовательское (SX_ MYMESSAGE), она отображает сообщение в окне и устанавливает флаг обработки в зависимости от состояния радиobutton OnMsgRB.
5. Процедура WndProc обрабатывает сообщения на уровне формы. Если сообщение - пользовательское, она отображает сообщение в окне и вызывает наследуемую процедуру WndProc только если не выбран radiobutton WndProcRB.
6. Процедура SXMyMessage обрабатывает сообщения в процедуре сообщения. Если сообщение - пользовательское, она отображает сообщение в окне и вызывает наследуемую процедуру только если не выбран radiobutton MsgProcRB.
7. Процедура DefaultHandler обрабатывает сообщения на уровне формы с помощью стандартного обработчика сообщений. Если сообщение - пользовательское, она отображает сообщение в окне и вызывает наследуемую процедуру DefaultHandler только если не выбран radiobutton DefHandlerRB.
8. Процедуры AppMsgCBClick, EatMsgCBClick, PostMessButtonClick и SendMessButtonClick обрабатывают события для чекбоксов, кнопок и радиobuttons.

Код предоставляет простой способ понять, как сообщения обрабатываются на различных уровнях в приложениях Delphi. Он может быть полезен для разработчиков, которые хотят узнать больше о обработке сообщений в Delphi или нуждаются в референтном примере для своих проектов.

В статье описана реализация обработки сообщений в приложении Delphi, демонстрирующая различные способы их обработки на уровне приложения, wndproc и message procedure.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Сообщения Windows ::