Mouse/keyboard messages for activexcontainer?
lazarus / 34-Windows

----------------------------------------------------------------------
Timewarp · 2012-05-25 14:24

In Delphi I'm using application.onmessage like code bellow.

I know how to convert webbrowser <> activexcontainer stuff, but how to
capture all messages? Problem is there is no application.onmessage in
Lazarus?

Error: identifier idents no member "onmessage"

How should I implement this? (simplified delphi example) 

Code: [Select]application.onmessage:=MsgHandler;

procedure Tform1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
var HtmlElement: IHTMLElement;
iHTMLDoc: IHtmlDocument2;
MousePos: TPoint;
begin
 if Msg.message = WM_LBUTTONDOWN then
   begin
   if Supports(webbrowser1.Document, IHtmlDocument2, iHTMLDoc) then
    begin
     if GetCursorPos(MousePos) then
     begin
      MousePos := Webbrowser1.ScreenToClient(MousePos);
      HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X,
MousePos.Y);
      if Assigned(HtmlElement) then
         showmessage(htmlelement.outerHTML);
     end;
    end;
   end;
end;

Thanks for any suggestions!

----------------------------------------------------------------------
ludob · 2012-05-25 16:55

You can insert your own message handler as explained here:
http://wiki.freepascal.org/Win32/64_Interface#Processing_non-
user_messages_in_your_window.
The Delphi TMsg is split up in its uMsg,wParam,lParam components and
Handled is the return value of the callback function.

Edit: small mistake: the Handled parameter is not the return value of
the callback function. Handled is true means that the CallWindowProc
on PrevWndProc is not done, ie. the event handler doesn't chain to the
old event handler.

----------------------------------------------------------------------
Timewarp · 2012-05-25 19:02

I tried it already, but could not make it work. If you click form it
works, but if you click inside webpage, messages are not generated?

I also tried:
Code: [Select]type
  Tactivexcontainer = class(activexcontainer.TActivexcontainer)
    protected
     procedure WndProc(var AMsg: TMessage); override;
  end;

procedure Tactivexcontainer.WndProc(var AMsg: TMessage);
begin
   if aMsg.msg=WM_LBUTTONDOWN then showmessage('Works')
   else inherited;
end;

Compiles, but doesn't work

----------------------------------------------------------------------
ludob · 2012-05-25 19:48

The problem is that there is no direct hook into the lcl message loop
like Delphi's Application.Onmessage. The Setwindowlong method is
intercepting messages that are dispatched to form1. However, I found
another method that consists into hooking into the browser parent
window:
Code: [Select]uses ...,windows,activex, MSHTML_4_0_TLB,
SHDocVw_1_1_TLB;
var
  Browser:TEvsWebBrowser;
  PrevWndProc: WNDPROC;

function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
    lParam: LParam): LRESULT; stdcall;
var
  HtmlElement: IHTMLElement;
  iHTMLDoc: IHtmlDocument2;
  MousePos: TPoint;
begin
  if (uMsg=WM_PARENTNOTIFY) and (wParam=WM_LBUTTONDOWN) then
  begin
    if Supports(Browser.ComServer.Document, IHtmlDocument2, iHTMLDoc)
then
     begin
      if GetCursorPos(MousePos) then
      begin
       MousePos := Form1.ActiveXContainer1.ScreenToClient(MousePos);
       HtmlElement := iHTMLDoc.ElementFromPoint(MousePos.X,
MousePos.Y);
       if Assigned(HtmlElement) then
          showmessage(htmlelement.outerHTML);
      end;
     end;
    result:=0;
  end
  else
    result:=CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  wnd: HWnd;
begin
  Browser:=TEvsWebBrowser.Create(Self);
  ActiveXContainer1.ComServer:=Browser.ComServer;
  ActiveXContainer1.Active:=true;
 (Browser.ComServer as IOleWindow).GetWindow(wnd);
 PrevWndProc:=Windows.WNDPROC(SetWindowLong(wnd,GWL_WNDPROC,PtrInt(@Wn
dCallback)));
end;

Here I used the TActiveXContainer component directly but the same
should work when you use a webbrowser component.
Note that we hook into the parent window of the browser. So the
message is not WM_LBUTTONDOWN anymore but WM_PARENTNOTIFY with a
WM_LBUTTONDOWN wparam.

----------------------------------------------------------------------
Timewarp · 2012-06-04 18:31

Works fine, thanks!

I tried only briefly, but could not get keyboard messages same way,
like keydown

----------------------------------------------------------------------
Timewarp · 2012-07-14 07:32

Another way to get Mouse and also Keyboard messages.

Code: [Select]var
  KBHook: HHook;
  MHook: HHook; 

// http://msdn.microsoft.com/en-
us/library/windows/desktop/ms644984(v=vs.85).aspx

function KeyboardHookProc(Code, wParam, lParam: LongInt): LongInt;
stdcall;
begin
 if (Code<0) then
 begin
  Result:=CallNextHookEx(KBHook, Code, wParam, lParam);
  exit;
 end;
 if (lParam shr 31)=0 then
  form1.memo1.lines.add('Keydown: '+inttostr(wParam))
 else
  form1.memo1.lines.add('Keyup: '+inttostr(wParam));
 Result := CallNextHookEx(KBHook, Code, wParam, lParam);
 //Result:=1; {Eat the message..}
end;

function MouseHookProc(Code, wParam, lParam: LongInt): LongInt;
stdcall;
begin
 if (Code<0) then
 begin
  Result:=CallNextHookEx(MHook, Code, wParam, lParam);
  exit;
 end;
 if wParam = WM_LBUTTONDOWN then form1.memo1.lines.add('LButtondown');
 if wParam = WM_RBUTTONDOWN then form1.memo1.lines.add('RButtondown');
 Result := CallNextHookEx(MHook, Code, wParam, lParam);
 //Result:=1; {Eat the message..}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MHook:=Windows.SetWindowsHookEx(WH_MOUSE, @MouseHookProc, HInstance,
GetCurrentThreadId());
 KBHook:=Windows.SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc,
HInstance, GetCurrentThreadId());
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 UnHookWindowsHookEx(KBHook);
 UnHookWindowsHookEx(MHook);
end;