Most Recently Used (MRU) menu component

{
  Article: Most Recently Used (MRU) menu component - TMRU

  http://delphi.about.com/library/weekly/aa112503a.htm

  Full source code of a TMRU component, a non-visual component
  which simplifies implementing a "Most Recently Used" file list
  in a menu (or a popup menu). The TMRU component allows for
  quick selection of a file that was recently accessed (opened)
  in an application.

  MRU - Most Recently Used

  Many applications offer a list of most recently used files
  (like Delphi's File | Reopen menu) - a list that reflects the user's most
  recently accessed files in an application.

  The MRU list allows for quick selection of a file that was recently opened
  without having to select an Open menu item and search to locate a specific
  lately accessed file.

  The TMRU Delphi component is a non-visual component which simplifies
  implementing a "Most Recently Used" file list in a menu (or a popup menu).
  Here are the TadpMRU component's features:

  MRU menu items are attached to a "ParentMenuItem"
  Dynamic, supports *unlimited* number of MRU items.
  A maximum number of MRU entries can be defined.
  Files can be added or removed from the list.
  The files are listed with the most recently used at the top of the list
  (from the "most recent" to "least recent.")
  Each file can be displayed using the full path name or just the file name.
  The MRU list is saved to the Registry upon application termination and
  loaded upon application startup.
  Enables more Registry storage areas by providing the RegistryPath property
  Exposes an OnClick event with the Filename as a parameter.
  and more...

  http://www.angusj.com/delphi/mruunit.html for <IniFile>
  Copyright 2003 Angus Johnson
}

unit uMRU;

interface

uses
  Windows, Messages, SysUtils, Classes, Menus, IniFiles, Registry;

const
  MRU_MAX_ITEMS = 16;
  MRU_NAME = 'MRU';

type

  // riggered when a "MRU menu item" is clicked.
  TMRUClickEvent = procedure( Sender : TObject; const FileName : String )
    of object;

  TMRU = class( TComponent )
  private
    FItems : TStringList;

    FMaxItems : cardinal;
    FShowFullPath : boolean;
    FRegistryPath : string;
    FIniFileName : string;
    FParentMenuItem : TMenuItem;
    FOnClick : TMRUClickEvent;
    procedure SetMaxItems( const Value : cardinal );
    procedure SetShowFullPath( const Value : boolean );
    procedure SetParentMenuItem( const Value : TMenuItem );

    procedure SetIniFileName( const Value : string );
    procedure SetRegistryPath( const Value : string );

    procedure LoadMRU;
    procedure SaveMRU;
    procedure LoadFromRegistry;
    procedure SaveToRegistry;
    procedure LoadFromIniFile;
    procedure SaveToIniFile;

    procedure ItemsChange( Sender : TObject );
    procedure ClearParentMenu;
  protected
    procedure Loaded; override;
    procedure Notification( AComponent : TComponent;
      Operation : TOperation ); override;
    procedure DoClick( Sender : TObject );

  public
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;

    // Adds the Filename to the MRU list, as the first item.
    procedure AddItem( const FileName : string );
    // Removes a MRU item provided with a file name.
    // Returns true if an existing item was removed; false otherwise.
    function RemoveItem( const FileName : string ) : boolean;

  published
    // Gets or sets the string value representing the key in Registry
    // where MRU entries are saved.
    // If omitted the MRU list is NOT saved upon application termination.
    // The root key used is HKEY_CURRENT_USER
    property RegistryPath : string read FRegistryPath write SetRegistryPath;
    // Gets or sets the string value representing the Ini FileName
    // where MRU entries are saved.
    // If omitted the MRU list is NOT saved upon application termination.
    property IniFileName : string read FIniFileName write SetIniFileName;

    // Gets or sets the maximum number of files in the MRU list.
    property MaxItems : cardinal read FMaxItems write SetMaxItems
      default MRU_MAX_ITEMS;

    // Gets or sets the value that indicates whether files as menu items
    // are displayed with full file name (or just using the file name).
    property ShowFullPath : boolean read FShowFullPath write SetShowFullPath
      default True;

    // Determines the menu item that the MRU items will be
    // added to as child menu items.
    property ParentMenuItem : TMenuItem read FParentMenuItem
      write SetParentMenuItem;

    // riggered when a "MRU menu item" is clicked.
    property OnClick : TMRUClickEvent read FOnClick write FOnClick;
  end;

procedure Register;

implementation

type
  // to be able to recognize MRU menu item when deleting
  TMRUMenuItem = class( TMenuItem );

procedure Register;
begin
  RegisterComponents( 'delphi.about.com', [ TMRU ] );
end;

{ TMRU }

constructor TMRU.Create( AOwner : TComponent );
begin
  inherited;
  FParentMenuItem := nil;
  FItems := TStringList.Create;
  FItems.OnChange := ItemsChange;

  FMaxItems := MRU_MAX_ITEMS;
  FShowFullPath := True;
end; (* Create *)

destructor TMRU.Destroy;
begin
  if not( csDesigning in ComponentState ) then
    SaveMRU;

  FItems.OnChange := nil;
  FItems.Free;

  inherited;
end; (* Destroy *)

procedure TMRU.Loaded;
begin
  inherited Loaded;
  if not( csDesigning in ComponentState ) then
    LoadMRU;
end; (* Loaded *)

procedure TMRU.Notification( AComponent : TComponent; Operation : TOperation );
begin
  inherited;
  if ( Operation = opRemove ) and ( AComponent = FParentMenuItem ) then
    FParentMenuItem := nil;
end; (* Notification *)

procedure TMRU.AddItem( const FileName : string );
begin
  if FileName <> '' then
  begin
    FItems.BeginUpdate;
    try
      if FItems.IndexOf( FileName ) > -1 then
        FItems.Delete( FItems.IndexOf( FileName ) );
      FItems.Insert( 0, FileName );

      while FItems.Count > MaxItems do
        FItems.Delete( MaxItems );
    finally
      FItems.EndUpdate;
    end;
  end;
end; (* AddItem *)

function TMRU.RemoveItem( const FileName : string ) : boolean;
begin
  if FItems.IndexOf( FileName ) > -1 then
  begin
    FItems.Delete( FItems.IndexOf( FileName ) );
    Result := True;
  end
  else
    Result := False;
end; (* RemoveItem *)

procedure TMRU.SetMaxItems( const Value : cardinal );
begin
  if Value <> FMaxItems then
  begin
    if Value < 1 then
      FMaxItems := 1
    else if Value > MaxInt then
      FMaxItems := MaxInt - 1
    else
    begin
      FMaxItems := Value;
      FItems.BeginUpdate;
      try
        while FItems.Count > MaxItems do
          FItems.Delete( FItems.Count - 1 );
      finally
        FItems.EndUpdate;
      end;
    end;
  end;
end; (* SetMaxItems *)

procedure TMRU.SetIniFileName( const Value : string );
begin
  if FIniFileName <> Value then
  begin
    FIniFileName := Value;
    LoadMRU;
  end;
end;

procedure TMRU.SetRegistryPath( const Value : string );
begin
  if FRegistryPath <> Value then
  begin
    FRegistryPath := Value;
    LoadMRU;
  end;
end; (* SetRegistryPath *)

procedure TMRU.SetShowFullPath( const Value : boolean );
begin
  if FShowFullPath <> Value then
  begin
    FShowFullPath := Value;
    ItemsChange( Self );
  end;
end; (* SetShowFullPath *)

procedure TMRU.LoadFromRegistry;
var
  i : cardinal;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey( FRegistryPath, False ) then
      begin
        FItems.BeginUpdate;
        FItems.Clear;
        try
          for i := 1 to FMaxItems do
            if ValueExists( MRU_NAME + IntToStr( i ) ) then
              FItems.Add( ReadString( MRU_NAME + IntToStr( i ) ) );
        finally
          FItems.EndUpdate;
        end;
        CloseKey;
      end;
    finally
      Free;
    end;
end; (* LoadFromRegistry *)

procedure TMRU.SaveToRegistry;
var
  i : integer;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey( FRegistryPath, True ) then
      begin
        // delete old mru
        i := 1;
        while ValueExists( MRU_NAME + IntToStr( i ) ) do
        begin
          DeleteValue( MRU_NAME + IntToStr( i ) );
          Inc( i );
        end;

        // write new mru
        for i := 0 to -1 + FItems.Count do
          WriteString( MRU_NAME + IntToStr( i + 1 ), FItems[ i ] );
        CloseKey;
      end;
    finally
      Free;
    end;
end;

procedure TMRU.LoadFromIniFile;
var
  i : cardinal;
  LItemName : string;
  IniFilePath : string;
  IniFileName : string;
begin
  IniFilePath := ExtractFilePath( FIniFileName );

  if IniFilePath <> '' then
    IniFileName := FIniFileName // Valid IniFile with path
  else if FIniFileName = '' then
    IniFileName := ChangeFileExt( paramStr( 0 ), '.ini' ) // default IniFile
  else // FIniFileName <> ''
    IniFileName := ExtractFilePath( paramStr( 0 ) ) + FIniFileName;

  if FileExists( IniFileName ) then
  begin
    with TIniFile.Create( IniFileName ) do
    begin
      try
        FItems.BeginUpdate;
        FItems.Clear;
        try
          for i := 1 to FMaxItems do
          begin
            LItemName := ReadString( MRU_NAME, IntToStr( i ), '' );
            if LItemName = '' then
              break;
            FItems.Add( LItemName );
          end;
        finally
          FItems.EndUpdate;
        end;
      finally
        Free;
      end;
    end;
  end;
end;

procedure TMRU.SaveToIniFile;
var
  i : cardinal;
  IniFilePath : string;
  IniFileName : string;
begin
  IniFilePath := ExtractFilePath( FIniFileName );

  if IniFilePath <> '' then
    IniFileName := FIniFileName // Valid IniFile with path
  else if FIniFileName = '' then
    IniFileName := ChangeFileExt( paramStr( 0 ), '.ini' ) // default IniFile
  else // FIniFileName <> ''
    IniFileName := ExtractFilePath( paramStr( 0 ) ) + FIniFileName;

  with TIniFile.Create( IniFileName ) do
  begin
    try
      for i := 1 to FMaxItems do
      begin
        if i <= FItems.Count then
          WriteString( MRU_NAME, IntToStr( i ), FItems[ i - 1 ] );
      end;
    finally
      Free;
    end;
  end;
end;

procedure TMRU.LoadMRU;
begin
  if FRegistryPath <> '' then
    LoadFromRegistry
  else
    LoadFromIniFile;
end;

procedure TMRU.SaveMRU;
begin
  if FRegistryPath <> '' then
    SaveToRegistry
  else
    SaveToIniFile;
end;

(* SaveMRU *)

procedure TMRU.ItemsChange( Sender : TObject );
var
  i : integer;
  NewMenuItem : TMenuItem;
  FileName : String;
begin
  if ParentMenuItem <> nil then
  begin
    ClearParentMenu;
    for i := 0 to -1 + FItems.Count do
    begin
      if ShowFullPath then
        FileName := StringReplace( FItems[ i ], '&', '&&',
          [ rfReplaceAll, rfIgnoreCase ] )
      else
        FileName := StringReplace( ExtractFileName( FItems[ i ] ), '&', '&&',
          [ rfReplaceAll, rfIgnoreCase ] );

      NewMenuItem := TMRUMenuItem.Create( Self );
      NewMenuItem.Caption := Format( '%s', [ FileName ] );
      NewMenuItem.Tag := i;
      NewMenuItem.OnClick := DoClick;
      ParentMenuItem.Add( NewMenuItem );
    end;
  end;
end; (* ItemsChange *)

procedure TMRU.ClearParentMenu;
var
  i : integer;
begin
  if Assigned( ParentMenuItem ) then
    for i := -1 + ParentMenuItem.Count downto 0 do
      if ParentMenuItem.Items[ i ] is TMRUMenuItem then
        ParentMenuItem.Delete( i );
end; (* ClearParentMenu *)

procedure TMRU.DoClick( Sender : TObject );
begin
  if Assigned( FOnClick ) and ( Sender is TMRUMenuItem ) then
    FOnClick( Self, FItems[ TMRUMenuItem( Sender ).Tag ] );
end; (* DoClick *)

procedure TMRU.SetParentMenuItem( const Value : TMenuItem );
begin
  if FParentMenuItem <> Value then
  begin
    ClearParentMenu;
    FParentMenuItem := Value;
    ItemsChange( Self );
  end;
end; (* SetParentMenuItem *)

end. (* MRU.pas *)

{
  ********************************************
  Zarko Gajic
  About.com Guide to Delphi Programming
  http://delphi.about.com
  email: delphi@aboutguide.com
  free newsletter: http://delphi.about.com/library/blnewsletter.htm
  forum: http://forums.about.com/ab-delphi/start/
  ********************************************
}

 

posted @ 2013-05-05 12:01  IAmAProgrammer  阅读(1126)  评论(0编辑  收藏  举报