Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 20 - Project WebDemo

Project Structure

WebDemo.dpr
program WebDemo;

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

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
WebDemoF.pas
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.
WebDemoF.dfm
object Form1: TForm1
  Left = 199
  Top = 242
  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
      8000000000000000000000000000000000000000000000000000000000000000
      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