Solved

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

Posted on 2008-10-04
14
422 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
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
ScreenConnect 6.0 Free Trial

Want empowering updates? You're in the right place! Discover new features in ScreenConnect 6.0, based on partner feedback, to keep you business operating smoothly and optimally (the way it should be). Explore all of the extras and enhancements for yourself!

 
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

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Delphi XE2 application frozen on Windows 10 10 312
Delphi XE10, MySQL Query 4 143
how to update exe applicatio from internet ? 6 78
Multi-layered image in FireMonkey 9 35
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 I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
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…

810 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