| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

WinApi [D6, Win95/98]

W00dy ©   (2004-12-04 07:40:00) 

Как переопределить обработчик событий для чужого окна имея только его хендл. Киньте пример.

---

Leonid Troyanovsky   (2004-12-04 19:56:00) [1]

> W00dy ©   (04.12.04 07:40)  
> Как переопределить обработчик событий для чужого окна имея
> только его хендл. Киньте пример.


Например, сабклассируем EDIT у блокнота.


procedure TForm1.Button1Click(Sender: TObject);
var
 h: HWND;
 lib: THandle;
 f: procedure (control: HWND; procidx: Word; param: DWord);
begin
 h := FindWindow('Notepad', nil);
 h := FindWindowEx(h, 0, 'EDIT', nil);
 lib := LoadLibrary('hksub.dll');
 Win32Check(lib <> 0);
 f := GetProcAddress(lib, 'SubClassControl');
 f(h, 1, Memo1.Handle);
 FreeLibrary(lib);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 h: HWND;
 lib: THandle;
 f: procedure (control: HWND; procidx: Word; param: DWord);
begin
 h := FindWindow('Notepad', nil);
 h := FindWindowEx(h, 0, 'EDIT', nil);
 lib := LoadLibrary('hksub.dll');
 Win32Check(lib <> 0);
 f := GetProcAddress(lib, 'SubClassControl');
 f(h, 0, 0);
 FreeLibrary(lib);
end;


-------------hksub.dpr----------------------

library hksub;

uses
 windows,
 messages;

const
 sPropOldWindowProc = 'OldWindowProc';
 sPropLib = 'lib';

var
 param : DWord = 0;
 oldwndproc: Pointer = nil;

function NewWndProc1(h: HWND; msg: UINT; wparam: WPARAM; lparam: LPARAM ):LResult; stdcall;
begin
 if msg = WM_CHAR then
   begin
     PostMessage(param, msg, wparam, lparam);
     Beep(1000, 55);
   end;
 Result := CallWindowProc(oldwndproc, h, msg, wparam, lparam);
end;

function hookproc(ncode: Longint; awparam:WPARAM; alparam:LPARAM):LResult;stdcall;
var
 msg: PCWPSTRUCT;
 buf: array [0..MAX_PATH] of Char;
 owp, nwp: Pointer;
 lib: THandle;
 hcontrol : HWND;
begin
Result := 0;
msg := PCWPSTRUCT(alparam);
if (msg.message = WM_NULL) then
   begin
     hcontrol := msg.hwnd;
     param := msg.lParam;
     owp := Pointer(GetProp(hcontrol, sPropOldWindowProc));

     if Assigned(owp) then
       begin
         SetWindowLong(hcontrol, GWL_WNDPROC, Longint(owp));
         RemoveProp(hcontrol, sPropOldWindowProc);
       end;

     if (msg.wParam = 0) then
       begin
         lib := GetProp(hcontrol, sPropLib);
         if lib <> 0 then
           FreeLibrary(lib);
         RemoveProp(hcontrol, sPropLib);
       end
     else
       begin
         nwp := GetProcAddress(Hinstance,PChar(MakeLong(msg.wParam, 0)));
         if not Assigned(nwp) then
           Exit;
         GetModuleFileName(Hinstance, buf, SizeOf(buf));
         lib := LoadLibrary(buf);
         SetProp(hcontrol, sPropLib, lib);
         owp := Pointer(GetWindowLong(hcontrol, GWL_WNDPROC));
         oldwndproc := owp;
         SetProp(hcontrol, sPropOldWindowProc, THandle(oldwndproc));
         SetWindowLong(hcontrol, GWL_WNDPROC, Longint(nwp));
       end;
   end;
end;

procedure SubClassControl(control:HWND; procidx: Word; param: LParam);
var
 tid : DWord;
 hk: HHOOK;
begin
 tid := GetWindowThreadProcessId(control);
 hk := SetWindowsHookEx(WH_CALLWNDPROC, hookproc, Hinstance, tid);
 SendMessage(control, WM_NULL, WPARAM(procidx), LPARAM(Param));
 UnhookWindowsHookEx(hk);
 SendMessage(control, WM_NULL, 0, 0);
end;

exports
 SubClassControl,
 NewWndProc1 index 1;

begin
end.

-------------EOF hksub.dpr----------------------

Что будет работать в 9x не уверен.

--
С уважением, LVT.

---

Xaker   (2004-12-04 12:28:00) [2]

пример (блокирока КАД)


function MyWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
ready:=false;
  if  msg=WM_HOTKEY then  begin
// Поймали HOTKEY CAD (CSE) - выводим сообщение на десктоп "Default" и затем выходим
if( MAKELONG( MOD_CONTROL or MOD_ALT, VK_DELETE ) = lParam )then
begin
MessageBoxEx(0,'Ctrl + Alt + Del','FIGA1', MB_DEFAULT_DESKTOP_ONLY, 0 );
result:= 0;
ready:=True;
end;

if( MAKELONG( MOD_CONTROL or  MOD_SHIFT, VK_ESCAPE ) = lParam ) then
begin
MessageBoxEx(0,'Ctrl + Shift + Esc','FIGA2', MB_DEFAULT_DESKTOP_ONLY, 0 );
result:= 0;
ready:=True;
end;
if not ready then result:= CallWindowProc(SavedProc, hWnd, Msg, wParam, lParam);
                            end
else  result:= CallWindowProc(SavedProc, hWnd, Msg, wParam, lParam);

end;

procedure SetWndProc(hWnd: HWND);
begin
SavedProc:= pointer(SetWindowLong(hWnd, GWL_WNDPROC, cardinal(@myWndProc)));
end;

procedure UnSetWndProc(hWnd: HWND);
begin
SavedProc:= pointer(SetWindowLong(hWnd, GWL_WNDPROC, cardinal(SavedProc)));
end;


---

Digitman   (2004-12-04 11:41:00) [3]

нужно в кодовом потоке, создавшем это окно, вызвать SetWindowLong

---

Наверх