mrulist.pas

rxlib2.75控件包

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit MRUList;

{$I RX.INC}
{$R-,B-}

interface

uses SysUtils, Classes, Menus, IniFiles {$IFDEF WIN32}, Registry {$ENDIF},
  Placemnt;

type
  TRecentStrings = class;

{ TMRUManager }

  TGetItemEvent = procedure (Sender: TObject; var Caption: string;
    var ShortCut: TShortCut; UserData: Longint) of object;
  TReadItemEvent = procedure (Sender: TObject; IniFile: TObject;
    const Section: string; Index: Integer; var RecentName: string;
    var UserData: Longint) of object;
  TWriteItemEvent = procedure (Sender: TObject; IniFile: TObject;
    const Section: string; Index: Integer; const RecentName: string;
    UserData: Longint) of object;
  TClickMenuEvent = procedure (Sender: TObject; const RecentName,
    Caption: string; UserData: Longint) of object;

  TAccelDelimiter = (adTab, adSpace);
  TRecentMode = (rmInsert, rmAppend);

  TMRUManager = class(TComponent)
  private
    FList: TStrings;
    FItems: TList;
    FIniLink: TIniLink;
    FSeparateSize: Word;
    FAutoEnable: Boolean;
    FAutoUpdate: Boolean;
    FShowAccelChar: Boolean;
    FRemoveOnSelect: Boolean;
    FStartAccel: Cardinal;
    FAccelDelimiter: TAccelDelimiter;
    FRecentMenu: TMenuItem;
    FOnChange: TNotifyEvent;
    FOnGetItem: TGetItemEvent;
    FOnClick: TClickMenuEvent;
    FOnReadItem: TReadItemEvent;
    FOnWriteItem: TWriteItemEvent;
    procedure ListChanged(Sender: TObject);
    procedure ClearRecentMenu;
    procedure SetRecentMenu(Value: TMenuItem);
    procedure SetSeparateSize(Value: Word);
    function GetStorage: TFormPlacement;
    procedure SetStorage(Value: TFormPlacement);
    function GetCapacity: Integer;
    procedure SetCapacity(Value: Integer);
    function GetMode: TRecentMode;
    procedure SetMode(Value: TRecentMode);
    procedure SetStartAccel(Value: Cardinal);
    procedure SetShowAccelChar(Value: Boolean);
    procedure SetAccelDelimiter(Value: TAccelDelimiter);
    procedure SetAutoEnable(Value: Boolean);
    procedure AddMenuItem(Item: TMenuItem);
    procedure MenuItemClick(Sender: TObject);
    procedure IniSave(Sender: TObject);
    procedure IniLoad(Sender: TObject);
    procedure InternalLoad(Ini: TObject; const Section: string);
    procedure InternalSave(Ini: TObject; const Section: string);
  protected
    procedure Change; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoReadItem(Ini: TObject; const Section: string;
      Index: Integer; var RecentName: string; var UserData: Longint); dynamic;
    procedure DoWriteItem(Ini: TObject; const Section: string; Index: Integer;
      const RecentName: string; UserData: Longint); dynamic;
    procedure GetItemData(var Caption: string; var ShortCut: TShortCut;
      UserData: Longint); dynamic;
    procedure DoClick(const RecentName, Caption: string; UserData: Longint); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Add(const RecentName: string; UserData: Longint);
    procedure Clear;
    procedure Remove(const RecentName: string);
    procedure UpdateRecentMenu;
{$IFDEF WIN32}
    procedure LoadFromRegistry(Ini: TRegIniFile; const Section: string);
    procedure SaveToRegistry(Ini: TRegIniFile; const Section: string);
{$ENDIF WIN32}
    procedure LoadFromIni(Ini: TIniFile; const Section: string);
    procedure SaveToIni(Ini: TIniFile; const Section: string);
    property Strings: TStrings read FList;
  published
    property AccelDelimiter: TAccelDelimiter read FAccelDelimiter write SetAccelDelimiter default adTab;
    property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
    property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate default True;
    property Capacity: Integer read GetCapacity write SetCapacity default 10;
    property Mode: TRecentMode read GetMode write SetMode default rmInsert;
    property RemoveOnSelect: Boolean read FRemoveOnSelect write FRemoveOnSelect default False;
    property IniStorage: TFormPlacement read GetStorage write SetStorage;
    property SeparateSize: Word read FSeparateSize write SetSeparateSize default 0;
    property RecentMenu: TMenuItem read FRecentMenu write SetRecentMenu;
    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
    property StartAccel: Cardinal read FStartAccel write SetStartAccel default 1;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick: TClickMenuEvent read FOnClick write FOnClick;
    property OnGetItemData: TGetItemEvent read FOnGetItem write FOnGetItem;
    property OnReadItem: TReadItemEvent read FOnReadItem write FOnReadItem;
    property OnWriteItem: TWriteItemEvent read FOnWriteItem write FOnWriteItem;
  end;

