unit1.~pas

我自己做的小巧浏览器,界面简单实用,使用ie内核,请自行编译然后运行

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    ToolBar1: TToolBar;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Button1: TButton;
    StatusBar1: TStatusBar;
    ToolBar2: TToolBar;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure GotoPage(ReqURL:string) ;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.GotoPage(ReqURL:string) ;
begin
 WebBrowser1.Navigate(ReqUrl);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GotoPage(comboBox1.text);
end;

procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
     GotoPage(ComboBox1.Text);
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
  StatusBar1.Panels[0].text:='loading - '+combobox1.Text +'...';
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
var
  NewUrl:string;
begin
StatusBar1.Panels[0].Text:='over';
  NewUrl:=WebBrowser1.LocationURL;
  IF (NewUrl<>'') and(ComboBox1.Items.IndexOf(NewUrl)<0) then
      begin
        ComboBox1.Items.Add(NewUrl);
        combobox1.ItemIndex:= ComboBox1.Items.IndexOf(NewUrl);
      end;
end;

procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
  const Text: WideString);
begin
  caption:='WebShell';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GotoPage('about:blank');
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  WebBrowser1.GoBack;
  BitBtn2.Enabled :=True;
end;

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

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

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

end.