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 21 - Project BrowseFast

Project Structure

BrowseFast.dpr
program BrowseFast;

uses
QForms,
 BrowseForm in 'BrowseForm.pas' {Form1};

{$R *.res}

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

interface

uses
SysUtils,Types,Classes,Variants, QGraphics, QControls, QForms, QDialogs,
 QStdCtrls, QComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
 IdTCPClient, IdHTTP, QExtCtrls, IdURI;

type
TForm1= class(TForm)
   ToolBar1: TToolBar;
   ToolButton4: TToolButton;
   PageControl1: TPageControl;
   TabSheet1: TTabSheet;
   TabSheet2: TTabSheet;
   Memo1: TMemo;
   ComboURL: TComboBox;
   TextBrowser1: TTextBrowser;
   IdHTTP1: TIdHTTP;
   StatusBar1: TStatusBar;
   ToolButton2: TToolButton;
   procedure ToolButton4Click(Sender: TObject);
   procedure ComboURLKeyPress(Sender: TObject; var Key: Char);
   procedure TextBrowser1HighlightText(Sender: TObject;
      const HighlightedText: WideString);
   procedure TextBrowser1Click(Sender: TObject);
   procedure ToolButton2Click(Sender: TObject);
 private
   LastUrl, NewRequest: String;
   nPos: Integer;
 public
   procedure GoToUrl (NewUrl: String);
 end;

var
Form1:TForm1;

implementation

{$R *.xfm}

procedureTForm1.ToolButton4Click(Sender:TObject);
begin
GoToUrl(ComboUrl.Text);
// reset back button
  nPos := 0;
end;

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

procedure TForm1.TextBrowser1HighlightText(Sender: TObject;
 const HighlightedText: WideString);
begin
  StatusBar1.SimpleText := 'Goto: ' + HighlightedText;
  NewRequest := HighlightedText;
end;

procedure TForm1.TextBrowser1Click(Sender: TObject);
var
 Uri: TIdUri;
begin
  if NewRequest <> '' then
  begin
    Uri := TIdUri.Create (LastUrl);
    if Pos ('http:', NewRequest) > 0 then
      GoToUrl (NewRequest)
    else if NewRequest [1] = '/' then
      GoToUrl ('http://' + Uri.Host + NewRequest)
    else
      GoToUrl ('http://' + Uri.Host + Uri.Path + NewRequest);
    nPos := 0;
  end;
end;

procedure TForm1.GoToUrl(NewUrl: String);
begin
 // add to history list
  if (NewUrl <> '') then
  begin
    if ComboURL.Items.IndexOf (NewUrl) < 0 then
      ComboURL.Items.Insert (0, NewUrl);
    ComboURL.Text := NewUrl;
  end;

  TextBrowser1.Text := IdHttp1.Get (NewUrl);
  Memo1.Lines.Text := TextBrowser1.Text;
  // TextBrowser1.Factory.FilePath.Add (NewUrl);
  LastUrl := NewUrl;
  NewRequest := '';
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
 Inc (nPos);
  if NPos < ComboUrl.Items.Count then
    GoToUrl(ComboUrl.Items[nPos])
  else
    ToolButton2.Enabled := False;
end;

end.
BrowseForm.xfm
object Form1: TForm1
  Left = 236
  Top = 125
  Width = 718
  Height = 526
  VertScrollBar.Range = 29
  ActiveControl = ComboURL
  Caption = 'HtmlEdit'
  Color = clBackground
  PixelsPerInch = 75
  TextHeight = 13
  TextWidth = 6
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 718
    Height = 29
    ButtonHeight = 20
    ButtonWidth = 34
    Caption = 'ToolBar1'
    ShowCaptions = True
    TabOrder = 0
    object ToolButton4: TToolButton
      Left = 397
      Top = 4
      Height = 20
      Caption = 'Go'
      ImageIndex = 3
      OnClick = ToolButton4Click
    end
    object ComboURL: TComboBox
      Left = 1
      Top = 4
      Width = 396
      Height = 21
      AutoComplete = True
      ItemHeight = 15
      Items.Strings = (
        'http://www.marcocantu.com'
        'http://www.borland.com'
        'http://community.borland.com')
      TabOrder = 1
      OnKeyPress = ComboURLKeyPress
    end
    object ToolButton2: TToolButton
      Left = 431
      Top = 4
      Height = 20
      Caption = 'Back'
      ImageIndex = 5
      OnClick = ToolButton2Click
    end
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 29
    Width = 718
    Height = 497
    ActivePage = TabSheet1
    Align = alClient
    TabOrder = 1
    object TabSheet1: TTabSheet
      Caption = 'View'
      object TextBrowser1: TTextBrowser
        Left = 0
        Top = 0
        Width = 710
        Height = 448
        Align = alClient
        TabOrder = 0
        OnClick = TextBrowser1Click
        OnHighlightText = TextBrowser1HighlightText
      end
      object StatusBar1: TStatusBar
        Left = 0
        Top = 448
        Width = 710
        Height = 19
        Panels = <>
        SimplePanel = True
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'Source'
      ImageIndex = 1
      object Memo1: TMemo
        Left = 0
        Top = 0
        Width = 710
        Height = 467
        Align = alClient
        ReadOnly = True
        TabOrder = 0
      end
    end
  end
  object IdHTTP1: TIdHTTP
    HandleRedirects = True
    Request.Accept = 'text/html, */*'
    Request.ContentLength = 0
    Request.ContentRangeEnd = 0
    Request.ContentRangeStart = 0
    Request.ProxyPort = 0
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    Left = 48
    Top = 80
  end
end