Solved

TWebBrowser - Back, Forward, Stop, & Refresh Buttons ???

Posted on 2008-10-04
14
426 Views
Last Modified: 2012-05-07
I am trying to implement buttons for my TWebBrowser. But the Forward and Back do not seem to work.

Can any one help me

Thanks
private
    { Private declarations }
    UrlStr: String;
    HistoryIndex: Integer;
    HistoryList: TStringList;
    procedure FindAddress;
  end;
 
procedure TfrmMain.FindAddress;
var
  Flags: OLEVariant;
begin
  Flags := 0;
  pnlProgress.PartsComplete:= 0;
  pnlProgress.TotalParts:= 100;
  WebBrowser2.Navigate(WideString(UrlStr), Flags, Flags, Flags, Flags);
end;
 
procedure TfrmMain.actBackUpdate(Sender: TObject);
begin
 if HistoryList.Count > 0 then
  btnBack.Enabled := HistoryIndex > 0
 else
  btnBack.Enabled := False;
end;
 
procedure TfrmMain.actForwardUpdate(Sender: TObject);
begin
 if HistoryList.Count > 0 then
  btnForward.Enabled := HistoryIndex < HistoryList.Count - 1
 else
  btnForward.Enabled := False;
end;
 
procedure TfrmMain.actStopExecute(Sender: TObject);
begin
 WebBrowser2.Stop;
end;
 
procedure TfrmMain.actRefreshExecute(Sender: TObject);
begin
 FindAddress;
end;
 
procedure TfrmMain.actForwardExecute(Sender: TObject);
begin
 URLStr := HistoryList[HistoryIndex + 1];
 FindAddress;
end;
 
procedure TfrmMain.actBackExecute(Sender: TObject);
begin
  URLStr := HistoryList[HistoryIndex - 1];
  FindAddress;
end;
 
procedure TfrmMain.WebBrowser2BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
 NewIndex: Integer;
begin
  NewIndex := HistoryList.IndexOf(URL);
  if NewIndex = -1 then
  begin
    if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
      while HistoryList.Count > HistoryIndex do
        HistoryList.Delete(HistoryIndex);
    HistoryIndex := HistoryList.Add(URL);
  end
  else
    HistoryIndex := NewIndex;
  URLStr:= URL;
end;
 
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
 HistoryList.Free;
end;
 
procedure TfrmMain.FormCreate(Sender: TObject);
begin
 HistoryIndex := -1;
 HistoryList := TStringList.Create;
end;

Open in new window

0
Comment
Question by:geocoins-software
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 5
14 Comments
 
LVL 21

Expert Comment

by:ziolko
ID: 22641491
that's unit to handle browsing history sometime ago, if you get rid of all references to pageId and subcategory it should work fine

(***************************************************************
 *
 * Unit Name: uBrowseHistory
 *
 * Author : Lukasz Zielinski
 * Created: 06-Jun-2006
 *
 *
 *
 ****************************************************************)

unit uBrowseHistory;

interface

uses Classes;

