Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

How to disable popup menu on TWebBrowser component

Posted on 2001-07-09
3
775 Views
Last Modified: 2010-04-04


1. Does anyone know how to disable popup menu on TWebBrowser component.
2. If its possible then how to add my own popup menu?

Question 1 is more important for me.

thanks in advance.
0
Comment
Question by:kirezz
  • 2
3 Comments
 
LVL 17

Expert Comment

by:inthe
ID: 6264774
Hi,
here a is sample to do both:

override popup menu and have own menu with copy and save

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,OleCtnrs, StdCtrls, OleCtrls, SHDocVw_TLB, Menus,
   OleConst,  ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    OpenDialog1: TOpenDialog;
    Save1: TMenuItem;      {popupmenu savepage item}
    Copy1: TMenuItem;      
     SaveDialog1: TSaveDialog;
    WebBrowser1: TWebBrowser;
   procedure MessageLoop(var Msg:TMsg;var Handled:Boolean);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Save1Click(Sender: TObject);
     procedure Copy1Click(Sender: TObject);  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MessageLoop(var Msg: TMsg; var Handled: Boolean);
var
 mouse:Tpoint;
begin
if msg.hwnd = webbrowser1.Handle then
  begin
   if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)
   then begin
    handled:=True;
     getcursorpos(Mouse);
    popupmenu1.popup(Mouse.x,Mouse.y);
   end
  else Handled := False; //not rbutton
 end
else
Handled := false; //not webbrowser msg
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.execute;
webbrowser1.oleobject.navigate(opendialog1.filename);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := MessageLoop;
end;

procedure TForm1.Save1Click(Sender: TObject);
var
persist :ipersistfile;
begin
persist := (webbrowser1.document as ipersistfile);
persist.save('c:\a.html',false);
showmessage('page saved as c:\a.html');
end;

procedure TForm1.Copy1Click(Sender: TObject);
  var
    vInput, vOutput: OleVariant;
  begin
    WebBrowser1.ExecWB(OLECMDID_COPY, 0, vInput, vOutput);
  end;

end.
0
 

Author Comment

by:kirezz
ID: 6267557
Hi inthe,

i've checked your code but seems it doesn;t work properly.

Only diference from posted code is only that i dont have "SHDocVw_TLB.dcu" and instead of that i've put "SHDocVw" in uses clause. I don;t know if this is cause of problems.

list of problems i got:

1. when i initialy start prg i get empty webbrowser object and i can see my custom poput menu, but after i load other html page with button1click default menus are shown.

2. when twebbrowser is empty, if i choose "open" from my popup i got following error:
"trying to revoke a drop target that has not been registered"

3.when i try to click on "save" menu item i got some exception ("access violation at address...").

Do you know how to help me please?

thank you.
0
 
LVL 17

Accepted Solution

by:
inthe earned 35 total points
ID: 6271454
sorry this is old code i never realised it now causes problems..the best suggestion i can tiunk tat definelty works id too upgrade toi embeddedwb as it has these extra properties in object inspector already.

http://www.euromind.com/iedelphi/embeddedwb/onshowcontextmenu.htm 


about the trying to revoke a drop target that has not been registered error

that is corect as document object is empty so you need to check first if WebBrowser1.Document <> nil and add the
initialization
 OleInitialize(nil);

finalization
 OleUninitialize;
sections to register it.


if you just wish to disable the menu i found a policy for it though it works a bit strange ,i found it not very realiable:

function IERestrictionsSettings(Key: string; Disabled: Boolean): Boolean;
var
  reg: TRegistry;
begin
  Result := TRUE;
  Reg := TRegistry.Create;
  with Reg do try
    RootKey := HKEY_CURRENT_USER;
    OpenKey('Software\Policies\Microsoft\Internet Explorer\Restrictions', True);
    WriteInteger(Key, Integer(Disabled));
    CloseKey;
  except
    Result := FALSE;
  end;
  Reg.Free;
end;

function DisableContextMenu(Disabled: Boolean): Boolean;
begin
  Result := IERestrictionsSettings('NoBrowserContextMenu', Disabled);
end;

below is a example ive tested that seems to be working ok,if you find fault let me know but i am using embeddedwb myself as its much better (and easier) to use in general.

Regards Barry



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw, Menus,ActiveX;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Edit1: TEdit;
    PopupMenu1: TPopupMenu;
    Save1: TMenuItem;
    Copy1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
procedure MessageLoop(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MessageLoop(var Msg: TMsg; var Handled: Boolean);
var
mouse:Tpoint;
begin
Handled := IsDialogMessage(Webbrowser1.Handle, msg) = True;
if handled then
begin
  if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)
 then begin
   getcursorpos(Mouse);
   popupmenu1.popup(Mouse.x,Mouse.y);
  end
 else
  handled := false;//not menu
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := MessageLoop;
webbrowser1.oleobject.navigate('http://www.google.com');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a,b,c,d : olevariant;
begin
webbrowser1.navigate(pchar(edit1.text),a,b,c,d);
end;

procedure TForm1.Save1Click(Sender: TObject);
var
i,o :olevariant;
begin
if (WebBrowser1.Document <> nil) then
  WebBrowser1.ExecWB(OLECMDID_SAVEAS,0,I,O);
end;

procedure TForm1.Copy1Click(Sender: TObject);
 var
   I,O: OleVariant;
 begin
  if WebBrowser1.Document <> nil then
   WebBrowser1.ExecWB(OLECMDID_COPY,0,I,O);
 end;

initialization
 OleInitialize(nil);

finalization
 OleUninitialize;

end.
0

Featured Post

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question