Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How to disable popup menu on TWebBrowser component

Posted on 2001-07-09
3
Medium Priority
?
814 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
[X]
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
  • 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 140 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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…

721 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