418 lines
10 KiB
ObjectPascal

unit TB2MRU;
{
Toolbar2000
Copyright (C) 1998-2006 by Jordan Russell
All rights reserved.
The contents of this file are subject to the "Toolbar2000 License"; you may
not use or distribute this file except in compliance with the
"Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
TB2k-LICENSE.txt or at:
http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
Alternatively, the contents of this file may be used under the terms of the
GNU General Public License (the "GPL"), in which case the provisions of the
GPL are applicable instead of those in the "Toolbar2000 License". A copy of
the GPL may be found in GPL-LICENSE.txt or at:
http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
If you wish to allow use of your version of this file only under the terms of
the GPL and not to allow others to use your version of this file under the
"Toolbar2000 License", indicate your decision by deleting the provisions
above and replace them with the notice and other provisions required by the
GPL. If you do not delete the provisions above, a recipient may use your
version of this file under either the "Toolbar2000 License" or the GPL.
$jrsoftware: tb2k/Source/TB2MRU.pas,v 1.24 2006/03/12 23:11:59 jr Exp $
}
interface
{$I TB2Ver.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
TB2Item, IniFiles, Registry;
type
TTBMRUListClickEvent = procedure(Sender: TObject; const Filename: String) of object;
TTBMRUList = class(TComponent)
private
FAddFullPath: Boolean;
FContainer: TTBCustomItem;
FHidePathExtension: Boolean;
FList: TStrings;
FMaxItems: Integer;
FOnChange: TNotifyEvent;
FOnClick: TTBMRUListClickEvent;
FPrefix: String;
procedure ClickHandler(Sender: TObject);
procedure SetHidePathExtension(Value: Boolean);
procedure SetList(Value: TStrings);
procedure SetMaxItems(Value: Integer);
protected
property Container: TTBCustomItem read FContainer;
function GetItemClass: TTBCustomItemClass; virtual;
procedure SetItemCaptions; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Add(Filename: String);
procedure Remove(const Filename: String);
procedure LoadFromIni(Ini: TCustomIniFile; const Section: String);
procedure LoadFromRegIni(Ini: TRegIniFile; const Section: String);
procedure SaveToIni(Ini: TCustomIniFile; const Section: String);
procedure SaveToRegIni(Ini: TRegIniFile; const Section: String);
published
{ MaxItems must be published before Items }
property AddFullPath: Boolean read FAddFullPath write FAddFullPath default True;
property HidePathExtension: Boolean read FHidePathExtension write SetHidePathExtension default True;
property MaxItems: Integer read FMaxItems write SetMaxItems default 4;
property Items: TStrings read FList write SetList;
property OnClick: TTBMRUListClickEvent read FOnClick write FOnClick;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property Prefix: String read FPrefix write FPrefix;
end;
TTBMRUListItem = class(TTBCustomItem)
private
FMRUList: TTBMRUList;
procedure SetMRUList(Value: TTBMRUList);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
published
property MRUList: TTBMRUList read FMRUList write SetMRUList;
//property Caption;
//property LinkSubitems;
end;
implementation
uses
{$IFDEF CLR} System.Text, System.IO, {$ENDIF}
TB2Common, TB2Consts, CommDlg;
procedure ChangeFileNameToTitle(var S: String);
{$IFNDEF CLR}
var
Buf: array[0..MAX_PATH-1] of Char;
begin
if GetFileTitle(PChar(S), Buf, SizeOf(Buf) div SizeOf(Buf[0])) = 0 then
S := Buf;
end;
{$ELSE}
var
Buf: StringBuilder;
begin
Buf := StringBuilder.Create(MAX_PATH);
if GetFileTitle(S, Buf, Buf.Capacity) = 0 then
S := Buf.ToString;
end;
{$ENDIF}
{ TTBMRUListStrings }
type
TTBMRUListStrings = class(TStrings)
private
FInternalList: TStrings;
FMRUList: TTBMRUList;
procedure Changed;
public
constructor Create;
destructor Destroy; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
function Get(Index: Integer): String; override;
function GetCount: Integer; override;
function IndexOf(const S: String): Integer; override;
procedure Insert(Index: Integer; const S: String); override;
procedure Move(CurIndex, NewIndex: Integer); override;
procedure Put(Index: Integer; const S: String); override;
end;
constructor TTBMRUListStrings.Create;
begin
inherited;
FInternalList := TStringList.Create;
end;
destructor TTBMRUListStrings.Destroy;
begin
inherited;
FInternalList.Free;
end;
procedure TTBMRUListStrings.Changed;
begin
if Assigned(FMRUList.FOnChange) and
not(csLoading in FMRUList.ComponentState) then
FMRUList.FOnChange(FMRUList);
end;
procedure TTBMRUListStrings.Clear;
var
I: Integer;
begin
for I := FInternalList.Count-1 downto 0 do
Delete(I);
end;
procedure TTBMRUListStrings.Delete(Index: Integer);
begin
FMRUList.FContainer[Index].Free;
FInternalList.Delete(Index);
FMRUList.SetItemCaptions;
Changed;
end;
function TTBMRUListStrings.Get(Index: Integer): String;
begin
Result := FInternalList[Index];
end;
function TTBMRUListStrings.GetCount: Integer;
begin
Result := FInternalList.Count;
end;
function TTBMRUListStrings.IndexOf(const S: String): Integer;
begin
{ This is identical to TStrings.IndexOf except we use SameFileName. }
for Result := 0 to GetCount - 1 do
{$IFDEF JR_D6}
if SameFileName(Get(Result), S) then Exit;
{$ELSE}
if AnsiCompareFileName(Get(Result), S) = 0 then Exit;
{$ENDIF}
Result := -1;
end;
procedure TTBMRUListStrings.Insert(Index: Integer; const S: String);
var
Item: TTBCustomItem;
begin
Item := FMRUList.GetItemClass.Create(FMRUList.FContainer);
Item.OnClick := FMRUList.ClickHandler;
FMRUList.FContainer.Insert(Index, Item);
FInternalList.Insert(Index, S);
FMRUList.SetItemCaptions;
Changed;
end;
procedure TTBMRUListStrings.Move(CurIndex, NewIndex: Integer);
begin
FInternalList.Move(CurIndex, NewIndex);
FMRUList.FContainer.Move(CurIndex, NewIndex);
FMRUList.SetItemCaptions;
Changed;
end;
procedure TTBMRUListStrings.Put(Index: Integer; const S: String);
begin
FInternalList[Index] := S;
FMRUList.SetItemCaptions;
Changed;
end;
{ TTBMRUList }
constructor TTBMRUList.Create(AOwner: TComponent);
begin
inherited;
FAddFullPath := True;
FHidePathExtension := True;
FMaxItems := 4;
FPrefix := 'MRU';
FList := TTBMRUListStrings.Create;
TTBMRUListStrings(FList).FMRUList := Self;
FContainer := TTBCustomItem.Create(nil);
end;
destructor TTBMRUList.Destroy;
begin
FContainer.Free;
FList.Free;
inherited;
end;
procedure TTBMRUList.Add(Filename: String);
var
I: Integer;
begin
if AddFullPath then
Filename := ExpandFileName(Filename);
{ If Filename is already in the MRU list, move it to the top }
I := FList.IndexOf(Filename);
if I <> -1 then begin
if I > 0 then
FList.Move(I, 0);
FList[0] := Filename; { ...in case the capitalization changed }
end
else
FList.Insert(0, Filename);
end;
procedure TTBMRUList.Remove(const Filename: String);
var
I: Integer;
begin
I := FList.IndexOf(Filename);
if I <> -1 then
FList.Delete(I);
end;
procedure TTBMRUList.LoadFromIni(Ini: TCustomIniFile; const Section: String);
var
I: Integer;
S: String;
begin
FList.Clear;
for I := 1 to FMaxItems do begin
S := Ini.ReadString(Section, FPrefix + IntToStr(I), '');
if S <> '' then
FList.Add(S);
end;
end;
procedure TTBMRUList.LoadFromRegIni(Ini: TRegIniFile; const Section: String);
var
I: Integer;
S: String;
begin
FList.Clear;
for I := 1 to FMaxItems do begin
S := Ini.ReadString(Section, FPrefix + IntToStr(I), '');
if S <> '' then
FList.Add(S);
end;
end;
procedure TTBMRUList.SaveToIni(Ini: TCustomIniFile; const Section: String);
var
I: Integer;
begin
for I := 1 to FMaxItems do begin
if I <= FList.Count then
Ini.WriteString(Section, FPrefix + IntToStr(I), FList[I-1])
else
Ini.DeleteKey(Section, FPrefix + IntToStr(I));
end;
end;
procedure TTBMRUList.SaveToRegIni(Ini: TRegIniFile; const Section: String);
var
I: Integer;
begin
for I := 1 to FMaxItems do begin
if I <= FList.Count then
Ini.WriteString(Section, FPrefix + IntToStr(I), FList[I-1])
else
Ini.DeleteKey(Section, FPrefix + IntToStr(I));
end;
end;
procedure TTBMRUList.SetItemCaptions;
var
I, J: Integer;
Key: Char;
S: String;
begin
while FList.Count > FMaxItems do
FList.Delete(FList.Count-1);
for I := 0 to FContainer.Count-1 do begin
Key := #0;
if I < 9 then
Key := Chr(Ord('1') + I)
else begin
{ No more numbers; try letters }
J := I - 9;
if J < 26 then
Key := Chr(Ord('A') + J);
end;
S := FList[I];
if HidePathExtension then
ChangeFileNameToTitle(S);
S := EscapeAmpersands(S);
if Key <> #0 then
FContainer[I].Caption := Format('&%s %s', [Key, S])
else
FContainer[I].Caption := S;
end;
end;
procedure TTBMRUList.ClickHandler(Sender: TObject);
var
I: Integer;
begin
I := FContainer.IndexOf(TTBCustomItem(Sender));
if I <> -1 then begin
if I > 0 then
FList.Move(I, 0);
if Assigned(FOnClick) then
FOnClick(Self, FList[0]);
end;
end;
procedure TTBMRUList.SetHidePathExtension(Value: Boolean);
begin
if FHidePathExtension <> Value then begin
FHidePathExtension := Value;
SetItemCaptions;
end;
end;
procedure TTBMRUList.SetList(Value: TStrings);
begin
FList.Assign(Value);
end;
procedure TTBMRUList.SetMaxItems(Value: Integer);
begin
FMaxItems := Value;
SetItemCaptions;
end;
function TTBMRUList.GetItemClass: TTBCustomItemClass;
begin
Result := TTBCustomItem;
end;
{ TTBMRUListItem }
constructor TTBMRUListItem.Create(AOwner: TComponent);
begin
inherited;
ItemStyle := ItemStyle + [tbisEmbeddedGroup];
Caption := STBMRUListItemDefCaption;
end;
procedure TTBMRUListItem.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FMRUList) and (Operation = opRemove) then
SetMRUList(nil);
end;
procedure TTBMRUListItem.SetMRUList(Value: TTBMRUList);
begin
if FMRUList <> Value then begin
FMRUList := Value;
if Assigned(FMRUList) then begin
Value.FreeNotification(Self);
LinkSubitems := FMRUList.FContainer;
end
else
LinkSubitems := nil;
end;
end;
end.