Project Structure

• BrowseFast.dpr
• BrowseForm.pas
• BrowseForm.dfm

program BrowseFast;

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

{$R *.res}

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

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.

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