Logo New book: Delphi 2007 Handbook
My blog in online
Delphi tech support service: support.marcocantu.com
Google
  Web www.marcocantu.com

Menu for Development

Site Menu
Delphi 2007 Handbook
Mastering Borland Delphi 2005
Essential Pascal
Essential Delphi
Buy Books Online
Code Repository
Newsgroups
White Papers
Tools
Conferences
Training
Delphi Links
Contact Marco

My Other Sites
Italian Site (www.marcocantu.it)
Developers Newsgroups Browser (dev.newswhat.com)
My town (www.piazzacavalli.net)
the delphi search
Wintech Italia (my company)

Breaking News
Buy Mastering Borland Delphi 2005 from Amazon
Free ebook: Mastering Delphi Update for Delphi 2006

Advertising
Home My Blog Books My Bookstore Development Links 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