mruflist.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsMRUFileList v2.67                                                        }
{------------------------------------------------------------------------------}
{ A Most Recently Used (MRU) File List component for Delphi.                   }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See MRUFList.txt for notes, known issues, and revision history.              }
{------------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{------------------------------------------------------------------------------}


unit MRUFList;

interface

uses
  Classes, SysUtils,
  {$IFDEF DFS_WIN32}
  Registry, Windows,
  {$ENDIF}
  Menus;


const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsMRUFileList v2.67';

type
  { Registry root values }
  TRootKey = (rkClassesRoot, rkCurrentUser, rkLocalMachine, rkUsers,
     rkCurrentConfig, rkDynData);
  { How to display the item on the menu.  mdCustom gets the display string
    from the OnGetDisplayName event. }
  TMRUDisplay = (mdFullPath, mdFileNameExt, mdFileNameOnly, mdCustom);

{$IFDEF DFS_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
  SClearItemCaption      = '&Clear MRU List';
  SRemoveObsoleteCaption = '&Remove Obsolete';
  { Defaults for component properties }
  DEF_SUBMENUNAME        = 'Reopen';

const
  { Defaults for component properties }
  DEF_ADDTOTOP        = TRUE;
  DEF_MAXIMUM         = 5;
  DEF_REMOVEONCLICK   = TRUE;
  DEF_USESUBMENU      = FALSE;
  DEF_MAXCAPTIONWIDTH = 200;
  {$IFDEF DFS_WIN32}
  DEF_USEREGISTRY     = TRUE;
  DEF_ROOTKEY         = rkCurrentUser;
  {$ELSE}
  DEF_USEREGISTRY     = FALSE;
  {$ENDIF}
  DEF_MRUDISPLAY      = mdFullPath;

type
  TdfsMRUFileList = class;  { Forward declaration }

  { A simple TMenuItem descendant to be used for RTTI }
  TMRUMenuItem = class(TMenuItem)
  private
    FFullCaption: string;
    FOwningList: TdfsMRUFileList;
  public
    ItemNumber: byte;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FullCaption: string read FFullCaption write FFullCaption;
  end;

  { Event procedure for MRU item click.  Passes filename for easy us }
  TMRUClick = procedure(Sender: TObject; AFilename: string) of object;
  { Event for programatically determining if an MRU item is obsolete }
  TMRURemoveObsolete = procedure(Sender: TObject; AnItem: string;
     var Remove: boolean) of object;
  { Event for getting the display name of an item for MRUDisplay = mdCustom }
  TMRUGetDisplayName = procedure(Sender: TObject; AFilename: string;
     var ADisplayName: string) of object;
  { Events for creation/destruction of MRU menu items }
  TMRUOnCreateDestroyMRUItem = procedure(Sender: TObject; Item: TMRUMenuItem)
     of object;

  TdfsMRUFileList = class(TComponent)
  private
    { Property variables }
    FAddToTop: boolean;
    FMaximum: byte;
    FRemoveOnClick: boolean;
    FUseSubmenu: boolean;
    FInsertSeparator : Boolean;
    FSubmenuName: string;
    FFileMenu: TMenuItem;
    FPopupMenu: TPopupMenu;
    FMenuItems: TStringList;
    FAutoSave: boolean;
    FAutoSaveName: string;
    FAutoSaveKey: string;
    FMaxCaptionWidth: integer;
    FClearItemName : String;
    FShowClearItem : Boolean;
    FShowRemoveObsolete : Boolean;
    FRemoveObsoleteName : String;
    FOnRemoveObsolete: TMRURemoveObsolete;
    { Event variables }
    FOnMRUItemClick: TMRUClick;
    { Internal use }
    FInhibitUpdate: boolean;
    FUseRegistry: boolean;
    {$IFDEF DFS_WIN32}
    FRegistryKey: HKEY;
    {$ENDIF}
    FMRUDisplay: TMRUDisplay;
    FOnGetDisplayName: TMRUGetDisplayName;
    FOnCreateMRUItem: TMRUOnCreateDestroyMRUItem;
    FOnDestroyMRUItem: TMRUOnCreateDestroyMRUItem;

    { Property methods }
    procedure SetMaximum(Val: byte);
    procedure SetFileMenu(Val: TMenuItem);
    procedure SetPopupMenu(const Val: TPopupMenu);
    procedure SetUseSubmenu(Val: boolean);
    procedure SetInsertSeparator(Val: boolean);
    procedure SetSubmenuName(Val: string);
    procedure SetMaxCaptionWidth(Val: integer);
    procedure SetAutoSaveName(const Val: string);
    procedure SetAutoSavekey(const Val: string);
    {$IFDEF DFS_WIN32}
    procedure SetAutoSaveRootKey(Val: TRootKey);
    function GetAutoSaveRootKey: TRootKey;
    {$ENDIF}
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    { MenuItem OnClick handler }
    procedure SetMRUDisplay(Val: TMRUDisplay);
    function GetMRUDisplay: TMRUDisplay;
    procedure MRUClicked(Sender: TObject);
    procedure ClearClicked(Sender : TObject);
    procedure RemoveObsoleteClicked(Sender : TObject);
    procedure SetClearItemName(const Value: String);
    procedure SetRemoveObsoleteName(const Value: string);
    procedure SetShowClearItem(const Value: boolean);
    procedure SetShowRemoveObsolete(const Value: boolean);
  protected
    { Method to place items on menu }
    procedure PopulateMenu; virtual;
    { We need to know if our menu item is deleted. }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Procedures for calling event handlers }
    procedure GetDisplayName(AFilename: string; var ADisplayName: string); virtual;
    procedure RemoveObsolete(AFilename: string; var Remove: boolean); virtual;
    procedure MRUItemClick(AFilename: string); virtual;
    procedure CreateMRUItem(AnItem: TMRUMenuItem); virtual;
    procedure DestroyMRUItem(AnItem: TMRUMenuItem); virtual;
    procedure Loaded; override;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    { Methods to add items to the MRU list }
    procedure InsertItem(Index: integer; aFile: string);
    procedure ReplaceItem(OldItem, NewItem: string);
    procedure AddItem(aFile: string);
    procedure AddStringList(Files: TStringList);
    procedure AddStrings(Files: TStrings);
    { Methods to load and save items. }
    function Load: boolean;
    function Save: boolean;
    { Method to remove all MRU items from the menu, but NOT from the internal }
    { list.  You probably want ClearAllItems. }
    procedure RemoveAllItems;
    { Method to clear a single item by name from the MRU items. }
    procedure ClearItem (aFile: string);
    { Method to clear all current MRU items. }
    procedure ClearAllItems; virtual;
    { Method to remove all "obsolete" items. }
    procedure RemoveObsoleteItems; virtual;

    { The MRU Items.  Read Only. }
    property Items: TStringList
       read FMenuItems;
  published
    {$IFDEF DFS_WIN32}
    property UseRegistry: boolean
       read FUseRegistry
       write FUseRegistry
       nodefault;
    {$ENDIF}
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property AddToTop: boolean
       read FAddToTop
       write FAddToTop
       default DEF_ADDTOTOP;
    property Maximum: byte             { Maximum number of items on MRU list }
       read FMaximum
       write SetMaximum
       default DEF_MAXIMUM;
    property RemoveOnClick: boolean    { Remove MRU item when selected? }
       read FRemoveOnClick
       write FRemoveOnClick
       default DEF_REMOVEONCLICK;
    property UseSubmenu: boolean       { MRU items placed on a submenu? }
       read FUseSubmenu
       write SetUseSubmenu
       default DEF_USESUBMENU;
    property InsertSeparator : boolean
       read FInsertSeparator
       write SetInsertSeparator
       default True;
    property SubmenuName: string       { Caption of submenu item, if needed }
       read FSubmenuName
       write SetSubmenuName;
    property ClearItemName : String    { caption of the ClearMenuItem }
        read FClearItemName
        write SetClearItemName;
    property ShowClearItem :boolean
        read FShowClearItem
        write SetShowClearItem
        default TRUE;
    property ShowRemoveObsolete : boolean
        read FShowRemoveObsolete
        write SetShowRemoveObsolete
        default TRUE;
    property RemoveObsoleteName : string
        read FRemoveObsoleteName
        write SetRemoveObsoleteName;
    property OnMRUItemClick: TMRUClick { Event for MRU item selection }
       read FOnMRUItemClick
       write FOnMRUItemClick;
    property OnRemoveObsolete: TMRURemoveObsolete 
       read FOnRemoveObsolete
       write FOnRemoveObsolete;
    property FileMenu: TMenuItem       { Menu to place MRU items on. }
       read FFileMenu
       write SetFileMenu;
    property PopupMenu: TPopupMenu
       read FPopupMenu
       write SetPopupMenu;
    property AutoSave: boolean         { Save and restore MRU items automatically. }
       read FAutoSave
       write FAutoSave
       default TRUE;
    property AutoSaveName: string      { The filename (INI) or key (registry) to save to.}
       read FAutoSaveName
       write SetAutoSaveName;
    property AutoSaveKey: string       { The section to save to. }
       read FAutoSaveKey
       write SetAutoSavekey;
    {$IFDEF DFS_WIN32}
    property AutoSaveRootKey: TRootKey { Root registry key for AutoSaveName registry path }
       read GetAutoSaveRootKey
       write SetAutoSaveRootKey
       default DEF_ROOTKEY;
    {$ENDIF}
    property MaxCaptionWidth: integer  { Maximum width of an MRU item, 0 = no maximum.}
       read FMaxCaptionWidth
       write SetMaxCaptionWidth
       default DEF_MAXCAPTIONWIDTH;
    property MRUDisplay: TMRUDisplay { How to display itmes on the menu }
       read GetMRUDisplay
       write SetMRUDisplay
       default DEF_MRUDISPLAY;
    property OnGetDisplayName: TMRUGetDisplayName
       read FOnGetDisplayName
       write FOnGetDisplayName;
    property OnCreateMRUItem: TMRUOnCreateDestroyMRUItem
       read FOnCreateMRUItem
       write FOnCreateMRUItem;
    property OnDestroyMRUItem: TMRUOnCreateDestroyMRUItem
       read FOnDestroyMRUItem
       write FOnDestroyMRUItem;
  end;

implementation

uses
  WinTypes, WinProcs, Graphics, FileCtrl, INIFiles;

var
  MenuBmp: TBitmap;


{ Simple TMenuItem descendant mainly for RTTI, but also knows it's index     }
{ into the FMenuItems list.                                                  }
constructor TMRUMenuItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ItemNumber := 0;
  FFullCaption := inherited Caption;
end;

destructor TMRUMenuItem.Destroy;
begin
  if FOwningList <> NIL then
    FOwningList.DestroyMRUItem(Self);

  inherited Destroy;
end;



{ Needs to do nothing more than initialize properties to defaults and create }
{ the list variable.                                                         }
constructor TdfsMRUFileList.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  {$IFDEF DFS_WIN32}
  AutoSaveRootKey := rkCurrentUser;
  {$ENDIF}
  FAddToTop := DEF_ADDTOTOP;
  FMaximum := DEF_MAXIMUM;
  FRemoveOnClick := DEF_REMOVEONCLICK;
  FUseSubmenu := DEF_USESUBMENU;
  FInsertSeparator:=True;
  SubmenuName := DEF_SUBMENUNAME;