Solved

Make a Farsi Browser

Posted on 2001-06-06
5
328 Views
Last Modified: 2010-04-06
Hi
I Design And Implementation a Farsi Browser For Internet.
I Use TBrwoser Component From Delphi ...
I Want Disable Popup Menu From This Object In RunTime.

Questions:

1) When Right Click On This Object , Open a Popup Menu ,
I Want Disable This Popup Menu ???
After Disable I Want Open My Popup Menu With Right Click
On WebBrowser Component.

2) Which I Can Open My Browser Duplicate With Programming.
Example : File --> New --> Window    in Internet Explorer.
I Want Ways Until Open a Other Window From My Browser.
Count Open Windows Not Fixed ...

3) Which I Can Register My Browser in Windows Until My Browser Use Default Browser For Windows similar
"Internet Explorere".

4) Which I Can Simulate Tasks Popup Menu a WebBrowser.
Example :  < View Source > , < Add To Favorites > ,
Encoding , ...

Thanks From You Very Very Much
0
Comment
Question by:mpzlarge40
  • 3
  • 2
5 Comments
 
LVL 17

Expert Comment

by:inthe
ID: 6159482
hi,
to disable the popupmenu this works ok by simply handling the right mouse button events and telling windows we have taken care of it



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw_TLB;

type
  TForm1 = class(TForm)
   WebBrowser1: TWebBrowser;
   procedure MessageLoop(var Msg:TMsg;var Handled:Boolean);
   procedure FormCreate(Sender: TObject);
     
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.MessageLoop(var Msg: TMsg; var Handled: Boolean);
 begin
 if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP) then
handled:=True
   else Handled := False
end;
end;

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



for your file-new-window you can recreate your form by doing like:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f : tform;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
f := tform1.create(self);
f.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
webbrowser1.oleobject.navigate(edit1.text)
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if assigned(f) then begin
f.Free;
f := nil;
end;
end;

end.
0
 
LVL 17

Expert Comment

by:inthe
ID: 6159731
for number 3 (register as default browser) you have to change in the registry all the extensions like  http:// , .html, .htm etc to point to your app instead .

one of the most helpful articles in doing this is at:

http://help.netscape.com/kb/consumer/19980502-2.html



as a note on your form create youll need to parse paramstr(1) so if users click on shortcut to http://www.foo.com/my.html your paramstr will contain the url for you to open in the browser.

quick example you could text with a memo:

