You've already forked lazarus-ccr
missing file
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2177 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
457
components/rx/rxhistorynavigator.pas
Normal file
457
components/rx/rxhistorynavigator.pas
Normal file
@ -0,0 +1,457 @@
|
||||
{ RxHistoryNavigator unit
|
||||
|
||||
Copyright (C) 2005-2011 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit RxHistoryNavigator;
|
||||
|
||||
{$I rx.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, rxtoolbar,
|
||||
Menus;
|
||||
|
||||
type
|
||||
PNavigateRec = ^TNavigateRec;
|
||||
TNavigateRec = record
|
||||
Name:string;
|
||||
Cond:string;
|
||||
Next:PNavigateRec;
|
||||
end;
|
||||
|
||||
type
|
||||
TRxHistoryNavigator = class;
|
||||
THistoryNavigateEvent = procedure(Sender:TRxHistoryNavigator; AInfo:string; AProcessed:boolean) of object;
|
||||
|
||||
{ TRxHistoryNavigator }
|
||||
|
||||
TRxHistoryNavigator = class(TComponent)
|
||||
private
|
||||
FForwardBtnItem:TToolbarItem;
|
||||
FForwardBtn: string;
|
||||
|
||||
FBackBtnItem:TToolbarItem;
|
||||
FBackBtn: string;
|
||||
First:PNavigateRec;
|
||||
Curr:PNavigateRec;
|
||||
FMaxPopupItems: integer;
|
||||
|
||||
FOnHistoryNavigate: THistoryNavigateEvent;
|
||||
FToolPanel: TToolPanel;
|
||||
PMBack:TPopupMenu;
|
||||
PMForw:TPopupMenu;
|
||||
function GetBackBtn: string;
|
||||
function GetForwardBtn: string;
|
||||
procedure SetBackBtn(AValue: string);
|
||||
procedure SetForwardBtn(AValue: string);
|
||||
procedure SetToolPanel(AValue: TToolPanel);
|
||||
procedure ClearFromCurrent(var C:PNavigateRec);
|
||||
|
||||
procedure CreateBackMenu;
|
||||
procedure CreateRetrMenu;
|
||||
|
||||
function Last:PNavigateRec;
|
||||
function Prior(R:PNavigateRec):PNavigateRec;
|
||||
procedure CheckTop;
|
||||
procedure CheckBottom;
|
||||
procedure EnableAction(ActName:byte; Enable:boolean);
|
||||
procedure BackProc(Sender: TObject);
|
||||
procedure ForwardProc(Sender: TObject);
|
||||
procedure DoSetItems;
|
||||
protected
|
||||
function Navigate(ToTop:boolean; Count:integer):boolean;
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ClearHistory;
|
||||
procedure AddToHistory(AHistoryCaption, AInfo:string);
|
||||
published
|
||||
property ToolPanel: TToolPanel read FToolPanel write SetToolPanel;
|
||||
property BackBtn:string read GetBackBtn write SetBackBtn;
|
||||
property ForwardBtn:string read GetForwardBtn write SetForwardBtn;
|
||||
property OnHistoryNavigate:THistoryNavigateEvent read FOnHistoryNavigate write FOnHistoryNavigate;
|
||||
property MaxPopupItems:integer read FMaxPopupItems write FMaxPopupItems default 10;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses ActnList, rxconst;
|
||||
|
||||
{ TRxHistoryNavigator }
|
||||
|
||||
procedure TRxHistoryNavigator.SetToolPanel(AValue: TToolPanel);
|
||||
begin
|
||||
if FToolPanel=AValue then Exit;
|
||||
FToolPanel:=AValue;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.ClearFromCurrent(var C: PNavigateRec);
|
||||
var
|
||||
R:PNavigateRec;
|
||||
begin
|
||||
while C<>nil do
|
||||
begin
|
||||
R:=C;
|
||||
C:=C^.Next;
|
||||
Dispose(R);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.CreateRetrMenu;
|
||||
var i:integer;
|
||||
S:PNavigateRec;
|
||||
Item:TMenuItem;
|
||||
begin
|
||||
if Curr=nil then exit;
|
||||
PMForw.Items.Clear;
|
||||
i:=0;
|
||||
S:=Curr^.Next;
|
||||
while (i<FMaxPopupItems) and (S<>nil) do
|
||||
begin
|
||||
Item := TMenuItem.Create(Self);
|
||||
Item.Caption := S^.Name;
|
||||
Item.OnClick := @ForwardProc;
|
||||
Item.Hint:=Format(sHistoryDesc, [S^.Cond]);
|
||||
Item.Tag:=i;
|
||||
PMForw.Items.Add(Item);
|
||||
inc(i);
|
||||
S:=S^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxHistoryNavigator.Last: PNavigateRec;
|
||||
begin
|
||||
if First=nil then Result:=nil
|
||||
else
|
||||
begin
|
||||
Result:=First;
|
||||
while Result^.Next<>nil do Result:=Result^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxHistoryNavigator.Prior(R: PNavigateRec): PNavigateRec;
|
||||
var
|
||||
L:PNavigateRec;
|
||||
begin
|
||||
if First=nil then Result:=nil
|
||||
else
|
||||
begin
|
||||
L:=First;
|
||||
while (L^.Next<>nil) and (L^.Next<>R) do
|
||||
begin
|
||||
L:=L^.Next;
|
||||
end;
|
||||
if L^.Next=nil then Result:=nil else Result:=l;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.CheckTop;
|
||||
begin
|
||||
EnableAction(0, (Curr<>nil) and (Curr<>First));
|
||||
end;
|
||||
|
||||
|
||||
procedure TRxHistoryNavigator.CheckBottom;
|
||||
begin
|
||||
EnableAction(1, (Curr<>nil) and (Curr^.Next<>nil));
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.EnableAction(ActName: byte; Enable: boolean);
|
||||
begin
|
||||
if First=nil then Enable:=false;
|
||||
if ActName = 0 then (FBackBtnItem.Action as TAction).Enabled:=Enable
|
||||
else (FForwardBtnItem.Action as TAction).Enabled:=Enable
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.BackProc(Sender: TObject);
|
||||
begin
|
||||
Navigate(true, (Sender as TComponent).Tag);
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.ForwardProc(Sender: TObject);
|
||||
begin
|
||||
Navigate(false, (Sender as TComponent).Tag);
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.DoSetItems;
|
||||
begin
|
||||
if Assigned(FToolPanel) then
|
||||
begin
|
||||
FForwardBtnItem:=FToolPanel.Items.ByActionName[FForwardBtn];
|
||||
if Assigned(FForwardBtnItem) then
|
||||
begin
|
||||
FForwardBtnItem.DropDownMenu:=PMForw;
|
||||
FForwardBtnItem.Action.OnExecute:=@ForwardProc;
|
||||
end;
|
||||
|
||||
FBackBtnItem:=FToolPanel.Items.ByActionName[FBackBtn];
|
||||
if Assigned(FBackBtnItem) then
|
||||
begin
|
||||
FBackBtnItem.DropDownMenu:=PMBack;
|
||||
FBackBtnItem.Action.OnExecute:=@BackProc;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxHistoryNavigator.Navigate(ToTop: boolean; Count: integer): boolean;
|
||||
var
|
||||
F:boolean;
|
||||
Condit: string;
|
||||
begin
|
||||
Result:=false;
|
||||
if First=nil then exit;
|
||||
if ToTop then
|
||||
begin
|
||||
inc(Count);
|
||||
repeat
|
||||
Curr:=Prior(Curr);
|
||||
if Curr=nil then Curr:=First;
|
||||
Dec(Count);
|
||||
until (Count=0) or (Curr=First);
|
||||
Result:=true;
|
||||
Condit:=Curr^.Cond;
|
||||
CreateBackMenu;
|
||||
CreateRetrMenu;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(Count);
|
||||
repeat
|
||||
if Curr^.Next<>nil then Curr:=Curr^.Next;
|
||||
Dec(Count);
|
||||
until (Count=0) or (Curr^.Next=nil);
|
||||
Result:=true;
|
||||
Condit:=Curr^.Cond;
|
||||
CreateRetrMenu;
|
||||
CreateBackMenu;
|
||||
end;
|
||||
CheckTop;
|
||||
CheckBottom;
|
||||
F:=true;
|
||||
if Assigned(FOnHistoryNavigate) and Assigned(Curr) then
|
||||
FOnHistoryNavigate(Self, Condit, F);
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
DoSetItems;
|
||||
CheckTop;
|
||||
CheckBottom;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if Operation = opRemove then
|
||||
begin
|
||||
if AComponent = FToolPanel then
|
||||
begin
|
||||
if Assigned(FForwardBtnItem) then
|
||||
begin
|
||||
FForwardBtnItem.Action.OnExecute:=nil;
|
||||
FForwardBtnItem:=nil;
|
||||
end;
|
||||
|
||||
if Assigned(FBackBtnItem) then
|
||||
begin
|
||||
FBackBtnItem.Action.OnExecute:=nil;
|
||||
FBackBtnItem:=nil;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if AComponent = Self then
|
||||
begin
|
||||
if Assigned(FForwardBtnItem) then
|
||||
begin
|
||||
FForwardBtnItem.Action.OnExecute:=nil;
|
||||
FForwardBtnItem.DropDownMenu:=nil;
|
||||
FForwardBtnItem:=nil;
|
||||
end;
|
||||
|
||||
if Assigned(FBackBtnItem) then
|
||||
begin
|
||||
FBackBtnItem.Action.OnExecute:=nil;
|
||||
FBackBtnItem.DropDownMenu:=nil;
|
||||
FBackBtnItem:=nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.CreateBackMenu;
|
||||
var i:integer;
|
||||
S:PNavigateRec;
|
||||
Item:TMenuItem;
|
||||
begin
|
||||
if Curr=nil then exit;
|
||||
PMBack.Items.Clear;
|
||||
i:=0;
|
||||
S:=Curr;
|
||||
while (i<FMaxPopupItems) and (S<>First) do
|
||||
begin
|
||||
Item := TMenuItem.Create(Self);
|
||||
Item.Caption := S^.Name;
|
||||
Item.OnClick := @BackProc;
|
||||
Item.Hint:=Format(sHistoryDesc, [S^.Cond]);
|
||||
Item.Tag:=i;
|
||||
PMBack.Items.Add(Item);
|
||||
inc(i);
|
||||
S:=Prior(S);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TRxHistoryNavigator.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
PMBack:=TPopupMenu.Create(Self);
|
||||
PMBack.Parent:=Self;
|
||||
PMForw:=TPopupMenu.Create(Self);
|
||||
PMForw.Parent:=Self;
|
||||
FMaxPopupItems:=10;
|
||||
end;
|
||||
|
||||
destructor TRxHistoryNavigator.Destroy;
|
||||
begin
|
||||
Curr:=nil;
|
||||
ClearFromCurrent(First);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.ClearHistory;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.AddToHistory(AHistoryCaption, AInfo: string);
|
||||
var
|
||||
R, L:PNavigateRec;
|
||||
begin
|
||||
New(R);
|
||||
FillChar(R^, SizeOf(TNavigateRec), 0);
|
||||
R^.Name:=AHistoryCaption;
|
||||
R^.Cond:=AInfo;
|
||||
if First<>nil then
|
||||
begin
|
||||
L:=Last;
|
||||
if Curr<>L then ClearFromCurrent(Curr^.Next);
|
||||
Curr^.Next:=R;
|
||||
Curr:=R;
|
||||
end
|
||||
else
|
||||
begin
|
||||
First:=R;
|
||||
Curr:=R;
|
||||
end;
|
||||
CreateBackMenu;
|
||||
CreateRetrMenu;
|
||||
CheckTop;
|
||||
CheckBottom;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.SetBackBtn(AValue: string);
|
||||
begin
|
||||
if FBackBtn=AValue then Exit;
|
||||
|
||||
if ForwardBtn = AValue then
|
||||
ForwardBtn:='';
|
||||
|
||||
FBackBtn:=AValue;
|
||||
|
||||
if Assigned(FBackBtnItem) then
|
||||
begin
|
||||
FBackBtnItem.DropDownMenu:=nil;
|
||||
FBackBtnItem.Action.OnExecute:=nil;
|
||||
end;
|
||||
|
||||
if Assigned(FToolPanel) and (FBackBtn<>'') then
|
||||
begin
|
||||
FBackBtnItem:=FToolPanel.Items.ByActionName[FBackBtn];
|
||||
if Assigned(FBackBtnItem) then
|
||||
begin
|
||||
FBackBtnItem.DropDownMenu:=PMBack;
|
||||
FBackBtnItem.Action.OnExecute:=@BackProc;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FBackBtnItem:=nil;
|
||||
end;
|
||||
|
||||
function TRxHistoryNavigator.GetBackBtn: string;
|
||||
begin
|
||||
if Assigned(FBackBtnItem) then
|
||||
Result:=FBackBtnItem.Action.Name
|
||||
else
|
||||
Result:=FBackBtn;
|
||||
end;
|
||||
|
||||
function TRxHistoryNavigator.GetForwardBtn: string;
|
||||
begin
|
||||
if Assigned(FForwardBtnItem) then
|
||||
Result:=FForwardBtnItem.Action.Name
|
||||
else
|
||||
Result:=FForwardBtn;
|
||||
end;
|
||||
|
||||
procedure TRxHistoryNavigator.SetForwardBtn(AValue: string);
|
||||
begin
|
||||
if FForwardBtn=AValue then Exit;
|
||||
|
||||
if BackBtn = AValue then
|
||||
BackBtn:='';
|
||||
|
||||
FForwardBtn:=AValue;
|
||||
|
||||
|
||||
if Assigned(FForwardBtnItem) then
|
||||
begin
|
||||
FForwardBtnItem.DropDownMenu:=nil;
|
||||
FForwardBtnItem.Action.OnExecute:=nil;
|
||||
end;
|
||||
|
||||
if Assigned(FToolPanel) and (AValue <>'') then
|
||||
begin
|
||||
FForwardBtnItem:=FToolPanel.Items.ByActionName[FForwardBtn];
|
||||
if Assigned(FForwardBtnItem) then
|
||||
begin
|
||||
FForwardBtnItem.DropDownMenu:=PMForw;
|
||||
FForwardBtnItem.Action.OnExecute:=@ForwardProc;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FForwardBtnItem:=nil;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user