Тема: браузер
Показать сообщение отдельно
  #25  
Старый 09.10.2010, 21:24
Аватар для ALexandr555
ALexandr555 ALexandr555 вне форума
Специалист
 
Регистрация: 09.10.2010
Адрес: Тольятти
Сообщения: 803
Версия Delphi: Delphi 7
Репутация: 2064
По умолчанию

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, {$IFDEF DELPHI6UP}Variants, {$ENDIF}AppEvnts,
  Dialogs, ExtDlgs, Graphics, Menus, ExtCtrls, ImgList, Controls, StdCtrls, ComCtrls,
  OleCtrls, SHDocVw, ToolWin, Buttons, WBFuncs, Classes, Forms,
  HistoryMenu, FavMenu, ActiveX, IEAddress,  ShellAPI, MSHTML,
  UrlMon, CommCtrl, WinInet,
  ComObj;

type
  TForm1 = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    OpenDialog1: TOpenDialog;
    IEAddress1: TIEAddress;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    PrintSetup1: TMenuItem;
    Print1: TMenuItem;
    N3: TMenuItem;
    SaveAs1: TMenuItem;
    Save1: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    WebBrowser1: TWebBrowser;
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure IEAddress1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
  private
  public
  function CreateTabBrowser(sURL, sCaption: string): TTabSheet;
  end;



var
  Form1: TForm1;

implementation


{$R *.dfm}


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



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

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

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
  WebBrowser1.Stop;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
  WebBrowser1.Refresh;
end;

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

procedure TForm1.IEAddress1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    WebBrowser1.Navigate(IEAddress1.Text);
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
var
  tss: TTabSheet;//вкладка
begin
  if Twebbrowser(Sender).ReadyState <> READYSTATE_COMPLETE then
  begin
    ppDisp := nil;
    Cancel := True;
  end else
  begin
    tss := CreateTabBrowser('about:blank', 'Новая вкладка');//создаем вкладку с пустым адресом
    WaitForBrowser(Twebbrowser(tss.Controls[0]));//ожидаем завершения работы Twebbrowser
    ppdisp := (Twebbrowser(tss.Controls[0])).Application;//передаем фокус активному веббровсеру
    WaitForBrowser(Twebbrowser(tss.Controls[0]));//ожидаем завершение работы веббровсера(активного разумется)

  end;
  end;

function TForm1.CreateTabBrowser(sURL, sCaption: string): TTabSheet;
begin

end;

end.
эхххх вобщем пропустил но не работает....
Ответить с цитированием