type

  THistoryItem = class(TObject)
  private
    FCaption: string;
    FPageID: Integer;
    FSubCategory: Integer;
  public
    constructor Create(const ACaption: string; APageID, ASubCategory: Integer);
    function IsEqual(const ACaption: string; APageID, ASubCategory: Integer):Boolean;
    procedure Swap(const ACaption: string; APageID, ASubCategory: Integer);
    property Caption: string read FCaption;
    property PageID: Integer read FPageID;
    property SubCategory: Integer read FSubCategory;
  end;

  THistoryItems = class(TObject)
  private
    FList: TList; // dont use TObjectList since Remove() and Delete() are used only to remove items from list without destroying them
    FMaxLength: Word;
    function GetCount: Integer;
    function GetItems(Index: Integer): THistoryItem;
    procedure Trim;
    procedure SetMaxLength(Value: Word);
  public
    constructor Create;
    destructor Destroy;override;
    procedure Clear;
    procedure Push(AItem: THistoryItem);
    function Pop:THistoryItem;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: THistoryItem read GetItems;default;
    property MaxLength: Word read FMaxLength write SetMaxLength;
  end;

  THistoryItemSelectedEvent = procedure(const ACaption: string; AWParam, ALParam: Integer) of object;

  TBrowseHistory = class(TObject)
  private
    FLockAdd: Boolean;
    FBack: THistoryItems;
    FForward: THistoryItems;
    FCurrentPosition: THistoryItem;
    FOnHistory: THistoryItemSelectedEvent;
    FOnHistoryChanged: TNotifyEvent;
    procedure DoHistory;
    procedure DoHistoryChanged;
    procedure SetHistoryLength(Value: Word);
    function GetHistoryLength: Word;
  public
    constructor Create;
    destructor Destroy;override;
    procedure NewHistoryItem(const ACaption: string; APageID, ASubCategory: Integer);
    procedure SwapCurrent(const ACaption: string; APageID, ASubCategory: Integer);
    function IsCurrentEqual(const ACaption: string; APageID, ASubCategory: Integer):Boolean;
    procedure GoForward(AGoBy: Integer = 1);
    procedure GoBack(AGoBy: Integer = 1);
    property Back: THistoryItems read FBack;
    property Forward: THistoryItems read FForward;
    property HistoryLength: Word read GetHistoryLength write SetHistoryLength;
    property OnHistoryItemSelected: THistoryItemSelectedEvent read FOnHistory write FOnHistory;
    property OnHistoryChanged: TNotifyEvent read FOnHistoryChanged write FOnHistoryChanged;
  end;

implementation

uses Windows, SysUtils;

{ THistoryItem }

constructor THistoryItem.Create(const ACaption: string; APageID, ASubCategory: Integer);
begin
  inherited Create;
  Swap(ACaption, APageID, ASubCategory);  
end;

function THistoryItem.IsEqual(const ACaption: string; APageID, ASubCategory: Integer):Boolean;
begin
  Result := (FPageID = APageID) and
            ((FSubCategory = ASubCategory) or (FSubCategory = -1));
end;

procedure THistoryItem.Swap(const ACaption: string; APageID, ASubCategory: Integer);
begin
  FCaption := ACaption;
  FPageID := APageID;
  FSubCategory := ASubCategory;
end;

{ THistoryItems }

constructor THistoryItems.Create;
begin
  inherited Create;
  FMaxLength := 20;
  FList := TList.Create;
end;

destructor THistoryItems.Destroy;
begin
  Clear;
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure THistoryItems.Push(AItem: THistoryItem);
begin
  if Assigned(AItem) then
    FList.Add(AItem);
  Trim;
end;

function THistoryItems.Pop:THistoryItem;
begin
  if FList.Count > 0 then begin
    Result := THistoryItem(FList[FList.Count - 1]);
    FList.Remove(Result);  
  end else
    Result := nil;
end;

procedure THistoryItems.Clear;
var it: THistoryItem;
begin
  while FList.Count > 0 do begin
    it := THistoryItem(FList[0]);
    it.Free;
    FList.Delete(0);
  end;
end;

function THistoryItems.GetCount: Integer;
begin
  Result := FList.Count;  
end;

function THistoryItems.GetItems(Index: Integer): THistoryItem;
begin
  Result := THistoryItem(FList[Index]);
end;

procedure THistoryItems.Trim;
var it: THistoryItem;
begin
  while FList.Count > FMaxLength do begin
    it := FList[0];
    FList.Delete(0);
    FreeAndNil(it);
  end;
end;

procedure THistoryItems.SetMaxLength(Value: Word);
begin
  FMaxLength := Value;
  Trim;
end;

{ TBrowseHistory }

constructor TBrowseHistory.Create;
begin
  inherited Create;
  FLockAdd := False;
  FBack := THistoryItems.Create;
  FForward := THistoryItems.Create;
  FCurrentPosition := nil;    
