• 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/
      ********************************************
    }

  • 相关阅读:
    记一次file_get_contents报failed to open stream: HTTP request failed! HTTP/1.1 400 Bad Request的错
    记一次centos7下配置服务器的过程
    locate: 无法执行 stat () `/var/lib/mlocate/mlocate.db': 没有那个文件或目录
    VM12虚拟机Centos7配置动态IP的网络设置
    记录下防御SSH爆破攻击的经验(CentOS7.3)
    第6次实践作业 17组
    第5次实践作业
    第3次实践作业
    第2次实践作业
    第1次实践作业
  • 原文地址:https://www.cnblogs.com/shangdawei/p/3060793.html
Copyright © 2020-2023  润新知