Delphi实例之一个简易的浏览器的实现

原作者: [db:作者] 来自: [db:来源] 收藏邀请

Delphi实例之一个简易的浏览器的实现

Delphi7的WebBrowser组件提供了很多不错的网页设计的功能，下面做一个简单的浏览器。组件很简单按照下面摆放就行了。

这是运行后的效果

源代码

主页面

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, OleCtrls, SHDocVw,
  8   ImgList, ToolWin;
  9 
 10 type
 11   TForm1 = class(TForm)
 12     ToolBar1: TToolBar;
 13     StatusBar1: TStatusBar;
 14     ImageList1: TImageList;
 15     WebBrowser1: TWebBrowser;
 16     Panel1: TPanel;
 17     BackButton: TToolButton;
 18     ForwardButton: TToolButton;
 19     ToolButton3: TToolButton;
 20     RefreshButton: TToolButton;
 21     Stopbutton: TToolButton;
 22     HomeButton: TToolButton;
 23     Label1: TLabel;
 24     Edit1: TEdit;
 25     GotoButton: TBitBtn;
 26     procedure GotoButtonClick(Sender: TObject);
 27     procedure WebBrowser1DownloadBegin(Sender: TObject);
 28     procedure WebBrowser1DownloadComplete(Sender: TObject);
 29     procedure BackButtonClick(Sender: TObject);
 30     procedure ForwardButtonClick(Sender: TObject);
 31     procedure StopbuttonClick(Sender: TObject);
 32     procedure RefreshButtonClick(Sender: TObject);
 33     procedure HomeButtonClick(Sender: TObject);
 34   private
 35     { Private declarations }
 36   public
 37     { Public declarations }
 38   end;
 39 
 40 var
 41   Form1: TForm1;
 42 
 43 implementation
 44 
 45 {$R *.dfm}
 46 
 47 procedure TForm1.GotoButtonClick(Sender: TObject);
 48 begin
 49   WebBrowser1.Navigate(Edit1.Text); {连接到指定地址}
 50 end;
 51 
 52 procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
 53 begin
 54   Form1.Caption:=Form1.Caption+'  '+Edit1.Text+'……';
 55   StatusBar1.SimpleText:='正在连接地址： '+Edit1.Text; {状态栏显示正在连接的地址}
 56 end;
 57 
 58 procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
 59 begin
 60   Form1.Caption:=Form1.Caption+'  '+WebBrowser1.LocationURL;
 61   StatusBar1.SimpleText:='完成' +WebBrowser1.LocationURL;{连接完成}
 62 end;
 63 
 64 procedure TForm1.BackButtonClick(Sender: TObject);
 65 begin
 66   try
 67     WebBrowser1.GoBack;                    {返回}
 68   except
 69     ShowMessage('已经达到最早历史记录');
 70     exit;
 71   end;
 72 end;
 73 
 74 procedure TForm1.ForwardButtonClick(Sender: TObject);
 75 begin
 76   try
 77     WebBrowser1.GoForward;                 {前进}
 78   except
 79     ShowMessage('已经达到最新历史记录');
 80     exit;
 81   end;
 82 end;
 83 
 84 procedure TForm1.StopbuttonClick(Sender: TObject);
 85 begin
 86   WebBrowser1.Stop;                       {停止}
 87 end;
 88 
 89 procedure TForm1.RefreshButtonClick(Sender: TObject);
 90 begin
 91   WebBrowser1.Refresh;                     {刷新}
 92 end;
 93 
 94 procedure TForm1.HomeButtonClick(Sender: TObject);
 95 begin
 96   WebBrowser1.GoHome;
 97   Edit1.Text:='http://www.cnblogs.com/Chaobs';    {主页}
 98 end;
 99 
100 end.