for i:= 0 to ParamCount do
begin
if FindFirst( ParamStr( i), faAnyFile, SearchRec) = 0 then
Memo1.Lines.Add( ExtractFilePath( ParamStr(i)) + SearchRec.Name;
FindClose( SearchRec);
end;
0
 
LVL 2

Accepted Solution

by:
RickHalle earned 200 total points
ID: 6161097
#1:
http://members.home.com/hfournier/webbrowser.htm#advanced
#2:
You will need to to create a new instance of the browser. Some things to consider will be the fact that you will need to create the browser at run time if you intend to create as many instances as you want. If you only will have two then you can use two controls at run time. Note: If you do so the browsers will be loaded with the app. and stay there until it is closed.

Here is a sample I whipped up to do most of what you are asking plus a bit more. It creates a new form with a dynamically created browser. It requires the units mentioned at the site above for the right click with the change below in IEDocHostUIHandler.pas, a progress bar, and two buttons(One to Create, One to Destroy). You can create as many webbrowser/form instances as your memory will handle. Destroy only destroys the last one created. I am sure someone here can suggest a way to destroy previous ones. If you want the full project for this sample send an email to Rick@C2CSports.com and I will send it to you(11k zip)

IEDocHostUIHandler.pas(Change)
function TDocHostUIHandler.IDocHostUIHandler_ShowContextMenu(const dwID: DWORD;
  const ppt: PPOINT; const pcmdtReserved: IUnknown;
  const pdispReserved: IDispatch): HRESULT;
begin
  Result := S_OK;
//  Result := E_NOTIMPL;
end;

unit UI;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SHDocVw, ExtCtrls, ComCtrls, IEDocHostUIHandler, ieConst, MSHTML,
  StdCtrls;

type
  TForm1 = class(TForm)
    RetrieveWBProgressbar: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    DynamicWB: TWebBrowser;
    procedure DynamicWBNavigateComplete2(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure DynamicWBBeforeNavigate2(Sender: TObject; const pDisp: IDispatch;
      var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
    procedure DynamicWBDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure DynamicWBDownloadBegin(Sender: TObject);
    procedure DynamicWBDownloadComplete(Sender: TObject);
    procedure DynamicWBNewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure DynamicWBOnProgressChanged(Sender: TObject; Progress: Integer; ProgressMax: Integer);
  public
    { Public declarations }
  protected
  end;

var
  Form1: TForm1;
  Form2: TForm;
  FDocHostUIHandler: TDocHostUIHandler;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDocHostUIHandler := TDocHostUIHandler.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FDocHostUIHandler.Free;
end;

procedure TForm1.DynamicWBNavigateComplete2(Sender: TObject; const pDisp: IDispatch;
  var URL: OleVariant);
var
  hr: HResult;
  CustDoc: ICustomDoc;
begin
  hr := DynamicWB.Document.QueryInterface(ICustomDoc, CustDoc);
  if hr = S_OK then
    CustDoc.SetUIHandler(FDocHostUIHandler);
end;

procedure TForm1.DynamicWBBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
const crMyCursor = 1;
begin
//Handle BeforeNavigate2 Event
end;

procedure TForm1.DynamicWBDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc: IHTMLDocument2;
  Element: IHTMLElement;
const
//  Make_Flat = True;
  Make_Flat = False;
begin
  Doc := IHTMLDocument2(TWebBrowser(Sender).Document);
  if Doc = nil then
    Exit;
  Element := Doc.body;
  if Element = nil then
    Exit;
  case Make_Flat of
    TRUE: Element.style.borderStyle := 'none';
    FALSE: Element.style.borderStyle := '';
  end;
end;

procedure TForm1.DynamicWBDownloadBegin(Sender: TObject);
begin
//Handle DownloadBegin Event
end;

procedure TForm1.DynamicWBDownloadComplete(Sender: TObject);
begin
//Handle DownloadComplete Event
end;

procedure TForm1.DynamicWBNewWindow2(Sender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
var
  Doc: IHTMLDocument2;
  S: string;
  varUrl: OLEVariant;
  Flags: OLEVariant;
begin
  Flags := 0;
  begin
    Cancel := True;
    Doc := IHTMLDocument2(TWebBrowser(Sender).Document);
    S := Copy(Doc.activeElement.outerHTML, pos('href=',
      Doc.activeElement.outerHTML) + 5, length(Doc.activeElement.outerHTML) -
      pos('href=', Doc.activeElement.outerHTML) + 5);
    S := Copy(S, 0, pos('>', S) - 1);
    if pos('"', S) = 1 then
      S := Copy(S, 2, Length(S) - 1);
    if pos('"', S) = Length(S) then
      S := Copy(S, 0, Length(S) - 1);
    varURL := S;
    DynamicWB.Navigate2(varURL, Flags, Flags, Flags, Flags);
  end;
end;

procedure TForm1.DynamicWBOnProgressChanged(Sender: TObject; Progress: Integer; ProgressMax: Integer);
begin
  if Progress > 0 then begin
    RetrieveWBProgressbar.Max := ProgressMax;
    RetrieveWBProgressbar.Position := Progress;
  end
  else
    RetrieveWBProgressbar.Position := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Form2 := TForm.CreateNew(Application);
    DynamicWB := TWebBrowser.Create(Form2);
    DynamicWB.CreateParented(Form2.Handle);
    Form2.Show;
    with DynamicWB do begin
      SetFocus;
      SetBounds(2, 2, Form2.Width - 4, Form2.Height - 4);
      OnNavigateComplete2 := DynamicWBNavigateComplete2;
      OnBeforeNavigate2 := DynamicWBBeforeNavigate2;
      OnDownloadBegin := DynamicWBDownloadBegin;
      OnDownloadComplete := DynamicWBDownloadComplete;
      OnNewWindow2 := DynamicWBNewWindow2;
      OnProgressChange := DynamicWBOnProgressChanged;
      OnDocumentComplete := DynamicWBDocumentComplete;
      DoObjectVerb(-1);
    end;
  DynamicWB.Navigate('http://bluewaterfishfinder.com/');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if DynamicWB <> nil then begin
    DynamicWB.DoObjectVerb(-3);
    DynamicWB.Destroy;
    DynamicWB := nil;
    Form2.Visible := False;
  end;
end;

end.


Rick
0
 
LVL 2

Expert Comment

by:RickHalle
ID: 6161148
Note:
NewWindow2 is canceling the new window and instead loading it into itself in this sample. If I were doing what you appear to be trying to do I would use a panel in the main form and put one instance of the browser there. Then use the NewWindow2(Cancel) event to prevent IE from opening and then load the url into a new instance of the browser/form. This sample is meant primarily to demonstrate the ability to create/destroy the browser at run time and to catch some of the events.

DocumentComplete above is there to change the border style of the browser window which I needed to be flat in the project where I pulled this code from. I left it because it may be of some interest.

The visible property for the webbrowser also does nothing. You will see DoObjectVerb above, this is used to show/hide it.

Rick
0
 
LVL 2

Expert Comment

by:RickHalle
ID: 6189890
Listening.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This video discusses moving either the default database or any database to a new volume.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

758 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

23 Experts available now in Live!

Get 1:1 Help Now