mainfm.pas

web 浏览器用delphi编的

unit MainFM;

interface

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

type
  TWebBrowserForm = class(TForm)
    ActionList1: TActionList;
    ActionBack: TAction;
    ActionForward: TAction;
    ActionStop: TAction;
    ActionRefresh: TAction;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    V1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    H1: TMenuItem;
    CoolBar1: TCoolBar;
    ImageList1: TImageList;
    TB: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    TBrefresh: TToolButton;
    TBStop: TToolButton;
    Animate: TAnimate;
    CBAddress: TComboBox;
    ToolBar2: TToolBar;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    WebBrowser: TWebBrowser;
    DgOpen: TOpenDialog;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton7: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure ActionBackExecute(Sender: TObject);
    procedure ActionBackUpdate(Sender: TObject);
    procedure ActionForwardExecute(Sender: TObject);
    procedure ActionForwardUpdate(Sender: TObject);
    procedure ActionStopExecute(Sender: TObject);
    procedure ActionRefreshExecute(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure CBAddressKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CBAddressClick(Sender: TObject);
    procedure WebBrowserBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowserDownloadBegin(Sender: TObject);
    procedure WebBrowserDownloadComplete(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);

  private
    { Private declarations }
     HistoryIndex:Integer;
     SLHistory:TstringList;
     UPdateCBAddress:boolean;
     Procedure FindAddress;
  public
    { Public declarations }
  end;

var
  WebBrowserForm: TWebBrowserForm;

implementation

{$R *.dfm}
//
Procedure  TWebBrowserForm.FindAddress ;
var
Flags:OLEVariant;
begin
Flags:=0;
UPdateCBAddress:=True;
WebBrowser.Navigate(WideString(CBAddress.text),Flags,Flags,Flags,Flags);
 end;
  //
procedure TWebBrowserForm.FormCreate(Sender: TObject);
begin
HistoryIndex:=-1;
SLHistory:=TStringList.Create ;
Animate.Active:=False;
end;
//
procedure TWebBrowserForm.ActionBackExecute(Sender: TObject);
begin
CBAddress.text:=SLHIstory.Strings [HistoryIndex -1];
FindAddress;
end;
//
procedure TWebBrowserForm.ActionBackUpdate(Sender: TObject);
begin
if SLHistory.Count >0 then
 ActionBack.Enabled :=HistoryIndex >0
 else
 ActionBack.Enabled :=false;
end;
 //
procedure TWebBrowserForm.ActionForwardExecute(Sender: TObject);
begin
 CBAddress.text:=SLHIstory.Strings [HistoryIndex +1];
FindAddress;
end;
 //
procedure TWebBrowserForm.ActionForwardUpdate(Sender: TObject);
begin
 if SLHistory.Count >0 then
 ActionBack.Enabled :=HistoryIndex < SLHistory.Count-1
 else
 ActionBack.Enabled :=false;
end;
 //
procedure TWebBrowserForm.ActionStopExecute(Sender: TObject);
begin
WebBrowser.Stop ;
end;
 //
procedure TWebBrowserForm.ActionRefreshExecute(Sender: TObject);
begin
FindAddress;
end;
  //
procedure TWebBrowserForm.N2Click(Sender: TObject);
begin
  if DgOpen.Execute  then
  begin
   CBAddress.Text:=DgOpen.FileName;
   FindAddress;
   end;
end;
   //
procedure TWebBrowserForm.N4Click(Sender: TObject);
begin
close;
end;
     //
procedure TWebBrowserForm.N5Click(Sender: TObject);
begin
with Sender as TMenuItem do
begin
Checked:=not Checked;
CoolBar1.Visible :=Checked;
end;
end;
procedure TWebBrowserForm.ToolButton3Click(Sender: TObject);
begin
  CBAddress.Text :='www.baidu.com' ;
  FindAddress;
end;

procedure TWebBrowserForm.ToolButton7Click(Sender: TObject);
begin
  CBAddress.Text :='www.google.cn' ;
  FindAddress;
end;
    //
procedure TWebBrowserForm.ToolButton5Click(Sender: TObject);
begin
  CBAddress.Text :='www.sina.com.cn' ;
  FindAddress;
end;
    //
procedure TWebBrowserForm.ToolButton6Click(Sender: TObject);
begin
 CBAddress.Text :='www.sohu.com.cn' ;
  FindAddress;
end;
    //
    procedure TWebBrowserForm.ToolButton4Click(Sender: TObject);
begin
            CBAddress.Text :='www.163.com' ;
  FindAddress;
end;

procedure TWebBrowserForm.CBAddressKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key=VK_Return then
  FindAddress;
end;
     //
procedure TWebBrowserForm.CBAddressClick(Sender: TObject);
begin
FindAddress;
end;
    //
procedure TWebBrowserForm.WebBrowserBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
    NewIndex:Integer;
begin
   NewIndex:=SLHistory.IndexOf(URL);
     if NewIndex=-1 then //未找到
   begin
       if(HistoryIndex>=0)and(HistoryIndex<SLHistory.Count-1) then
       while SLHistory.Count > HistoryIndex do
         SLHistory.Delete(HistoryIndex);// 移去最前面的一个URL
         HistoryIndex:=SLHistory.Add(URL);
    end
    else
        HistoryIndex:=NewIndex;
        if UpdateCBAddress then
        begin
        UPdateCBAddress:=false;
        NewIndex:=CBAddress.Items.IndexOf(URL);
        if NewIndex=-1 then
        CBAddress.Items.Insert(0,URL)
        else
        CBAddress.Items.Move(NewIndex,0);
        end;
        CBAddress.Text:=URL;


end;
   //
procedure TWebBrowserForm.WebBrowserDownloadBegin(Sender: TObject);
begin
   TBStop.Enabled:=True;
  Animate.Active :=True;
end;



procedure TWebBrowserForm.WebBrowserDownloadComplete(Sender: TObject);
begin
 TBStop.Enabled :=False;
 Animate.Active :=False;
end;

procedure TWebBrowserForm.FormDestroy(Sender: TObject);
begin
 SLHistory.Free;
end;




end.