unit1.pas

delphi浏览器,希望大家能够多多下载我的代码

unit Unit1;

interface

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

const
    CM_HOMEPAGEREQUEST=WM_USER+$1000;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    CoolBar1: TCoolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Label1: TLabel;
    edturl: TComboBox;
    WebBrowser1: TWebBrowser;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure edturlKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edturlClick(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);


  private
    HistoryIndex:integer;
    HistoryList:TStringList;
    UpdateCombo:boolean;
    procedure findaddress;
    procedure homepagerequest(var message:Tmessage);message CM_HOMEPAGEREQUEST;  {把注释全部去掉的时候编译有错误的？？？？}
  public
    { Public declarations }

  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.findaddress;
var
flags:olevariant;
begin
flags:=0;
updatecombo:=true;
webbrowser1.Navigate(widestring(edturl.text),flags,flags,flags,flags);
end;

procedure Tform1.homepagerequest(var message:Tmessage);
begin
edturl.text:='http://www.programbbs.com';
findaddress;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
historyindex:=-1;
historylist:=Tstringlist.create;
postmessage(handle,CM_HOMEPAGEREQUEST,0,0);
end;

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

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
findaddress;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if (historylist.count>0)and (historyindex>0)then
begin
edturl.text:=historylist[historyindex-1];
findaddress;
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if(historylist.count>0)and(historyindex<historylist.count-1)then
begin
edturl.text:=historylist[historyindex+1];
findaddress;
end;
end;

procedure TForm1.edturlKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=VK_RETURN then
findaddress;
end;

procedure TForm1.edturlClick(Sender: TObject);
begin
findaddress;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  newindex:integer;
begin
   newindex:=historylist.IndexOf(url);
   if newindex=-1 then
   begin
   if(historyindex>=0) and(historyindex<historylist.Count-1) then
   while historylist.Count>historyindex do
   historylist.Delete(historyindex);
   historyindex:=historylist.Add(url);
   end
   else
   historyindex:=newindex;
   if updatecombo then
   begin
   updatecombo:=false;
   newindex:=edturl.Items.IndexOf(url);
   if newindex=-1 then
   edturl.Items.Insert(0,url)
   else
   edturl.Items.Move(newindex,0);
   end;
   edturl.Text:=url;
   statusbar1.Panels[0].Text:=url;
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
statusbar1.Panels[0].Text:='开始下载页面。。。。。';
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
statusbar1.Panels[0].Text:='下载完成';
end;

end.