Создание невиз. компонента

← →
Dr. Genius (2005-09-05 16:50) [0]

Заинтересовался недавно созданием собственных компонент в Delphi. Пишу сейчас компонент для перехвата системных WM-сообщений Windows – таких как WM_HOTKEY, WM_QUERYENDSESSION, WM_SYSTEMERROR и др. Но компонент не перехватывает события. Ниже выложен текст модуля компонента.
Бросаю я свой компонент на форму, обрабатываю событие OnHotKey. Запускаю свой проект. Событие перехвата нажатия «горячей» клавиши не работает. Точно так же не работает событие перехвата OnQueryEndSession. Событие OnSystemError я не тестировал, но понятно, что и оно наверняка не будет работать. В чем проблема? Почему не перехватываются WM-сообщения.
Я выложил текст модуля целиком, т. к. может быть в нем есть ещё ошибки. Заниматься созданием компонентов я начал всего пару дней назад и ещё плохо разбираюсь в этом. Поэтому не исключено, что в модуле есть и другие ошибки, или я что-то сделал не так. Сообщите, если заметите.

unit Eventio; interface uses Windows, Messages, SysUtils, Classes; type THotKeyEvent = procedure (var Msg: TWMHotKey) of object; TQueryEndSessionEvent = procedure (var Msg: TWMQueryEndSession) of object; TSystemErrorEvent = procedure (var Msg: TWMSystemError) of object; TEventio = class (TComponent) private { Private declarations } FHotKey: THotKeyEvent; FQueryEndSession: TQueryEndSessionEvent; FSystemError: TSystemErrorEvent; function GetVersion: String; procedure SetVersion (const Value: String); procedure WMHotKey (var Msg: TWMHotKey); message WM_HOTKEY; procedure WMQueryEndSession (var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; procedure WMSystemError (var Msg: TWMSystemError); message WM_SYSTEMERROR; protected { Protected declarations } public { Public declarations } constructor Create (AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property Version: String read GetVersion write SetVersion stored False; property OnHotKey: THotKeyEvent read FHotKey write FHotKey; property OnQueryEndSession: TQueryEndSessionEvent read FQueryEndSession write FQueryEndSession; property OnSystemError: TSystemErrorEvent read FSystemError write FSystemError; end; procedure Register; implementation constructor TEventio.Create (AOwner: TComponent); begin inherited Create (AOwner); end; //----------------------------------------------------------- destructor TEventio.Destroy; begin inherited Destroy; end; //----------------------------------------------------------- function TEventio.GetVersion: String; begin Result := "1.0"; end; //----------------------------------------------------------- procedure TEventio.SetVersion (const Value: String); begin end; //----------------------------------------------------------- procedure TEventio.WMHotKey (var Msg: TWMHotKey); begin if Assigned (FHotKey) then FHotKey (Msg); end; //----------------------------------------------------------- procedure TEventio.WMQueryEndSession (var Msg: TWMQueryEndSession); begin if Assigned (FQueryEndSession) then FQueryEndSession (Msg); end; //----------------------------------------------------------- procedure TEventio.WMSystemError (var Msg: TWMSystemError); begin if Assigned (FSystemError) then FSystemError (Msg); end; //----------------------------------------------------------- procedure Register; begin RegisterComponents ("Dr. Genius", [TEventio]); end; //----------------------------------------------------------- end.

← →
Digitman © (2005-09-05 16:56) [1]

а где собственно перехват-то ?

← →
Джо © (2005-09-05 16:58) [2]

Волшебства не бывает. С какого перепугу вашему невизуальному компоненту будут приходить все эти сообщения?

← →
Джо © (2005-09-05 16:59) [3]

Один из возможных путей - замена оконной процедуры на свою.

← →
Dr. Genius (2005-09-05 17:21) [4]

> Один из возможных путей - замена оконной процедуры на свою.

Не понял...

← →
Digitman © (2005-09-05 17:26) [5]

может тебе книжки какие-нть умные почитать для начала ?

в 2-х словах ведь не объяснить, что такое "оконная процедура" и с чем ее едят ..

← →
Джо © (2005-09-05 17:27) [6]

> [4] Dr. Genius (05.09.05 17:21)
> Не понял...

Что же сделать? Предлагаю разобраться для начала в том, что есть "сообщение". Перед тем, как их "перехватывать".

← →
Dr. Genius (2005-09-05 17:35) [7]

> Что же сделать? Предлагаю разобраться для начала в том,
> что есть "сообщение". Перед тем, как их "перехватывать".

> Волшебства не бывает. С какого перепугу вашему невизуальному
> компоненту будут приходить все эти сообщения?

Так хотя бы скажите: можно ли невизуальным компонентом перехватывать сообщения windows.

← →
Dr. Genius (2005-09-05 17:41) [8]

Я в своей программе вручную перехватываю и обрабатываю такие сообщения как WM_HOTKEY, WM_QUERYENDSESSION. Но мне хочется сделать компонент для этого. Что такое сообщение Windows я знаю, иначе я бы не брался за создание компонента для их перехвата.

← →
Джо © (2005-09-05 17:46) [9]

> [7] Dr. Genius (05.09.05 17:35)
> Так хотя бы скажите: можно ли невизуальным компонентом перехватывать
> сообщения windows.

Вопрос некорректно поставлен, что тут можно ответить? Сначала необходимо разобраться в том, что есть "сообщение". Если ты этого не понимаешь, то как можно его "перехватывать"?
С одной стороны - да, можно, в некотором смысле. Так, как, например некоторые сообщения "перехватывает" невизуальный компонент TApplicationEvent (смотри исходный код).
С другой стороны - нет, нельзя. Потому как для того, чтобы нечто "перехватить" необхоимо, чтобы тебе это нечто "посылалос". Опять же, ключевой вопрос - "С какого перепугу вашему невизуальному компоненту будут приходить все эти сообщения"?
Следовательно, сначала нужно добиться того, чтобы этому компоненту приходили какие-то там "сообщения". А для этого нужно понимать механизм сообщений вообще и специфику их обработки в Делфи.

← →
Джо © (2005-09-05 17:48) [10]

[8] Dr. Genius (05.09.05 17:41)
> Что такое сообщение Windows я знаю

Ну, тогда должен знать что такое "оконная процедура". Иначе - ложь.

← →
Юрий Зотов © (2005-09-05 17:52) [11]

> Dr. Genius (05.09.05 17:41) [8]

В Вашем коде нет никакого перехвата сообщений, а есть только их обработка. Но чтобы сообщение можно было обработать, его сначала надо получить, так ведь? А Windows рассылает сообщения только окнам и ни о каких компонентах не имеет ни малейшего понятия. Ваш же компонент окна не содержит и, соответственно, никаких сообщений не получает.

> Что такое сообщение Windows я знаю

Вряд ли это так, раз Вы надеялись перехватить этим кодом какие-то сообщения, да еще и спрашиваете, что такое оконная функция.

← →
Digitman © (2005-09-05 17:54) [12]

> можно ли невизуальным компонентом перехватывать сообщения
> windows

можно.

> в своей программе вручную перехватываю и обрабатываю такие
> сообщения как WM_HOTKEY, WM_QUERYENDSESSION

вручную это как ?

> Что такое сообщение Windows я знаю

тогда ты должен знать и то, что сообщения эти посылаются не в пустоту , а окну-адресату (или группе окон-адресатов)

у тебя же в коде твоего компонента нет никаких окон, зато окно обязательно есть у объекта Application твоего ехе-приложения

с этим окном, как и прочими окнами, при его создании была ассоциирована оконная функция, которую ОС вызывает всякий раз для обработки поступившего в адрес этого окна сообщения

перехват в дан.случае сводится к подмене адреса этой ф-ции на адрес своей ф-ции, определенной в юните твоего компонента

установка нового адреса оконной ф-ции сводится к вызову ф-ции SetWindowLong()

> Dr. Genius (05.09.05 17:35) [7]

> Так хотя бы скажите: можно ли невизуальным компонентом
> перехватывать сообщения windows.

Можно, несмотря на все сказанное выше. Только не самим компонентом, а опосредованно. Если нужно перехватывать сообщения только одного конкретного окна, то можно подменить его оконную функцию своей; если же интересует перехват сообщений всех окон, то можно установить хук, а в нем вызывать метод Dispatch компонента.

← →
Dr. Genius (2005-09-06 09:15) [14]

> если же интересует перехват сообщений всех окон, то можно
> установить хук, а в нем вызывать метод Dispatch компонента.

А можно ли небольшой пример перехвата одного из каких-нибудь сообщений. Мне бы разобраться на примере перехвата одного сообщения (ну, например, WM_QUERYENDSESSION – его Windows рассылает всем запущенным приложениям, когда пользователь завершает сессию Windows). А дальше я сам все сделаю с остальными.

> Dr. Genius (06.09.05 09:15) [14]

Что-то типа этого (в работе не проверял).
unit YzHook; interface uses Windows, Messages, SysUtils, Classes; type TYzHook = class; TYzMessageEvent = procedure(Sender: TYzHook; Wnd: HWND; const Msg: TMessage) of object; TYzHook = class(TComponent) private FOnMessage: TYzMessageEvent; protected procedure DoMessage(Wnd: HWND; const Msg: TMessage); dynamic; public class function NewInstance: TObject; override; procedure FreeInstance; override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnMessage: TYzMessageEvent read FOnMessage write FOnMessage; end; implementation var HookInstance: TObject = nil; HookHandle: HHOOK = 0; function HookProc(Code: integer; WParam, LParam: LongInt): LongInt; stdcall; var Msg: TMessage; begin with PCWPStruct(LParam)^ do try Msg.Msg := message; Msg.WParam := wParam; Msg.LParam := lParam; TYzHook(HookInstance).DoMessage(hwnd, Msg) finally Result := CallNextHookEx(HookHandle, Code, WParam, LParam) end end; { TYzHook } constructor TYzHook.Create(AOwner: TComponent); begin inherited; if not (csDesigning in ComponentState) then begin HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @HookProc, 0, MainThreadID); Win32Check(HookHandle <> 0) end end; destructor TYzHook.Destroy; begin inherited; if HookHandle <> 0 then Win32Check(UnhookWindowsHookEx(HookHandle)) end; procedure TYzHook.DoMessage(Wnd: HWND; const Msg: TMessage); begin if Assigned(FOnMessage) then FOnMessage(Self, Wnd, Msg) end; procedure TYzHook.FreeInstance; begin HookInstance := nil; inherited end; class function TYzHook.NewInstance: TObject; begin if HookInstance = nil then HookInstance := inherited NewInstance; Result := HookInstance end; end.

Подправил плюшки. Вот работающий компонент. Очень простой, как видите.
unit YzHook; interface uses Windows, Messages, SysUtils, Classes; type TYzHook = class; TYzMessageEvent = procedure(Sender: TYzHook; Wnd: HWND; const Msg: TMessage) of object; TYzHook = class(TComponent) private FOnMessage: TYzMessageEvent; protected procedure DoMessage(Wnd: HWND; const Msg: TMessage); dynamic; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnMessage: TYzMessageEvent read FOnMessage write FOnMessage; end; implementation var HookInstance: TYzHook; HookHandle: HHOOK = 0; function HookProc(Code: integer; WParam, LParam: LongInt): LongInt; stdcall; var Msg: TMessage; begin with PCWPStruct(LParam)^ do try Msg.Msg := message; Msg.WParam := wParam; Msg.LParam := lParam; HookInstance.DoMessage(hwnd, Msg) finally Result := CallNextHookEx(HookHandle, Code, WParam, LParam) end end; { TYzHook } constructor TYzHook.Create(AOwner: TComponent); begin if HookInstance <> nil then raise Exception.CreateFmt("Component %s already exists", [ClassName]); inherited; if not (csDesigning in ComponentState) then begin HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @HookProc, 0, MainThreadID); Win32Check(HookHandle <> 0) end; HookInstance := Self end; destructor TYzHook.Destroy; begin inherited; if HookInstance = Self then begin HookInstance := nil; if HookHandle <> 0 then begin Win32Check(UnhookWindowsHookEx(HookHandle)); HookHandle := 0 end end end; procedure TYzHook.DoMessage(Wnd: HWND; const Msg: TMessage); begin if Assigned(FOnMessage) and not (csLoading in ComponentState) then FOnMessage(Self, Wnd, Msg) end; end.

← →
Dr. Genius (2005-09-08 11:05) [17]

Огромное спасибо Вам, Юрий Зотов!

Создание невиз. компонента Найти похожие ветки