Кот схватил мышку за хвост...
... и своротил со стола комп!
{*************************************************************************}{
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(varMessage : TMessage) : Boolean ofobject;
{*************************************************************************}unit MessageReceiver;
interfaceuses
Windows, Messages, SysUtils, Classes, Forms, Dialogs;
type
TOnReceiveUserMessage = procedure(Msg: Cardinal; wParam, lParam: Integer;
var Handled: Boolean) ofobject;
TOnReceiveOtherMessage = procedure(var Handled: Boolean) ofobject;
TMessageReceiver = class(TComponent)
private{ Private declarations }
FHooked: Boolean;
FOnReceiveUserMessage: TOnReceiveUserMessage;
FOnDateTimeChange: TOnReceiveOtherMessage;
function MessageHook(var Msg: TMessage): Boolean;
protectedfunction 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;
procedureRegister;
implementationprocedureRegister;
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);
begininherited Create(AOwner);
FHooked := False;
ifnot (csDesigning in ComponentState) thenbegin
Application.HookMainWindow(MessageHook);
FHooked := True;
end;
end;
destructor TMessageReceiver.Destroy;
beginif FHooked then Application.UnhookMainWindow(MessageHook);
inherited Destroy;
end;
end.
Статья Отловить сообщение в компоненте раздела ОС и Железо Сообщения Windows может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.