Браузер на основе IE. Небольшая проблема.

[Bengl]

Доброго времени суток господа.

Пишу простенький браузер на основе IE. Всё готово, всё впринципе функционирует, но есть косяк:

При переходе по ссылке, которая должна открываться в новом окне - страница открывается в IE, а не в моём браузере.

Как это исправить ?

Я вижу два варианта:
1) сделать каким то образом мой браузер "по умолчанию".
2) что то изменить в коде.

Вот весь проект: http://zalil.ru/30171358

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ToolWin, OleCtrls, SHDocVw, ImgList;

type
  Tbrowser = class(TForm)
    WebBrowser1: TWebBrowser;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    ComboBox1: TComboBox;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    ImageList1: TImageList;
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  browser: Tbrowser;

implementation

{$R *.dfm}

procedure Tbrowser.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key= VK_RETURN then
WebBrowser1.Navigate(ComboBox1.Text);
end;

procedure Tbrowser.ToolButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
WebBrowser1.Navigate(OpenDialog1.FileName);
ComboBox1.Text:=OpenDialog1.FileName;
end;
end;

procedure Tbrowser.ToolButton2Click(Sender: TObject);
begin
WebBrowser1.GoBack;
end;

procedure Tbrowser.ToolButton3Click(Sender: TObject);
begin
WebBrowser1.GoForward;
end;

procedure Tbrowser.ToolButton4Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;

procedure Tbrowser.ToolButton5Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure Tbrowser.ToolButton6Click(Sender: TObject);
var
PostData, Headers:OLEvariant;
begin
WebBrowser1.ExecWB(OLECMDID_PRINT,OLECMDEXECOPT_DODEFAULT,PostData, Headers);
end;

procedure Tbrowser.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
StatusBar1.SimpleText:=Text;
end;

procedure Tbrowser.WebBrowser1ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
ProgressBar1.Max:=ProgressMax;
ProgressBar1.Position:=Progress;
end;

end.

[Bright-rider]

Присоединяюсь ТС. Тоже ищу решения данной проблемы.

[Dj_smart]

Как вариант - вешать вместо адреса ссылки #, а на onclick вешать смену title документа на адрес + некая спецкомбинация, чтобы браузер не реагировал на смену титла скриптами, куда нужно идти.
Как-то так: <a href="#" onclick="document.title='goto:http://google.ru';">click</a>
Так вот, в WebBrowser есть отличный метод OnTitleChange(Насколько помню) и по его изменению можно наваять чтото вроде:
s := полученный "новый титл", в данном случае - goto:http://google.ru

if pos('goto:', s) = 1 then begin
  delete(s, 5);
  // делаем c s что надо
end;

Этим способом, кстати я делал управление программой из ВебБраузера.

[Bengl]

Как вариант - вешать вместо адреса ссылки #, а на onclick вешать смену title документа на адрес + некая спецкомбинация, чтобы браузер не реагировал на смену титла скриптами, куда нужно идти.
Как-то так: <a href="#" onclick="document.title='goto:http://google.ru';">click</a>
Так вот, в WebBrowser есть отличный метод OnTitleChange(Насколько помню) и по его изменению можно наваять чтото вроде:
s := полученный "новый титл", в данном случае - goto:http://google.ru
Код:

if pos('goto:', s) = 1 then begin
delete(s, 5);
// делаем c s что надо
end;
Этим способом, кстати я делал управление программой из ВебБраузера.

мягко говоря, возникли проблемы с реализацией...

Есть еще варианты ?

[856100]

Я нашел оптимальное решение этой проблемы, но напишу чуть позже (гдето часов в 10) - ща все таки сессия))

[856100]

Как и обещал:

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ToolWin, ComCtrls, OleCtrls, SHDocVw, ShellAPI;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    Edit1: TEdit;
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure FormShow(Sender: TObject);
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  S:string; //тут будем хранить сылку на новое окно

implementation

{$R *.dfm}

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  If Key=VK_RETURN then Button1.Click;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;

procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  StatusBar1.SimpleText:=Text;
  if Copy(Text, 1, 4)='http' then S:=Text; //Если ссылка, то ее записать
                                    //(вдруг потом нужно будет по ней перейти)
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
  Cancel:=True; //Заприщаем запуск обозревателя IE
  ShellExecute(Handle, 'open', PChar(ParamStr(0)), PChar(S), nil, 0);
    //Запускаем себя еще раз, только указав в параметрах ссылку на новое окно
    // можно и вкладки создать, как в опере... но это уже другой разговор =))
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if Form1.Tag=1 then Exit;
  If ParamCount>0 then   //Если имеется параметр, то переходим по нему
  begin
    Edit1.Text:=ParamStr(1);
    WebBrowser1.Navigate(ParamStr(1));
  end;
  Form1.Tag:=1; //Если сново будет вызов onshow, то ничего не делать
end;

procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
  const Text: WideString);
begin
  Form1.Caption:=Text; //Это не обязательно))
end;

end.

А это собственно и проект
http://zalil.ru/30178094

[Bengl]

Огромнейшее спасибо ! То что нужно.

[alexprey]

Я делал через обработку события открытия нового окна

procedure TPageForm.WebPageNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
 MainForm.CreateWindow('');
 ppDisp:= Mainform.lastcreatewindow.WebPage.DefaultDispatch;
end;
...
//MainForm.CreateWindow('') - создаю новую вкладку в своем браузере
Mainform.lastcreatewindow - возвращаю переменную окна

[856100]

alexprey, тут может быть много разный вариаций - я привел вариант, как это выглядит в IE.

[alexprey]

Мой намного проще, не надо еще раз запускать
PS. IE - не лучший браузер для того чтобы приводить примеры на нем