Solved

How to disable popup menu on TWebBrowser component

Posted on 2001-07-09
3
756 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Delphi XE10 Round Image 2 75
Reconfigure Delphi Install? 2 45
control image tags in a string ? 12 108
JAudiorecorder record freezing the app 29 59
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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
Need to grow your business through quality cloud solutions? With everything required to build a cloud platform and solution, you may feel like the distance between you and the cloud is quite long. Help is here. Spend some time learning about the Con…

937 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now