unit UBrowser2;

interface

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

type
  TForm1 = class(TForm)
    ActionList1: TActionList;
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    WebBrowser1: TWebBrowser;
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    AGoBack: TAction;
    AGoForward: TAction;
    AHome: TAction;
    ANewWindow: TAction;
    ANoHistory: TAction;
    ANoRead: TAction;
    ANoWrite: TAction;
    AOpen: TAction;
    AOptions: TAction;
    ARefresh: TAction;
    ASearch: TAction;
    AStop: TAction;
    AVFrame: TAction;
    TBExplorer: TToolBar;
    TBFile: TToolBar;
    ImageList1: TImageList;
    TBBack: TToolButton;
    TBForward: TToolButton;
    TBRefresh: TToolButton;
    TBStop: TToolButton;
    TBHome: TToolButton;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    TBSearch: TToolButton;
    TBTools: TToolBar;
    TBOpen: TToolButton;
    TBVFrame: TToolButton;
    TBFrame1: TToolButton;
    TBFrame2: TToolButton;
    Tools: TToolButton;
    TBNoHistory: TToolButton;
    TBNoRead: TToolButton;
    TBNoWrite: TToolButton;
    CBURL: TComboBox;
    MOpen: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    MOptions: TMenuItem;
    N10: TMenuItem;
    MExit: TMenuItem;
    MExplorer: TMenuItem;
    MFile: TMenuItem;
    MTools: TMenuItem;
    N11: TMenuItem;
    TBNewWind: TToolButton;
    ASaveAs: TAction;
    TBSave: TToolButton;
    ToolButton1: TToolButton;
    N9: TMenuItem;
   procedure CBURLKeyDown(Sender: TObject; var Key: Word;
                          Shift: TShiftState);
   procedure WebBrowser1BeforeNavigate2(Sender: TObject;
                const pDisp: IDispatch; var URL, Flags,
                TargetFrameName, PostData, Headers: OleVariant; 
                var Cancel: WordBool);
   procedure CBURLClick(Sender: TObject);
   procedure WebBrowser1ProgressChange(Sender: TObject;
                               Progress, ProgressMax: Integer);
   procedure AOpenExecute(Sender: TObject);
   procedure AGoBackExecute(Sender: TObject);
   procedure AGoForwardExecute(Sender: TObject);
   procedure AOptionsExecute(Sender: TObject);
   procedure AHomeExecute(Sender: TObject);
   procedure ASearchExecute(Sender: TObject);
   procedure AStopExecute(Sender: TObject);
   procedure ARefreshExecute(Sender: TObject);
   procedure AVFrameExecute(Sender: TObject);
   procedure MExplorerClick(Sender: TObject);
   procedure MFileClick(Sender: TObject);
   procedure MToolsClick(Sender: TObject);
   procedure MExitClick(Sender: TObject);
   procedure ANewWindowExecute(Sender: TObject);
   procedure ANoHistoryExecute(Sender: TObject);
   procedure ANoReadExecute(Sender: TObject);
   procedure ANoWriteExecute(Sender: TObject);
   procedure WebBrowser1NavigateComplete2(Sender: TObject;
                  const pDisp: IDispatch; var URL: OleVariant);
    procedure ASaveAsExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Load;
  end;

var
  Form1: TForm1;
var PFlags, PTargetFrameName: OleVariant;

implementation

uses U2Br2;

{$R *.dfm}
// Вам надо изменить записанный ниже путь на тот каталог,
// в котором находится файл VFrame.html
const SFrame = 'D:\FrontPage Webs\Content\cgi-bin\VFrame.html';
var LoadFrame: boolean = false;
    LoadFirst: boolean = true;

procedure TForm1.Load;
begin
// Загрузка URL или файла, заданного в свойстве CBURL.Text
 PFlags := 0;
 LoadFrame := false;
 if ANewWindow.Checked then PFlags := navOpenInNewWindow;
 if ANoHistory.Checked then PFlags := PFlags or navNoHistory;
 if ANoRead.Checked then PFlags :=
                                PFlags or navNoReadFromCache;
 if ANoWrite.Checked then PFlags :=
                                PFlags or navNoWriteToCache;
 if(TBFrame1.Enabled)
  then begin
   if(TBFrame1.Down)
    then PTargetFrameName := '1'
    else PTargetFrameName := '2';
  end
  else  PTargetFrameName := NULL;
 WebBrowser1.Navigate(CBURL.Text,PFlags,PTargetFrameName);
end;

procedure TForm1.CBURLKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
// Загрузка при нажатии Enter на CBURL
  if Key = VK_Return
    then Load;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName,
      PostData, Headers: OleVariant; var Cancel: WordBool);
// Обработка события перед загрузкой
var
  Index: Integer;
begin
// Управление списком CBURL
 Flags := PFlags;
 Index := -1;
 if not ANoRead.Checked then Index := CBURL.Items.IndexOf(URL);
 if (not ANoHistory.Checked) and not LoadFrame
  then begin
