Solved

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

Posted on 2008-10-04
14
415 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
  • 7
  • 5
14 Comments
 
LVL 21

Expert Comment

by:ziolko
Comment Utility
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
Comment Utility
*that's unit to handle browsing history that I wrote sometime ago*

ziolko.
0
 

Author Comment

by:geocoins-software
Comment Utility
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
 
LVL 21

Expert Comment

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

ziolko.
0
 
LVL 21

Expert Comment

by:ziolko
Comment Utility
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
Comment Utility
>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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 21

Expert Comment

by:ziolko
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
THANKS!
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

771 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now