Solved

How to disable popup menu on TWebBrowser component

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

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
How to renew a Delphi rad-studio licence? 5 77
Find and Replace Stream with 0s 8 72
Tidtcpserver listening on multiports? 1 44
enhance the following code 3 42
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…

756 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