end;

destructor TBrowseHistory.Destroy;
begin
  FreeAndNil(FBack);
  FreeAndNil(FForward);
  FreeAndNil(FCurrentPosition);
  inherited Destroy;
end;

procedure TBrowseHistory.DoHistory;
begin
  FLockAdd := True;
  if Assigned(FOnHistory) and (Assigned(FCurrentPosition)) then
    FOnHistory(FCurrentPosition.Caption, FCurrentPosition.PageID, FCurrentPosition.SubCategory);
  FLockAdd := False;
end;

procedure TBrowseHistory.DoHistoryChanged;
begin
  if Assigned(FOnHistoryChanged) then
    FOnHistoryChanged(Self);
end;

procedure TBrowseHistory.SetHistoryLength(Value: Word);
begin
  FBack.MaxLength := Value;
  FForward.MaxLength := Value;
  DoHistoryChanged;    
end;

function TBrowseHistory.GetHistoryLength: Word;
begin
  Result := FBack.MaxLength;  
end;

procedure TBrowseHistory.GoBack(AGoBy: Integer = 1);
var cnt: Integer;
begin
  for cnt := 1 to AGoBy do begin
    FForward.Push(FCurrentPosition);
    FCurrentPosition := FBack.Pop;
  end;
  DoHistoryChanged;
  DoHistory;
end;

procedure TBrowseHistory.GoForward(AGoBy: Integer = 1);
var cnt: Integer;
begin
  for cnt := 1 to AGoBy do begin
    FBack.Push(FCurrentPosition);
    FCurrentPosition := FForward.Pop;
  end;
  DoHistoryChanged;
  DoHistory;
end;

procedure TBrowseHistory.NewHistoryItem(const ACaption: string; APageID, ASubCategory: Integer);
begin
  if not FLockAdd then begin
    FForward.Clear;
    FBack.Push(FCurrentPosition);
    FCurrentPosition := THistoryItem.Create(ACaption, APageID, ASubCategory);
    DoHistoryChanged;
  end;
end;

procedure TBrowseHistory.SwapCurrent(const ACaption: string; APageID, ASubCategory: Integer);
begin
  if Assigned(FCurrentPosition) then
    FCurrentPosition.Swap(ACaption, APageID, ASubCategory);
end;

function TBrowseHistory.IsCurrentEqual(const ACaption: string; APageID, ASubCategory: Integer):Boolean;
begin
  Result := Assigned(FCurrentPosition);
  if Result then
    Result := FCurrentPosition.IsEqual(ACaption, APageID, ASubCategory);      
end;

end.

ziolko.
0
 
LVL 21

Expert Comment

by:ziolko
ID: 22641496
*that's unit to handle browsing history that I wrote sometime ago*

ziolko.
0
 

Author Comment

by:geocoins-software
ID: 22641528
huh?   I don't have anything in my code with a pageId or subcategory.

????

What , do you want me to use your UNIT?  Seems like a lot of code. My code is from the Delphi demos folder

besides, If i use your unit, you never explained how to use it. DO you have a demo which uses the unit

thanks
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 21

Expert Comment

by:ziolko
ID: 22641551
this was not for history of webbrowser:)
I'll post simple demo in a few minutes.

ziolko.
0
 
LVL 21

Expert Comment

by:ziolko
ID: 22641630
ooops wrong source:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, Menus, uBrowseHistory;

type
  TForm1 = class(TForm)
    btnBack: TButton;
    btnForward: TButton;
    btnRefresh: TButton;
    WebBrowser1: TWebBrowser;
    btnGo: TButton;
    edtAddress: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure btnGoClick(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure btnForwardClick(Sender: TObject);
  private
    FBrowseHistory: TBrowseHistory;
    FLastAddress: string;
    procedure OnHistorySelected(const ACaption: string; AWParam, ALParam: Integer);
    procedure OnHistoryChanged(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnGoClick(Sender: TObject);
begin
  WebBrowser1.Navigate(edtAddress.Text);
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  if FBrowseHistory.IsCurrentEqual(URL, 0, 0) then
    FBrowseHistory.SwapCurrent(URL, 0, 0)
  else
    FBrowseHistory.NewHistoryItem(UrL, 0, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBrowseHistory := TBrowseHistory.Create;
  FBrowseHistory.HistoryLength := 25;
  FBrowseHistory.OnHistoryItemSelected := OnHistorySelected;
  FBrowseHistory.OnHistoryChanged := OnHistoryChanged;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FBrowseHistory);
end;

procedure TForm1.btnBackClick(Sender: TObject);
begin
  FBrowseHistory.GoBack;
end;

procedure TForm1.btnForwardClick(Sender: TObject);
begin
  FBrowseHistory.GoForward;
end;

procedure TForm1.OnHistorySelected(const ACaption: string; AWParam,
  ALParam: Integer);
begin
  edtAddress.Text := ACaption;
  btnGo.Click;
end;

procedure TForm1.OnHistoryChanged(Sender: TObject);
var cnt: Integer;
begin
  btnBack.Enabled := FBrowseHistory.Back.Count > 0;
  btnForward.Enabled := FBrowseHistory.Forward.Count >0;
  Memo1.Clear;
  for cnt := FBrowseHistory.Back.Count - 1 downto 0 do
    Memo1.Lines.Add(FBrowseHistory.Back[cnt].Caption);
  Memo2.Clear;
  for cnt := FBrowseHistory.Forward.Count - 1 downto 0 do
    Memo2.Lines.Add(FBrowseHistory.Forward[cnt].Caption);
end;

end.


ziolko.
0
 

Author Comment

by:geocoins-software
ID: 22641637
>this was not for history of webbrowser:)

Sorry, I am not understanding anything you are saying.

It is not for the webbrowser history??????

Isn't that what i am loking for  ???

0
 
LVL 21

Expert Comment

by:ziolko
ID: 22641645
well I've created it for other purposes but if you look at sample you'll see that it will work with webbrowser too

ziolko.
0
 

Author Comment

by:geocoins-software
ID: 22641654
ok, there is a lot to digest here. I will have to start from beginning and slowly go through it all.

I will get back to you

thanks
0
 
LVL 21

Expert Comment

by:ziolko
ID: 22641659
just make sure that you'll change this in uBrowserHistory:

function THistoryItem.IsEqual(const ACaption: string; APageID, ASubCategory: Integer):Boolean;
begin
{  Result := (FPageID = APageID) and
            ((FSubCategory = ASubCategory) or (FSubCategory = -1));}
  Result := SameText(FCaption, ACaption);
end;

ziolko.
0
 
LVL 5

Expert Comment

by:wd123
ID: 22642428
with EmbeddedWB it's not a problem, you can see at demo exe file: http://www.bsalsa.com/Downloads/EmbeddedWB_Demo_Exe_File.zip
Full source and other staff at http://www.bsalsa.com/downloads.html
0
 
LVL 21

Accepted Solution

by:
ziolko earned 500 total points
ID: 22642863
I'm so so stupid, I was suggested by your code, and it is so simple:
 
WebBrowser1.GoBack
WebBrowser1.GoForward

ziolko.
0
 

Author Comment

by:geocoins-software
ID: 22642934
Great!  and with a little googling, i found this to handle the updates of my buttons.

procedure TfrmMain.WebBrowser2CommandStateChange(Sender: TObject;
  Command: Integer; Enable: WordBool);
begin
  case Command of
    CSC_NAVIGATEBACK: btnBack.Enabled := Enable;
    CSC_NAVIGATEFORWARD: btnForward.Enabled := Enable;
  end;
end;
0
 

Author Closing Comment

by:geocoins-software
ID: 31597320
THANKS!
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

756 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question