// Занесение в список CBURL
   if Index = -1
    then begin
     CBURL.Items.Insert(0,URL);
     CBURL.ItemIndex := 0;
    end
    else CBURL.ItemIndex := Index;
// Задание доступности действий AGoForward и AGoBack
   if CBURL.ItemIndex > 0
    then AGoForward.Enabled := true
    else AGoForward.Enabled := false;
   if CBURL.ItemIndex < CBURL.Items.Count - 1
    then AGoBack.Enabled := true
    else AGoBack.Enabled := false;
 end;
end;

procedure TForm1.CBURLClick(Sender: TObject);
begin
// Загрузка при выборе в CBURL
 Load;
end;

procedure TForm1.WebBrowser1ProgressChange(Sender: TObject;
                               Progress, ProgressMax: Integer);
// Занесение текста в панель состояния
begin
 if(Progress >0)
   then
    if (LoadFirst)
      then StatusBar1.SimpleText :=
        Format('Прочитано %d Kбайт из %d',
          [Progress div 1024,ProgressMax div 1024])
      else StatusBar1.SimpleText :=
        Format('%s "%s". Прочитано %d Kбайт из %d',
          [WebBrowser1.Type_, WebBrowser1.LocationName,
           Progress div 1024,ProgressMax div 1024]);
end;

procedure TForm1.AOpenExecute(Sender: TObject);
begin
// Вызов диалога открытия файла
 if (OpenDialog1.Execute)
  then begin
    CBURL.Text := OpenDialog1.FileName;
    Load;
  end;
end;

procedure TForm1.AGoBackExecute(Sender: TObject);
begin
// Переход на предыдущий документ
  CBURL.Text := CBURL.Items[CBURL.ItemIndex + 1];
// Другой вариант
//  WebBrowser1.GoBack;
  Load;
end;

procedure TForm1.AGoForwardExecute(Sender: TObject);
begin
// Переход на следующий документ
  CBURL.Text := CBURL.Items[CBURL.ItemIndex - 1];
// Другой вариант
//  WebBrowser1.GoForward;
  Load;
end;

procedure TForm1.AOptionsExecute(Sender: TObject);
begin
 with Fopt do begin
  CBWind.Checked := ANewWindow.Checked;
  CBHistory.Checked := ANoHistory.Checked;
  CBNoRead.Checked := ANoRead.Checked;
  CBNoWrite.Checked := ANoWrite.Checked;
  if ShowModal = mrOK
   then with Form1 do
   begin
    ANewWindow.Checked := CBWind.Checked;
    ANoHistory.Checked := CBHistory.Checked;
    ANoRead.Checked := CBNoRead.Checked;
    ANoWrite.Checked := CBNoWrite.Checked;
   end;
 end;  
end;

procedure TForm1.AHomeExecute(Sender: TObject);
begin
 WebBrowser1.GoHome;
end;

procedure TForm1.ASearchExecute(Sender: TObject);
begin
 WebBrowser1.GoSearch;
end;

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

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

procedure TForm1.AVFrameExecute(Sender: TObject);
begin
// AVFrame.Checked := not AVFrame.Checked; // для Delphi 5
 if(AVFrame.Checked)
   then begin
    LoadFrame := true;
    WebBrowser1.Navigate(SFrame);
    TBFrame1.Enabled := true;
    TBFrame2.Enabled := true;
   end
   else begin
    TBFrame1.Enabled := false;
    TBFrame2.Enabled := false;
   end;
end;

procedure TForm1.MExplorerClick(Sender: TObject);
begin
// MExplorer.Checked := not MExplorer.Checked; // для Delphi 5
 CoolBar1.Bands[0].Visible := MExplorer.Checked;
end;

procedure TForm1.MFileClick(Sender: TObject);
begin
// MFile.Checked := not MFile.Checked; // для Delphi 5
 TBFile.Visible := MFile.Checked;
 CoolBar1.Bands[2].Break := not CoolBar1.Bands[1].Visible;
end;

procedure TForm1.MToolsClick(Sender: TObject);
begin
// MTools.Checked := not MTools.Checked; // для Delphi 5
 TBTools.Visible := MTools.Checked;
 CoolBar1.Bands[1].Width := 235;
end;

procedure TForm1.MExitClick(Sender: TObject);
begin
 Close;
end;

procedure TForm1.ANewWindowExecute(Sender: TObject);
begin
 ANewWindow.Checked := not ANewWindow.Checked;
end;

procedure TForm1.ANoHistoryExecute(Sender: TObject);
begin
 ANoHistory.Checked := not ANoHistory.Checked;
end;

procedure TForm1.ANoReadExecute(Sender: TObject);
begin
 ANoRead.Checked := not ANoRead.Checked;
end;

procedure TForm1.ANoWriteExecute(Sender: TObject);
begin
 ANoWrite.Checked := not ANoWrite.Checked;
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
 LoadFirst := false;
end;

procedure TForm1.ASaveAsExecute(Sender: TObject);
begin
 WebBrowser1.ExecWB(OLECMDID_SAVEAS,1);
end;

end.
