Delphi World - Отловить сообщение в компоненте
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Отловить сообщение в компоненте

Кот схватил мышку за хвост...
... и своротил со стола комп!


{*************************************************************************}

{ 
  TApplication besitzt eine Methode HookMainWindow. 
  Damit kann man in die Windows Prozedur (WndProc) "einhaken" und Nachrichten, 
  welche an die Applikation geschickt werden, abfangen und behandeln. 

  HookMainWindow is wie folgt deklariert: 
} 

procedure HookMainWindow(Hook : TWindowHook); 

{ Und der Parameter TWindowHook (Methoden Pointer) so: } 

type 
  TWindowHook = function(var Message : TMessage) : Boolean of object; 
 

{*************************************************************************} 

unit MessageReceiver; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Forms, Dialogs; 

type 
  TOnReceiveUserMessage = procedure(Msg: Cardinal; wParam, lParam: Integer; 
    var Handled: Boolean) of object; 
  TOnReceiveOtherMessage = procedure(var Handled: Boolean) of object; 

  TMessageReceiver = class(TComponent) 
  private 
    { Private declarations } 
    FHooked: Boolean; 

    FOnReceiveUserMessage: TOnReceiveUserMessage; 
    FOnDateTimeChange: TOnReceiveOtherMessage; 

    function MessageHook(var Msg: TMessage): Boolean; 
  protected 
    function DoDateTimeChange(Msg: TMessage): Boolean; dynamic; 
    function DoUserMessage(Msg: TMessage): Boolean; dynamic; 
  public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
  published 
    { Published declarations } 
    property OnDateTimeChange: TOnReceiveOtherMessage 
      read FOnDateTimeChange write FOnDateTimeChange; 
    property OnReceiveUserMessage: TOnReceiveUserMessage 
      read FOnReceiveUserMessage write FOnReceiveUserMessage; 
  end; 
   
procedure Register; 

implementation 

procedure Register; 
begin 
  RegisterComponents('System', [TMessageReceiver]); 
end; 

function TMessageReceiver.MessageHook(var Msg: TMessage): Boolean; 
begin 
  Result := False; 
  // User defined messages 
  if (Msg.Msg >= WM_USER) then 
    Result := DoUserMessage(Msg) 
  else 
    // Other messages 
    case Msg.Msg of 
      WM_TIMECHANGE: Result := DoDateTimeChange(Msg); 
      // ... 
    end; 
end; 

function TMessageReceiver.DoDateTimeChange(Msg : TMessage): Boolean; 
begin 
  Result := False; 
  if Assigned(FOnDateTimeChange) then 
    FOnDateTimeChange(Result); 
end; 

function TMessageReceiver.DoUserMessage(Msg: TMessage): Boolean; 
begin 
  Result := False; 
  if Assigned(FOnReceiveUserMessage) then 
    FOnReceiveUserMessage(Msg.Msg, Msg.wParam, Msg.LParam, Result); 
end; 

constructor TMessageReceiver.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FHooked := False; 
  if not (csDesigning in ComponentState) then 
  begin 
    Application.HookMainWindow(MessageHook); 
    FHooked := True; 
  end; 
end; 

destructor TMessageReceiver.Destroy; 
begin 
  if FHooked then Application.UnhookMainWindow(MessageHook); 
  inherited Destroy; 
end; 

end.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования