Solved

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

Posted on 2008-10-04
14
435 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: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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

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…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Come and listen to Percona CEO Peter Zaitsev discuss what’s new in Percona open source software, including Percona Server for MySQL (https://www.percona.com/software/mysql-database/percona-server) and MongoDB (https://www.percona.com/software/mongo-…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

729 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