{ TRecentStrings }

  TRecentStrings = class(TStringList)
  private
    FMaxSize: Integer;
    FMode: TRecentMode;
    procedure SetMaxSize(Value: Integer);
  public
    constructor Create;
    function Add(const S: string): Integer; override;
    procedure AddStrings(Strings: TStrings); override;
    procedure DeleteExceed;
    procedure Remove(const S: String);
    property MaxSize: Integer read FMaxSize write SetMaxSize;
    property Mode: TRecentMode read FMode write FMode;
  end;

implementation

uses Controls, MaxMin, AppUtils;

const
  siRecentItem = 'Item_%d';
  siRecentData = 'User_%d';

{ TMRUManager }

constructor TMRUManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList := TRecentStrings.Create;
  FItems := TList.Create;
  TRecentStrings(FList).OnChange := ListChanged;
  FIniLink := TIniLink.Create;
  FIniLink.OnSave := IniSave;
  FIniLink.OnLoad := IniLoad;
  FAutoUpdate := True;
  FAutoEnable := True;
  FShowAccelChar := True;
  FStartAccel := 1;
end;

destructor TMRUManager.Destroy;
begin
  ClearRecentMenu;
  FIniLink.Free;
  TRecentStrings(FList).OnChange := nil;
  FList.Free;
  FItems.Free;
  FItems := nil;
  inherited Destroy;
end;

procedure TMRUManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = RecentMenu) and (Operation = opRemove) then
    RecentMenu := nil;
end;

procedure TMRUManager.GetItemData(var Caption: string; var ShortCut: TShortCut;
  UserData: Longint);
begin
  if Assigned(FOnGetItem) then FOnGetItem(Self, Caption, ShortCut, UserData);
end;

procedure TMRUManager.DoClick(const RecentName, Caption: string; UserData: Longint);
begin
  if Assigned(FOnClick) then FOnClick(Self, RecentName, Caption, UserData);
end;

procedure TMRUManager.MenuItemClick(Sender: TObject);
var
  I: Integer;
begin
  if Sender is TMenuItem then begin
    I := TMenuItem(Sender).Tag;
    if (I >= 0) and (I < FList.Count) then
      try
        DoClick(FList[I], TMenuItem(Sender).Caption, Longint(FList.Objects[I]));
      finally
        if RemoveOnSelect then Remove(FList[I]);
      end;
  end;
end;

function TMRUManager.GetCapacity: Integer;
begin
  Result := TRecentStrings(FList).MaxSize;
end;

procedure TMRUManager.SetCapacity(Value: Integer);
begin
  TRecentStrings(FList).MaxSize := Value;
end;

function TMRUManager.GetMode: TRecentMode;
begin
  Result := TRecentStrings(FList).Mode;
end;

procedure TMRUManager.SetMode(Value: TRecentMode);
begin
  TRecentStrings(FList).Mode := Value;
end;

function TMRUManager.GetStorage: TFormPlacement;
begin
  Result := FIniLink.Storage;
end;

procedure TMRUManager.SetStorage(Value: TFormPlacement);
begin
  FIniLink.Storage := Value;
end;

procedure TMRUManager.SetAutoEnable(Value: Boolean);
begin
  if FAutoEnable <> Value then begin
    FAutoEnable := Value;
    if Assigned(FRecentMenu) and FAutoEnable then
      FRecentMenu.Enabled := FRecentMenu.Count > 0;
  end;
end;

procedure TMRUManager.SetStartAccel(Value: Cardinal);
begin
  if FStartAccel <> Value then begin
    FStartAccel := Value;
    if FAutoUpdate then UpdateRecentMenu;
  end;
end;

procedure TMRUManager.SetAccelDelimiter(Value: TAccelDelimiter);
begin
  if FAccelDelimiter <> Value then begin
    FAccelDelimiter := Value;
    if FAutoUpdate and ShowAccelChar then UpdateRecentMenu;
  end;
end;

procedure TMRUManager.SetShowAccelChar(Value: Boolean);
begin
  if FShowAccelChar <> Value then begin
    FShowAccelChar := Value;
    if FAutoUpdate then UpdateRecentMenu;
  end;
end;

procedure TMRUManager.Add(const RecentName: string; UserData: Longint);
begin
  FList.AddObject(RecentName, TObject(UserData));
end;

procedure TMRUManager.Clear;
begin
  FList.Clear;
end;