main.pas

一个小小的浏览器,能打开网页,实现浏览器的功能,没有其它的功能

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, isp3, AdImage;

type
  TMainForm = class(TForm)
    HTML1: THTML;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Panel1: TPanel;
    Bevel1: TBevel;
    URLs: TComboBox;
    GoButton: TSpeedButton;
    View1: TMenuItem;
    DocumentSource1: TMenuItem;
    CancelBtn: TSpeedButton;
    Label1: TLabel;
    Histroy1: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    BackButton: TSpeedButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Openlocal1: TMenuItem;
    Save1: TMenuItem;
    N2: TMenuItem;
    Bevel2: TBevel;
    AdPanel: TPanel;
    Ad: TAdImage;
    Bevel3: TBevel;
    procedure Exit1Click(Sender: TObject);
    procedure GoButtonClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure DocumentSource1Click(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure HTML1BeginRetrieval(Sender: TObject);
    procedure HTML1EndRetrieval(Sender: TObject);
    procedure URLsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Openlocal1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Histroy1Click(Sender: TObject);
    procedure BackButtonClick(Sender: TObject);
    procedure AdPanelResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses DocSrc, History, About;

{$R *.DFM}

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.GoButtonClick(Sender: TObject);
begin
  if Html1.URL <> '' then
    HistoryForm.HistoryListBox.Items.Add(Html1.URL);
  if URLs.Items.IndexOf(URLs.Text) = -1 then
    URLs.Items.Add(URLs.Text);
  HTML1.RequestDoc(URLs.text);
  Statusbar1.Panels[0].Text := HTML1.RequestURL;
end;

procedure TMainForm.About1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TMainForm.DocumentSource1Click(Sender: TObject);
begin
  with DocSourceFrm do
  begin
    Show;
    Memo1.Lines.Clear;
    Memo1.Lines.Add(HTML1.SourceText);
    Memo1.SelStart := 0;
    SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);
  end;
end;

procedure TMainForm.CancelBtnClick(Sender: TObject);
begin
  HTML1.Cancel('test');
  CancelBtn.Enabled := False;
end;

procedure TMainForm.HTML1BeginRetrieval(Sender: TObject);
begin
  CancelBtn.Enabled := True;
end;

procedure TMainForm.HTML1EndRetrieval(Sender: TObject);
begin
  CancelBtn.Enabled := False;
end;

procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    GoButtonClick(nil);
end;



procedure TMainForm.Openlocal1Click(Sender: TObject);
begin
  if OpenDialog.Execute then begin
    URLs.Text := 'file:///' + OpenDialog.FileName;
    GoButtonClick(nil);
  end;
end;

procedure TMainForm.Save1Click(Sender: TObject);
begin
  if SaveDialog.Execute then begin
    with DocSourceFrm do
    begin
      Memo1.Lines.Clear;
      Memo1.Lines.Add(HTML1.SourceText);
      Memo1.Lines.SaveToFile(SaveDialog.FileName);
    end;
  end;
end;

procedure TMainForm.Histroy1Click(Sender: TObject);
begin
  HistoryForm.Show;
end;

procedure TMainForm.BackButtonClick(Sender: TObject);
begin
  with HistoryForm.HistoryListBox.Items do begin
    if Count > 0 then begin
      HTML1.RequestDoc(Strings[Count-1]);
      Statusbar1.Panels[0].Text := HTML1.RequestURL;
      Delete(Count-1);
    end;
  end;
end;



procedure TMainForm.AdPanelResize(Sender: TObject);
begin
  Ad.Left := (AdPanel.Width - Ad.Width) div 2;  
end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
  HTML1.RequestDoc('file:///welcome.htm');
end;

end.