?
Solved

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

Posted on 2008-10-04
14
Medium Priority
?
448 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
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 2000 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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…
Suggested Courses

650 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