Personnaliser la popup du WebBrowser de Delphi

Le menu déroulant (popup) dans un composant TWebBrowser est le menu classique d'Internet Explorer... même en affectant la propriété Popupmenu du composant ! Pour le personnaliser et ajouter vos propres commandes, il existe une solution :

Ajoutez la classe MSHTML

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MSHTML;

Ajoutez FOleInPlaceActiveObject: IOleInPlaceActiveObject; dans la partie « public ».

  private
    { Déclarations privées }
  public
  
    FOleInPlaceActiveObject: IOleInPlaceActiveObject;
	
  end;

Ajoutez cette fonction à votre fiche

function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var szClassName: array[0..255] of Char; CurPos: TPoint; X, Y: Integer;
const ie_name = 'Internet Explorer_Server';
begin
  GetCursorPos(CurPos);
  x := CurPos.x;
  y := CurPos.y;
  case nCode < 0 of
    True: Result := CallNextHookEx(HookID, nCode, wParam, lParam)
  else case wParam of
    WM_RBUTTONDOWN,WM_RBUTTONUP: begin
      GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND,
      szClassName, SizeOf(szClassName));
      if lstrcmp(@szClassName[0], @ie_name[1]) = 0 then begin
        Result := HC_SKIP;
        Form1.popupmenu1.popup(X, Y);
      end else
        Result := CallNextHookEx(HookID, nCode, wParam, lParam);
    end else
      Result := CallNextHookEx(HookID, nCode, wParam, lParam);
  end;
  end;
end;

Ajoutez ces éléments aux procédures Oncreate et OnDestroy de la fiche :

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);

var
  iOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin

procedure TForm1.FormCreate(Sender: TObject);
begin
  HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if HookID <> 0 then
    UnHookWindowsHookEx(HookID);
end;

end;

Des questions ? Rejoignez nous sur le forum...