Home: Code Repository: Mastering Delphi 5

Project WEBDEMO

Project Structure

WEBDEMO.DPR
WEBDEMOF.PAS
WEBDEMOF.DFM

program WebDemo;

uses
  Forms,
  WebDemoF in 'WebDemoF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit WebDemoF;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    ControlBar1: TControlBar;
    Panel1: TPanel;
    BtnOpen: TSpeedButton;
    BtnGo: TSpeedButton;
    ComboURL: TComboBox;
    procedure BtnOpenClick(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
    procedure BtnGoClick(Sender: TObject);
    procedure ComboURLKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
  private
    { Private declarations }
  public
    procedure GotoPage (ReqUrl: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtnOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
      GotoPage (OpenDialog1.FileName);
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
var
  NewUrl: string;
begin
  StatusBar1.Panels[0].Text := 'Done';
  // add URL to combobox
  NewUrl := WebBrowser1.LocationURL;
  if (NewUrl <> '') and
      (ComboURL.Items.IndexOf (NewUrl) < 0) then
    ComboURL.Items.Add (NewUrl);
end;

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

procedure TForm1.BtnGoClick(Sender: TObject);
begin
  GotoPage (ComboUrl.Text);
end;

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

procedure TForm1.FormShow(Sender: TObject);
begin
  GotoPage (ExtractFilePath (Application.ExeName) +
    'greeting.htm');
end;

procedure TForm1.GotoPage(ReqUrl: string);
begin
  WebBrowser1.Navigate (ReqUrl, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam);
end;

procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  StatusBar1.Panels[1].Text := Text;
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Downloading ' +
    WebBrowser1.LocationURL + '...';
end;

end.

object Form1: TForm1
  Left = 204
  Top = 127
  Width = 696
  Height = 480
  Caption = 'WebDemo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object WebBrowser1: TWebBrowser
    Left = 0
    Top = 36
    Width = 688
    Height = 398
    Align = alClient
    TabOrder = 0
    OnStatusTextChange = WebBrowser1StatusTextChange
    OnDownloadBegin = WebBrowser1DownloadBegin
    OnDownloadComplete = WebBrowser1DownloadComplete
    OnTitleChange = WebBrowser1TitleChange
    ControlData = {
      4C0000001B470000222900000100000005000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 434
    Width = 688
    Height = 19
    Panels = <
      item
        Width = 250
      end
      item
        Width = 50
      end>
    SimplePanel = False
  end
  object ControlBar1: TControlBar
    Left = 0
    Top = 0
    Width = 688
    Height = 36
    Align = alTop
    AutoSize = True
    BevelKind = bkSoft
    DockSite = False
    RowSize = 32
    TabOrder = 2
    object Panel1: TPanel
      Left = 11
      Top = 2
      Width = 514
      Height = 28
      BevelOuter = bvNone
      TabOrder = 0
      object BtnOpen: TSpeedButton
        Left = 1
        Top = 3
        Width = 73
        Height = 23
        Caption = 'Open File...'
        Flat = True
        OnClick = BtnOpenClick
      end
      object BtnGo: TSpeedButton
        Left = 478
        Top = 3
        Width = 32
        Height = 22
        Caption = 'Go'
        Flat = True
        OnClick = BtnGoClick
      end
      object ComboURL: TComboBox
        Left = 77
        Top = 3
        Width = 396
        Height = 21
        ItemHeight = 13
        TabOrder = 0
        OnKeyPress = ComboURLKeyPress
      end
    end
  end
  object OpenDialog1: TOpenDialog
    Filter = 'HTML file (*.htm)|*.htm|Any file (*.*)|*.*'
    Left = 40
    Top = 64
  end
end