geocoins-software
asked on
TWebBrowser - Back, Forward, Stop, & Refresh Buttons ???
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
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;
*that's unit to handle browsing history that I wrote sometime ago*
ziolko.
ziolko.
ASKER
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
????
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
this was not for history of webbrowser:)
I'll post simple demo in a few minutes.
ziolko.
I'll post simple demo in a few minutes.
ziolko.
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 WebBrowser1NavigateComplet e2(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(edtAd dress.Text );
end;
procedure TForm1.WebBrowser1Navigate Complete2( Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if FBrowseHistory.IsCurrentEq ual(URL, 0, 0) then
FBrowseHistory.SwapCurrent (URL, 0, 0)
else
FBrowseHistory.NewHistoryI tem(UrL, 0, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FBrowseHistory := TBrowseHistory.Create;
FBrowseHistory.HistoryLeng th := 25;
FBrowseHistory.OnHistoryIt emSelected := OnHistorySelected;
FBrowseHistory.OnHistoryCh anged := OnHistoryChanged;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FBrowseHistory) ;
end;
procedure TForm1.btnBackClick(Sender : TObject);
begin
FBrowseHistory.GoBack;
end;
procedure TForm1.btnForwardClick(Sen der: TObject);
begin
FBrowseHistory.GoForward;
end;
procedure TForm1.OnHistorySelected(c onst ACaption: string; AWParam,
ALParam: Integer);
begin
edtAddress.Text := ACaption;
btnGo.Click;
end;
procedure TForm1.OnHistoryChanged(Se nder: TObject);
var cnt: Integer;
begin
btnBack.Enabled := FBrowseHistory.Back.Count > 0;
btnForward.Enabled := FBrowseHistory.Forward.Cou nt >0;
Memo1.Clear;
for cnt := FBrowseHistory.Back.Count - 1 downto 0 do
Memo1.Lines.Add(FBrowseHis tory.Back[ cnt].Capti on);
Memo2.Clear;
for cnt := FBrowseHistory.Forward.Cou nt - 1 downto 0 do
Memo2.Lines.Add(FBrowseHis tory.Forwa rd[cnt].Ca ption);
end;
end.
ziolko.
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 WebBrowser1NavigateComplet
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(edtAd
end;
procedure TForm1.WebBrowser1Navigate
const pDisp: IDispatch; var URL: OleVariant);
begin
if FBrowseHistory.IsCurrentEq
FBrowseHistory.SwapCurrent
else
FBrowseHistory.NewHistoryI
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FBrowseHistory := TBrowseHistory.Create;
FBrowseHistory.HistoryLeng
FBrowseHistory.OnHistoryIt
FBrowseHistory.OnHistoryCh
end;
procedure TForm1.FormDestroy(Sender:
begin
FreeAndNil(FBrowseHistory)
end;
procedure TForm1.btnBackClick(Sender
begin
FBrowseHistory.GoBack;
end;
procedure TForm1.btnForwardClick(Sen
begin
FBrowseHistory.GoForward;
end;
procedure TForm1.OnHistorySelected(c
ALParam: Integer);
begin
edtAddress.Text := ACaption;
btnGo.Click;
end;
procedure TForm1.OnHistoryChanged(Se
var cnt: Integer;
begin
btnBack.Enabled := FBrowseHistory.Back.Count > 0;
btnForward.Enabled := FBrowseHistory.Forward.Cou
Memo1.Clear;
for cnt := FBrowseHistory.Back.Count - 1 downto 0 do
Memo1.Lines.Add(FBrowseHis
Memo2.Clear;
for cnt := FBrowseHistory.Forward.Cou
Memo2.Lines.Add(FBrowseHis
end;
end.
ziolko.
ASKER
>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 ???
Sorry, I am not understanding anything you are saying.
It is not for the webbrowser history??????
Isn't that what i am loking for ???
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.
ziolko.
ASKER
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
I will get back to you
thanks
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.
function THistoryItem.IsEqual(const
begin
{ Result := (FPageID = APageID) and
((FSubCategory = ASubCategory) or (FSubCategory = -1));}
Result := SameText(FCaption, ACaption);
end;
ziolko.
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
Full source and other staff at http://www.bsalsa.com/downloads.html
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Great! and with a little googling, i found this to handle the updates of my buttons.
procedure TfrmMain.WebBrowser2Comman dStateChan ge(Sender: TObject;
Command: Integer; Enable: WordBool);
begin
case Command of
CSC_NAVIGATEBACK: btnBack.Enabled := Enable;
CSC_NAVIGATEFORWARD: btnForward.Enabled := Enable;
end;
end;
procedure TfrmMain.WebBrowser2Comman
Command: Integer; Enable: WordBool);
begin
case Command of
CSC_NAVIGATEBACK: btnBack.Enabled := Enable;
CSC_NAVIGATEFORWARD: btnForward.Enabled := Enable;
end;
end;
ASKER
THANKS!
(*************************
*
* 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
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:THistory
begin
if FList.Count > 0 then begin
Result := THistoryItem(FList[FList.C
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(Ind
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
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(FCurrentPositio
inherited Destroy;
end;
procedure TBrowseHistory.DoHistory;
begin
FLockAdd := True;
if Assigned(FOnHistory) and (Assigned(FCurrentPosition
FOnHistory(FCurrentPositio
FLockAdd := False;
end;
procedure TBrowseHistory.DoHistoryCh
begin
if Assigned(FOnHistoryChanged
FOnHistoryChanged(Self);
end;
procedure TBrowseHistory.SetHistoryL
begin
FBack.MaxLength := Value;
FForward.MaxLength := Value;
DoHistoryChanged;
end;
function TBrowseHistory.GetHistoryL
begin
Result := FBack.MaxLength;
end;
procedure TBrowseHistory.GoBack(AGoB
var cnt: Integer;
begin
for cnt := 1 to AGoBy do begin
FForward.Push(FCurrentPosi
FCurrentPosition := FBack.Pop;
end;
DoHistoryChanged;
DoHistory;
end;
procedure TBrowseHistory.GoForward(A
var cnt: Integer;
begin
for cnt := 1 to AGoBy do begin
FBack.Push(FCurrentPositio
FCurrentPosition := FForward.Pop;
end;
DoHistoryChanged;
DoHistory;
end;
procedure TBrowseHistory.NewHistoryI
begin
if not FLockAdd then begin
FForward.Clear;
FBack.Push(FCurrentPositio
FCurrentPosition := THistoryItem.Create(ACapti
DoHistoryChanged;
end;
end;
procedure TBrowseHistory.SwapCurrent
begin
if Assigned(FCurrentPosition)
FCurrentPosition.Swap(ACap
end;
function TBrowseHistory.IsCurrentEq
begin
Result := Assigned(FCurrentPosition)
if Result then
Result := FCurrentPosition.IsEqual(A
end;
end.
ziolko.