unit1.pas

利用delphi做的很简单网页浏览器

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    CoolBar1: TCoolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Panel1: TPanel;
    StaticText1: TStaticText;
    ComboBox1: TComboBox;
    BitBtn1: TBitBtn;
    WebBrowser1: TWebBrowser;
    StatusBar1: TStatusBar;
    SpeedButton5: TSpeedButton;
    XPManifest1: TXPManifest;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PageCount:integer=0;
implementation
uses unit2;
{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  URL:string;
  Num:integer;
begin
  URL:=combobox1.Text;
  if URL<>'' then
  begin
    webbrowser1.Navigate(URL);
    Num:=0;
    while Num<combobox1.Items.Count do
    begin
      if combobox1.Text = combobox1.Items[Num] then
      begin
        abort;
      end else
      begin
        inc(Num);
      end;
    end;
    combobox1.Items.Add(URL);
    combobox1.Items.SaveToFile(getcurrentdir+'\urls.txt');
    
  end;
  
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  try
    webbrowser1.GoBack;
    speedbutton2.Enabled:=true;
    dec(pagecount);
  except
    
    exit;
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  combobox1.Width:=bitbtn1.Left-80;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  try
    webbrowser1.GoForward;
  except
   
    exit;
  end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  webbrowser1.Refresh;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  webbrowser1.Stop;
    statusbar1.SimpleText:='停止下载';
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
  statusbar1.SimpleText:='请稍后 正在下载...';
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
  statusbar1.SimpleText:='下载完成';
  combobox1.Text:=webbrowser1.LocationURL;
  N3.Enabled:=true;
  
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  webbrowser1.GoHome;
  combobox1.text:=webbrowser1.LocationURL;
  showmessage(combobox1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  combobox1.Items.LoadFromFile('urls.txt');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  form2.ShowModal;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  webbrowser1.ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  application.Terminate;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  speedbutton1.Click;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  speedbutton2.Click;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
  speedbutton3.Click;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
  speedbutton4.Click;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
  showmessage('小精灵工作室');
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  inc(PageCount);//记录浏览页面数
  if PageCount>1 then
  begin
    speedbutton1.Enabled:=true;
    dec(PageCount);
  end;
end;

end.