home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / MRUFList.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-28  |  36.4 KB  |  1,127 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TdfsMRUFileList v2.67                                                        }
  5. {------------------------------------------------------------------------------}
  6. { A Most Recently Used (MRU) File List component for Delphi.                   }
  7. {                                                                              }
  8. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  9. {                                                                              }
  10. { Copyright:                                                                   }
  11. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  12. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  13. { property of the author.                                                      }
  14. {                                                                              }
  15. { Distribution Rights:                                                         }
  16. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  17. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  18. { the DFS source code unless specifically stated otherwise.                    }
  19. { You are further granted permission to redistribute any of the DFS source     }
  20. { code in source code form, provided that the original archive as found on the }
  21. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  22. { example, if you create a descendant of TDFSColorButton, you must include in  }
  23. { the distribution package the colorbtn.zip file in the exact form that you    }
  24. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  25. {                                                                              }
  26. { Restrictions:                                                                }
  27. { Without the express written consent of the author, you may not:              }
  28. {   * Distribute modified versions of any DFS source code by itself. You must  }
  29. {     include the original archive as you found it at the DFS site.            }
  30. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  31. {     to sell any of your own original code that works with, enhances, etc.    }
  32. {     DFS source code.                                                         }
  33. {   * Distribute DFS source code for profit.                                   }
  34. {                                                                              }
  35. { Warranty:                                                                    }
  36. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  37. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  38. { and all risks and losses associated with it's use are assumed by you. In no  }
  39. { event shall the author of the softare, Bradley D. Stowers, be held           }
  40. { accountable for any damages or losses that may occur from use or misuse of   }
  41. { the software.                                                                }
  42. {                                                                              }
  43. { Support:                                                                     }
  44. { Support is provided via the DFS Support Forum, which is a web-based message  }
  45. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  46. { All DFS source code is provided free of charge. As such, I can not guarantee }
  47. { any support whatsoever. While I do try to answer all questions that I        }
  48. { receive, and address all problems that are reported to me, you must          }
  49. { understand that I simply can not guarantee that this will always be so.      }
  50. {                                                                              }
  51. { Clarifications:                                                              }
  52. { If you need any further information, please feel free to contact me directly.}
  53. { This agreement can be found online at my site in the "Miscellaneous" section.}
  54. {------------------------------------------------------------------------------}
  55. { The lateset version of my components are always available on the web at:     }
  56. {   http://www.delphifreestuff.com/                                            }
  57. { See MRUFList.txt for notes, known issues, and revision history.              }
  58. {------------------------------------------------------------------------------}
  59. { Date last modified:  June 28, 2001                                           }
  60. {------------------------------------------------------------------------------}
  61.  
  62.  
  63. unit MRUFList;
  64.  
  65. interface
  66.  
  67. uses
  68.   Classes, SysUtils,
  69.   {$IFDEF DFS_WIN32}
  70.   Registry, Windows,
  71.   {$ENDIF}
  72.   Menus;
  73.  
  74.  
  75. const
  76.   { This shuts up C++Builder 3 about the redefiniton being different. There
  77.     seems to be no equivalent in C1.  Sorry. }
  78.   {$IFDEF DFS_CPPB_3_UP}
  79.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  80.   {$ENDIF}
  81.   DFS_COMPONENT_VERSION = 'TdfsMRUFileList v2.67';
  82.  
  83. type
  84.   { Registry root values }
  85.   TRootKey = (rkClassesRoot, rkCurrentUser, rkLocalMachine, rkUsers,
  86.      rkCurrentConfig, rkDynData);
  87.   { How to display the item on the menu.  mdCustom gets the display string
  88.     from the OnGetDisplayName event. }
  89.   TMRUDisplay = (mdFullPath, mdFileNameExt, mdFileNameOnly, mdCustom);
  90.  
  91. {$IFDEF DFS_COMPILER_3_UP}
  92. resourcestring
  93. {$ELSE}
  94. const
  95. {$ENDIF}
  96.   SClearItemCaption      = '&Clear MRU List';
  97.   SRemoveObsoleteCaption = '&Remove Obsolete';
  98.   { Defaults for component properties }
  99.   DEF_SUBMENUNAME        = 'Reopen';
  100.  
  101. const
  102.   { Defaults for component properties }
  103.   DEF_ADDTOTOP        = TRUE;
  104.   DEF_MAXIMUM         = 5;
  105.   DEF_REMOVEONCLICK   = TRUE;
  106.   DEF_USESUBMENU      = FALSE;
  107.   DEF_MAXCAPTIONWIDTH = 200;
  108.   {$IFDEF DFS_WIN32}
  109.   DEF_USEREGISTRY     = TRUE;
  110.   DEF_ROOTKEY         = rkCurrentUser;
  111.   {$ELSE}
  112.   DEF_USEREGISTRY     = FALSE;
  113.   {$ENDIF}
  114.   DEF_MRUDISPLAY      = mdFullPath;
  115.  
  116. type
  117.   TdfsMRUFileList = class;  { Forward declaration }
  118.  
  119.   { A simple TMenuItem descendant to be used for RTTI }
  120.   TMRUMenuItem = class(TMenuItem)
  121.   private
  122.     FFullCaption: string;
  123.     FOwningList: TdfsMRUFileList;
  124.   public
  125.     ItemNumber: byte;
  126.     constructor Create(AOwner: TComponent); override;
  127.     destructor Destroy; override;
  128.     property FullCaption: string read FFullCaption write FFullCaption;
  129.   end;
  130.  
  131.   { Event procedure for MRU item click.  Passes filename for easy us }
  132.   TMRUClick = procedure(Sender: TObject; AFilename: string) of object;
  133.   { Event for programatically determining if an MRU item is obsolete }
  134.   TMRURemoveObsolete = procedure(Sender: TObject; AnItem: string;
  135.      var Remove: boolean) of object;
  136.   { Event for getting the display name of an item for MRUDisplay = mdCustom }
  137.   TMRUGetDisplayName = procedure(Sender: TObject; AFilename: string;
  138.      var ADisplayName: string) of object;
  139.   { Events for creation/destruction of MRU menu items }
  140.   TMRUOnCreateDestroyMRUItem = procedure(Sender: TObject; Item: TMRUMenuItem)
  141.      of object;
  142.  
  143.   TdfsMRUFileList = class(TComponent)
  144.   private
  145.     { Property variables }
  146.     FAddToTop: boolean;
  147.     FMaximum: byte;
  148.     FRemoveOnClick: boolean;
  149.     FUseSubmenu: boolean;
  150.     FInsertSeparator : Boolean;
  151.     FSubmenuName: string;
  152.     FFileMenu: TMenuItem;
  153.     FPopupMenu: TPopupMenu;
  154.     FMenuItems: TStringList;
  155.     FAutoSave: boolean;
  156.     FAutoSaveName: string;
  157.     FAutoSaveKey: string;
  158.     FMaxCaptionWidth: integer;
  159.     FClearItemName : String;
  160.     FShowClearItem : Boolean;
  161.     FShowRemoveObsolete : Boolean;
  162.     FRemoveObsoleteName : String;
  163.     FOnRemoveObsolete: TMRURemoveObsolete;
  164.     { Event variables }
  165.     FOnMRUItemClick: TMRUClick;
  166.     { Internal use }
  167.     FInhibitUpdate: boolean;
  168.     FUseRegistry: boolean;
  169.     {$IFDEF DFS_WIN32}
  170.     FRegistryKey: HKEY;
  171.     {$ENDIF}
  172.     FMRUDisplay: TMRUDisplay;
  173.     FOnGetDisplayName: TMRUGetDisplayName;
  174.     FOnCreateMRUItem: TMRUOnCreateDestroyMRUItem;
  175.     FOnDestroyMRUItem: TMRUOnCreateDestroyMRUItem;
  176.  
  177.     { Property methods }
  178.     procedure SetMaximum(Val: byte);
  179.     procedure SetFileMenu(Val: TMenuItem);
  180.     procedure SetPopupMenu(const Val: TPopupMenu);
  181.     procedure SetUseSubmenu(Val: boolean);
  182.     procedure SetInsertSeparator(Val: boolean);
  183.     procedure SetSubmenuName(Val: string);
  184.     procedure SetMaxCaptionWidth(Val: integer);
  185.     procedure SetAutoSaveName(const Val: string);
  186.     procedure SetAutoSavekey(const Val: string);
  187.     {$IFDEF DFS_WIN32}
  188.     procedure SetAutoSaveRootKey(Val: TRootKey);
  189.     function GetAutoSaveRootKey: TRootKey;
  190.     {$ENDIF}
  191.     function GetVersion: string;
  192.     procedure SetVersion(const Val: string);
  193.     { MenuItem OnClick handler }
  194.     procedure SetMRUDisplay(Val: TMRUDisplay);
  195.     function GetMRUDisplay: TMRUDisplay;
  196.     procedure MRUClicked(Sender: TObject);
  197.     procedure ClearClicked(Sender : TObject);
  198.     procedure RemoveObsoleteClicked(Sender : TObject);
  199.     procedure SetClearItemName(const Value: String);
  200.     procedure SetRemoveObsoleteName(const Value: string);
  201.     procedure SetShowClearItem(const Value: boolean);
  202.     procedure SetShowRemoveObsolete(const Value: boolean);
  203.   protected
  204.     { Method to place items on menu }
  205.     procedure PopulateMenu; virtual;
  206.     { We need to know if our menu item is deleted. }
  207.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  208.     { Procedures for calling event handlers }
  209.     procedure GetDisplayName(AFilename: string; var ADisplayName: string); virtual;
  210.     procedure RemoveObsolete(AFilename: string; var Remove: boolean); virtual;
  211.     procedure MRUItemClick(AFilename: string); virtual;
  212.     procedure CreateMRUItem(AnItem: TMRUMenuItem); virtual;
  213.     procedure DestroyMRUItem(AnItem: TMRUMenuItem); virtual;
  214.     procedure Loaded; override;
  215.   public
  216.     constructor Create(Owner: TComponent); override;
  217.     destructor Destroy; override;
  218.     { Methods to add items to the MRU list }
  219.     procedure InsertItem(Index: integer; aFile: string);
  220.     procedure ReplaceItem(OldItem, NewItem: string);
  221.     procedure AddItem(aFile: string);
  222.     procedure AddStringList(Files: TStringList);
  223.     procedure AddStrings(Files: TStrings);
  224.     { Methods to load and save items. }
  225.     function Load: boolean;
  226.     function Save: boolean;
  227.     { Method to remove all MRU items from the menu, but NOT from the internal }
  228.     { list.  You probably want ClearAllItems. }
  229.     procedure RemoveAllItems;
  230.     { Method to clear a single item by name from the MRU items. }
  231.     procedure ClearItem (aFile: string);
  232.     { Method to clear all current MRU items. }
  233.     procedure ClearAllItems; virtual;
  234.     { Method to remove all "obsolete" items. }
  235.     procedure RemoveObsoleteItems; virtual;
  236.  
  237.     { The MRU Items.  Read Only. }
  238.     property Items: TStringList
  239.        read FMenuItems;
  240.   published
  241.     {$IFDEF DFS_WIN32}
  242.     property UseRegistry: boolean
  243.        read FUseRegistry
  244.        write FUseRegistry
  245.        nodefault;
  246.     {$ENDIF}
  247.     property Version: string
  248.        read GetVersion
  249.        write SetVersion
  250.        stored FALSE;
  251.     property AddToTop: boolean
  252.        read FAddToTop
  253.        write FAddToTop
  254.        default DEF_ADDTOTOP;
  255.     property Maximum: byte             { Maximum number of items on MRU list }
  256.        read FMaximum
  257.        write SetMaximum
  258.        default DEF_MAXIMUM;
  259.     property RemoveOnClick: boolean    { Remove MRU item when selected? }
  260.        read FRemoveOnClick
  261.        write FRemoveOnClick
  262.        default DEF_REMOVEONCLICK;
  263.     property UseSubmenu: boolean       { MRU items placed on a submenu? }
  264.        read FUseSubmenu
  265.        write SetUseSubmenu
  266.        default DEF_USESUBMENU;
  267.     property InsertSeparator : boolean
  268.        read FInsertSeparator
  269.        write SetInsertSeparator
  270.        default True;
  271.     property SubmenuName: string       { Caption of submenu item, if needed }
  272.        read FSubmenuName
  273.        write SetSubmenuName;
  274.     property ClearItemName : String    { caption of the ClearMenuItem }
  275.         read FClearItemName
  276.         write SetClearItemName;
  277.     property ShowClearItem :boolean
  278.         read FShowClearItem
  279.         write SetShowClearItem
  280.         default TRUE;
  281.     property ShowRemoveObsolete : boolean
  282.         read FShowRemoveObsolete
  283.         write SetShowRemoveObsolete
  284.         default TRUE;
  285.     property RemoveObsoleteName : string
  286.         read FRemoveObsoleteName
  287.         write SetRemoveObsoleteName;
  288.     property OnMRUItemClick: TMRUClick { Event for MRU item selection }
  289.        read FOnMRUItemClick
  290.        write FOnMRUItemClick;
  291.     property OnRemoveObsolete: TMRURemoveObsolete 
  292.        read FOnRemoveObsolete
  293.        write FOnRemoveObsolete;
  294.     property FileMenu: TMenuItem       { Menu to place MRU items on. }
  295.        read FFileMenu
  296.        write SetFileMenu;
  297.     property PopupMenu: TPopupMenu
  298.        read FPopupMenu
  299.        write SetPopupMenu;
  300.     property AutoSave: boolean         { Save and restore MRU items automatically. }
  301.        read FAutoSave
  302.        write FAutoSave
  303.        default TRUE;
  304.     property AutoSaveName: string      { The filename (INI) or key (registry) to save to.}
  305.        read FAutoSaveName
  306.        write SetAutoSaveName;
  307.     property AutoSaveKey: string       { The section to save to. }
  308.        read FAutoSaveKey
  309.        write SetAutoSavekey;
  310.     {$IFDEF DFS_WIN32}
  311.     property AutoSaveRootKey: TRootKey { Root registry key for AutoSaveName registry path }
  312.        read GetAutoSaveRootKey
  313.        write SetAutoSaveRootKey
  314.        default DEF_ROOTKEY;
  315.     {$ENDIF}
  316.     property MaxCaptionWidth: integer  { Maximum width of an MRU item, 0 = no maximum.}
  317.        read FMaxCaptionWidth
  318.        write SetMaxCaptionWidth
  319.        default DEF_MAXCAPTIONWIDTH;
  320.     property MRUDisplay: TMRUDisplay { How to display itmes on the menu }
  321.        read GetMRUDisplay
  322.        write SetMRUDisplay
  323.        default DEF_MRUDISPLAY;
  324.     property OnGetDisplayName: TMRUGetDisplayName
  325.        read FOnGetDisplayName
  326.        write FOnGetDisplayName;
  327.     property OnCreateMRUItem: TMRUOnCreateDestroyMRUItem
  328.        read FOnCreateMRUItem
  329.        write FOnCreateMRUItem;
  330.     property OnDestroyMRUItem: TMRUOnCreateDestroyMRUItem
  331.        read FOnDestroyMRUItem
  332.        write FOnDestroyMRUItem;
  333.   end;
  334.  
  335. implementation
  336.  
  337. uses
  338.   WinTypes, WinProcs, Graphics, FileCtrl, INIFiles;
  339.  
  340. var
  341.   MenuBmp: TBitmap;
  342.  
  343.  
  344. { Simple TMenuItem descendant mainly for RTTI, but also knows it's index     }
  345. { into the FMenuItems list.                                                  }
  346. constructor TMRUMenuItem.Create(AOwner: TComponent);
  347. begin
  348.   inherited Create(AOwner);
  349.   ItemNumber := 0;
  350.   FFullCaption := inherited Caption;
  351. end;
  352.  
  353. destructor TMRUMenuItem.Destroy;
  354. begin
  355.   if FOwningList <> NIL then
  356.     FOwningList.DestroyMRUItem(Self);
  357.  
  358.   inherited Destroy;
  359. end;
  360.  
  361.  
  362.  
  363. { Needs to do nothing more than initialize properties to defaults and create }
  364. { the list variable.                                                         }
  365. constructor TdfsMRUFileList.Create(Owner: TComponent);
  366. begin
  367.   inherited Create(Owner);
  368.   {$IFDEF DFS_WIN32}
  369.   AutoSaveRootKey := rkCurrentUser;
  370.   {$ENDIF}
  371.   FAddToTop := DEF_ADDTOTOP;
  372.   FMaximum := DEF_MAXIMUM;
  373.   FRemoveOnClick := DEF_REMOVEONCLICK;
  374.   FUseSubmenu := DEF_USESUBMENU;
  375.   FInsertSeparator:=True;
  376.   SubmenuName := DEF_SUBMENUNAME;
  377.   FMaxCaptionWidth := DEF_MAXCAPTIONWIDTH;
  378.   FMenuItems := TStringList.Create;
  379.   FMenuItems.Sorted := FALSE;
  380.   FMRUDisplay := mdFullPath;
  381.   FInhibitUpdate := FALSE;
  382.   FShowClearItem := True;
  383.   FShowRemoveObsolete := True;
  384.   FClearItemName := SClearItemCaption;
  385.   FRemoveObsoleteName := SRemoveObsoleteCaption;
  386.   FAutoSave := TRUE;
  387.   FUseRegistry := DEF_USEREGISTRY;
  388.   if FUseRegistry then
  389.     {$IFDEF DFS_DELPHI}
  390.     FAutoSaveName := '\Software\My Application'
  391.     {$ELSE}
  392.     FAutoSaveName := '\Software\My Application\'
  393.     {$ENDIF}
  394.   else
  395.     FAutoSaveName := 'MyINI.INI';
  396.   FAutoSaveKey := 'MRU Items';
  397. end;
  398.  
  399. destructor TdfsMRUFileList.Destroy;
  400. begin
  401.   if FAutoSave then
  402.     Save;
  403.   RemoveAllItems;
  404.   { Cleanup the list variable }
  405.   FMenuItems.Free;
  406.   inherited Destroy;
  407. end;
  408.  
  409. procedure TdfsMRUFileList.SetMaximum(Val: byte);
  410. begin
  411.   { Value not different or invalid, do nothing. }
  412.   if (FMaximum = Val) then exit;
  413.   if Val < FMaximum then begin    { If new less than old value, remove some. }
  414.     while FMenuItems.Count > Val do { Remove extra items }
  415.       if FAddToTop then
  416.         FMenuItems.Delete(FMenuItems.Count-1)
  417.       else
  418.         FMenuItems.Delete(0);
  419.     PopulateMenu;                 { Redo the MRU menu. }
  420.   end;
  421.   { Note: an ELSE clause is not needed since if new value is more than old,  }
  422.   {       nothing needs to be done.                                          }
  423.   FMaximum := Val;
  424. end;
  425.  
  426. procedure TdfsMRUFileList.SetFileMenu(Val: TMenuItem);
  427. begin
  428.   RemoveAllItems;           { Remove MRU items from old menu. }
  429.   FFileMenu := Val;
  430.   PopulateMenu;             { Add MRU items to new menu.      }
  431. end;
  432.  
  433. procedure TdfsMRUFileList.SetPopupMenu(const Val: TPopupMenu);
  434. begin
  435.   RemoveAllItems;           { Remove MRU items from old menu. }
  436.   FPopupMenu := Val;
  437.   PopulateMenu;             { Add MRU items to new menu.      }
  438. end;
  439.  
  440. procedure TdfsMRUFileList.SetUseSubmenu(Val: boolean);
  441. begin
  442.   if FUseSubmenu = Val then exit; { Value not different, do nothing . }
  443.   FUseSubmenu := Val;
  444.   PopulateMenu;                   { Redo the menu according to new value. }
  445. end;
  446.  
  447. procedure TdfsMRUFileList.SetInsertSeparator(Val: boolean);
  448. begin
  449.   If Val=FInsertSeparator then exit;
  450.   FInsertSeparator:=Val;
  451.   PopulateMenu;
  452. end;
  453.  
  454. procedure TdfsMRUFileList.SetSubmenuName(Val: string);
  455. begin
  456.   if FSubmenuName = Val then exit; { Value not different, do nothing . }
  457.   FSubmenuName := Val;
  458.   if FUseSubmenu then         { Don't bother if we're not using the submenu. }
  459.     PopulateMenu;             { Redo the menu according to new value. }
  460. end;
  461.  
  462. procedure TdfsMRUFileList.SetMaxCaptionWidth(Val: integer);
  463. begin
  464.   if Val = FMaxCaptionWidth then exit; { Value not different, do nothing. }
  465.   FMaxCaptionWidth := Val;
  466.   PopulateMenu;
  467. end;
  468.  
  469. {$IFDEF DFS_WIN32}
  470. procedure TdfsMRUFileList.SetAutoSaveRootKey(Val: TRootKey);
  471. const
  472.   ORD_TO_VAL : array[TRootKey] of HKEY = (HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
  473.      HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA);
  474. begin
  475.   FRegistryKey := ORD_TO_VAL[Val];
  476.   if FAutoSave then
  477.     Load;
  478. end;
  479.  
  480. function TdfsMRUFileList.GetAutoSaveRootKey: TRootKey;
  481. begin
  482.   case FRegistryKey of
  483.     HKEY_CLASSES_ROOT:   Result := rkClassesRoot;
  484.     HKEY_LOCAL_MACHINE:  Result := rkLocalMachine;
  485.     HKEY_USERS:          Result := rkUsers;
  486.     HKEY_CURRENT_CONFIG: Result := rkCurrentConfig;
  487.     HKEY_DYN_DATA:       Result := rkDynData;
  488.   else
  489.     Result := rkCurrentUser;
  490.   end;
  491. end;
  492. {$ENDIF}
  493.  
  494. procedure TdfsMRUFileList.SetAutoSaveName(const Val: string);
  495. begin
  496.   if FAutoSaveName = Val then
  497.     exit;
  498.   FAutoSaveName := Val;
  499.   {$IFDEF DFS_WIN32}
  500.   // Causes wierd problems if it doesn't begin with a '\' character.
  501.   if FUseRegistry and (FAutoSaveName <> '') then
  502.   begin
  503.     if FAutoSaveName[1] <> '\' then
  504.       FAutoSaveName := '\' + FAutoSaveName;
  505.     {$IFDEF DFS_CPPB}
  506.     // C++Builder doesn't like it if the key doesn't end with a \ char.
  507.     if FAutoSaveName[Length(FAutoSaveName)] <> '\' then
  508.       FAutoSaveName := FAutoSaveName + '\';
  509.     {$ENDIF}
  510.   end;
  511.  
  512.   {$ENDIF}
  513.   if FAutoSave and (not (csLoading in ComponentState)) then
  514.     Load;
  515. end;
  516.  
  517. procedure TdfsMRUFileList.SetAutoSaveKey(const Val: string);
  518. begin
  519.   if FAutoSaveKey = Val then
  520.     exit;
  521.   FAutoSaveKey := Val;
  522.   if FAutoSave and (not (csLoading in ComponentState)) then
  523.     Load;
  524. end;
  525.  
  526. procedure TdfsMRUFileList.SetMRUDisplay(Val: TMRUDisplay);
  527. begin
  528.   FMRUDisplay := Val;
  529.   if FAutoSave and (not (csLoading in ComponentState)) then
  530.     Load;
  531. end;
  532.  
  533. function TdfsMRUFileList.GetMRUDisplay: TMRUDisplay;
  534. begin
  535.   Result := FMRUDisplay;
  536. end;
  537.  
  538. procedure TdfsMRUFileList.ClearClicked(Sender : TObject);
  539. begin
  540.   ClearAllItems;
  541. end;
  542.  
  543. procedure TdfsMRUFileList.RemoveObsoleteClicked(Sender : TObject);
  544. begin
  545.   RemoveObsoleteItems;
  546. end;
  547.  
  548. procedure TdfsMRUFileList.MRUClicked(Sender: TObject);
  549. var
  550.   ClickItem: string;
  551. begin
  552.   with Sender as TMRUMenuItem do begin
  553.     if assigned(FOnMRUItemClick) then       { Save the clicked item's filename }
  554.       ClickItem := FMenuItems[ItemNumber-1]
  555.     else
  556.       ClickItem := '';
  557.     if FRemoveOnClick then begin        { Remove the item, if desired. }
  558.       FMenuItems.Delete(ItemNumber-1);
  559.       PopulateMenu;
  560.     end;
  561.     MRUItemClick(ClickItem);                  { Call the users event handler. }
  562.   end;
  563. end;
  564.  
  565. procedure TdfsMRUFileList.InsertItem(Index: integer; aFile: string);
  566. var
  567.   i: integer;
  568. begin
  569.   i := FMenuItems.IndexOf(aFile);        { Search list for item being added. }
  570.   if i > -1 then                         { Find it? }
  571.     FMenuItems.Move(i, Index)            { Yes, move it to the top. }
  572.   else begin
  573.     while FMenuItems.Count > (FMaximum-1) do { Remove extra items. }
  574.       if FAddToTop then
  575.         FMenuItems.Delete(FMenuItems.Count-1)
  576.       else
  577.         FMenuItems.Delete(0);
  578.     FMenuItems.Insert(Index, aFile);     { No, add it. }
  579.   end;
  580.   if not FInhibitUpdate then             { Should we update the menu now? }
  581.     PopulateMenu;                        { Yes, redo the menu. }
  582. end;
  583.  
  584. procedure TdfsMRUFileList.ReplaceItem(OldItem, NewItem: string);
  585. var
  586.   i: integer;
  587. begin
  588.   i := FMenuItems.IndexOf(OldItem);      { Search list for item being added. }
  589.   if i = -1 then                         { Find it? }
  590.     exit                                 { No, get out. }
  591.   else begin
  592.     FMenuItems.Delete(i);                { Yes, remove it }
  593.     FMenuItems.Insert(i, NewItem);       { and replace with the new one. }
  594.   end;
  595.   if not FInhibitUpdate then             { Should we update the menu now? }
  596.     PopulateMenu;                        { Yes, redo the menu. }
  597. end;
  598.  
  599. procedure TdfsMRUFileList.AddItem(aFile: string);
  600. var
  601.   i: integer;
  602. begin
  603.   i := FMenuItems.IndexOf(aFile);        { Search list for item being added. }
  604.   if i > -1 then                         { Find it? }
  605.   begin
  606.     if FAddToTop then
  607.       FMenuItems.Move(i, 0)              { Yes, move it to the top. }
  608.     else
  609.       FMenuItems.Move(i, FMenuItems.Count-1);
  610.   end else begin
  611.     if FAddToTop then
  612.       FMenuItems.Insert(0, aFile)
  613.     else
  614.       FMenuItems.Add(aFile);             { No, add it to the bottom. }
  615.  
  616.     while FMenuItems.Count > FMaximum do { Remove extra items. }
  617.       if FAddToTop then
  618.         FMenuItems.Delete(FMenuItems.Count-1)
  619.       else
  620.         FMenuItems.Delete(0);
  621.   end;
  622.   if not FInhibitUpdate then             { Should we update the menu now? }
  623.     PopulateMenu;                        { Yes, redo the menu. }
  624. end;
  625.  
  626. procedure TdfsMRUFileList.AddStringList(Files: TStringList);
  627. var
  628.   x: integer;
  629. begin
  630.   FInhibitUpdate := TRUE;      { Don't let AddItem method call PopulateMenu. }
  631.   for x := 0 to Files.Count - 1 do  { Add each item. }
  632.     AddItem(Files[x]);
  633.   FInhibitUpdate := FALSE;     { Clear inhibit flag. }
  634.   PopulateMenu;                { Update menu now that all are added. }
  635. end;
  636.  
  637. procedure TdfsMRUFileList.AddStrings(Files: TStrings);
  638. var
  639.   x: integer;
  640. begin
  641.   FInhibitUpdate := TRUE;      { Don't let AddItem method call PopulateMenu. }
  642.   for x := 0 to Files.Count - 1 do  { Add each item. }
  643.     AddItem(Files[x]);
  644.   FInhibitUpdate := FALSE;     { Clear inhibit flag. }
  645.   PopulateMenu;                { Update menu now that all are added. }
  646. end;
  647.  
  648. procedure TdfsMRUFileList.PopulateMenu;
  649.   function MakeAmpShortcut(i: integer): string;
  650.   const
  651.     sChars : array[0..35] of char = ('1','2','3','4','5','6','7','8','9','0',
  652.                                      'A','B','C','D','E','F','G','H','I','J',
  653.                                      'K','L','M','N','O','P','Q','R','S','T',
  654.                                      'U','V','W','X','Y','Z');
  655.   begin
  656.     if i < 36 then
  657.       Result := '&' + SChars[i] + ' '
  658.     else
  659.       Result := '';
  660.   end;
  661. var
  662.   Offset,
  663.   x, y: integer;
  664.   NewItem: TMRUMenuItem;
  665.   ParentMenu,
  666.   AddMenu,
  667.   CurMenu,
  668.   NewMenuItem : TMenuItem;
  669.   s, t: string;
  670. begin
  671.   { No menus assigned, nothing to do. }
  672.   if (FFileMenu = NIL) and (FPopupMenu = NIL) then exit;
  673.   RemoveAllItems;                        { Remove all old items. }
  674.   if (FMenuItems.Count = 0) then exit;   { Don't have any items, we're done. }
  675.  
  676.   if FFileMenu <> NIL then
  677.   begin
  678.     { If FFileMenu is an item, insert before it.  If not, it's a submenu }
  679.     { so just add to the end of it                                       }
  680.     if FFileMenu.Count <> 0 then
  681.     begin
  682.       Offset := FFileMenu.Count;
  683.       ParentMenu := FFileMenu;
  684.     end else begin
  685.   {$IFDEF DFS_WIN32}
  686.       Offset := FFileMenu.MenuIndex;
  687.   {$ELSE}
  688.       Offset := FFileMenu.Parent.IndexOf(FFileMenu);
  689.   {$ENDIF}
  690.       ParentMenu := FFileMenu.Parent;
  691.     end;
  692.  
  693.     { Create separator item. }
  694.     if FInsertSeparator then
  695.     begin
  696.       NewItem := TMRUMenuItem.Create(ParentMenu);
  697.       NewItem.Caption := '-';
  698.       NewItem.FOwningList := Self;
  699.       CreateMRUItem(NewItem);
  700.       ParentMenu.Insert(Offset, NewItem);
  701.       inc(Offset);
  702.     end;
  703.  
  704.     { Create submenu if needed }
  705.     if FUseSubmenu then
  706.     begin
  707.       AddMenu := TMRUMenuItem.Create(ParentMenu);
  708.       AddMenu.Caption := FSubmenuName;
  709.       TMRUMenuItem(AddMenu).FOwningList := Self;
  710.       CreateMRUItem(TMRUMenuItem(AddMenu));
  711.       ParentMenu.Insert(Offset, AddMenu);
  712.       Offset := 0;
  713.     end else
  714.       AddMenu := ParentMenu; { Don't need submenu, just set to the file menu. }
  715.   end else begin
  716.     AddMenu := NIL;
  717.     Offset := 0;
  718.   end;
  719.  
  720.   { Create MRU items }
  721.   for y := 0 to 1 do
  722.   begin
  723.     CurMenu := NIL;
  724.     if (y = 0) then
  725.     begin
  726.       if assigned(AddMenu) then
  727.         CurMenu := AddMenu
  728.     end else begin
  729.       Offset := 0;
  730.       if assigned(FPopupMenu) then
  731.         CurMenu := FPopupMenu.Items
  732.     end;
  733.     if CurMenu = NIL then continue;
  734.  
  735.     for x := 0 to FMenuItems.Count - 1 do
  736.     begin
  737.       NewItem := TMRUMenuItem.Create(CurMenu);
  738.       NewItem.FullCaption := MakeAmpShortcut(x) + FMenuItems[x];
  739.       NewItem.FOwningList := Self;
  740.       case FMRUDisplay of
  741.         mdFullPath:
  742.           if FMaxCaptionWidth = 0 then
  743.             NewItem.Caption := NewItem.FullCaption
  744.           else
  745.             NewItem.Caption := MakeAmpShortcut(x) + MinimizeName(FMenuItems[x],
  746.               MenuBmp.Canvas, FMaxCaptionWidth);
  747.         mdFileNameExt:
  748.           { Can't minimize a filename only, so don't bother with MaxCaptionWidth }
  749.           NewItem.Caption := ExtractFileName(NewItem.FullCaption);
  750.         mdFileNameOnly:
  751.           begin
  752.             { Can't minimize a filename only, so don't bother with MaxCaptionWidth }
  753.             s := ExtractFileName(NewItem.FullCaption);
  754.             t := ExtractFileExt(s);
  755.             if (Length(t) > 0) then
  756.               Delete(s, Length(s) - Length(t) + 1, Length(t));
  757.             NewItem.Caption := s;
  758.           end;
  759.         mdCustom:
  760.           begin
  761.             s := FMenuItems[x];
  762.             t := NewItem.FullCaption;
  763.             GetDisplayName(s, t);
  764.             NewItem.Caption := t;
  765.           end;
  766.       end;
  767.       NewItem.ItemNumber := x + 1;                { Index into FMenuItems list }
  768.       NewItem.OnClick := MRUClicked;              { Set event handler }
  769.       CreateMRUItem(NewItem);
  770.       CurMenu.Insert(Offset, NewItem);            { Add to the menu }
  771.       inc(Offset);
  772.     end;
  773.  
  774.     if (y = 0) then
  775.     begin
  776.       { this is the seperator near the bottom of the menu, above the Clear MRU item }
  777.       if (FShowClearItem) or (FShowRemoveObsolete) then
  778.       begin
  779.         NewMenuItem := TMRUMenuItem.Create(AddMenu);
  780.         NewMenuItem.Caption := '-';
  781.         TMRUMenuItem(NewMenuItem).FOwningList := Self;
  782.         CreateMRUItem(TMRUMenuItem(NewMenuItem));
  783.         AddMenu.Insert(Offset, NewMenuItem);
  784.         Inc(Offset);
  785.       end;
  786.  
  787.       { this is the Clear MRU item }
  788.       if (FShowClearItem) then
  789.       begin
  790.         NewMenuItem := TMRUMenuItem.Create(AddMenu);
  791.         if FClearItemName = '' then
  792.           NewMenuItem.Caption := SClearItemCaption
  793.         else
  794.           NewMenuItem.Caption := FClearItemName;
  795.         TMRUMenuItem(NewMenuItem).FOwningList := Self;
  796.         NewMenuItem.OnClick := ClearClicked;
  797.         CreateMRUItem(TMRUMenuItem(NewMenuItem));
  798.         AddMenu.Insert(Offset, NewMenuItem);
  799.         Inc(Offset);
  800.       end;
  801.  
  802.       { this is the Remove Obsolete item }
  803.       if (FShowRemoveObsolete) then
  804.       begin
  805.         NewMenuItem := TMRUMenuItem.Create(AddMenu);
  806.         if FRemoveObsoleteName = '' then
  807.           NewMenuItem.Caption := SRemoveObsoleteCaption
  808.         else
  809.           NewMenuItem.Caption := FRemoveObsoleteName;
  810.         TMRUMenuItem(NewMenuItem).FOwningList := Self;
  811.         NewMenuItem.OnClick := RemoveObsoleteClicked;
  812.         CreateMRUItem(TMRUMenuItem(NewMenuItem));
  813.         AddMenu.Insert(Offset, NewMenuItem);
  814.       end;
  815.     end;
  816.   end;
  817. end;
  818.  
  819. procedure TdfsMRUFileList.RemoveAllItems;
  820. var
  821.   i, x: integer;
  822.   DeleteItem,
  823.   ParentMenu: TMenuItem;
  824. begin
  825.   { No menu, nothing to delete. }
  826.   if (FFileMenu = NIL) and (FPopupMenu = NIL) then exit;
  827.  
  828.   for i := 0 to 1 do
  829.   begin
  830.     if (i = 0) and (FFileMenu <> NIL) then
  831.     begin
  832.       if FFileMenu.Count <> 0 then
  833.         ParentMenu := FFileMenu
  834.       else
  835.         ParentMenu := FFileMenu.Parent;
  836.     end else if (i = 1) and (FPopupMenu <> NIL) then
  837.       ParentMenu := FPopupMenu.Items
  838.     else
  839.       ParentMenu := NIL;
  840.  
  841.     if ParentMenu = NIL then continue;           { No menu, nothing to delete. }
  842.  
  843.     { We don't know exactly which items are ours, so we have to check them all }
  844.     for x := ParentMenu.Count-1 downto 0 do begin
  845.       { Use RTTI to determine if item is of our special descenadant type. }
  846.       if (ParentMenu[x] is TMRUMenuItem) and
  847.          (TMRUMenuItem(ParentMenu[x]).FOwningList = Self) then
  848.       begin
  849.         DeleteItem := ParentMenu[x];
  850.         ParentMenu.Delete(x);   { Yes, it is, delete it. }
  851.         DeleteItem.Free;        { Don't forget the object, too! - RGL }
  852.       end;
  853.     end;
  854.   end;
  855. end;
  856.  
  857. procedure TdfsMRUFileList.ClearItem(aFile: string);
  858. var
  859.   i: integer;
  860. begin
  861.   i := FMenuItems.IndexOf(aFile);        { Search list for item being removed. }
  862.   if i > -1 then                         { Find it? }
  863.   begin
  864.     FMenuItems.Delete(i);                { Yes, delete it. }
  865.     PopulateMenu;                        { redo the menu. }
  866.   end;
  867. end;
  868.  
  869. function TdfsMRUFileList.Load: boolean;
  870.   procedure StripIdents(Items: TStringList);
  871.   var
  872.     p: byte;
  873.     x: integer;
  874.   begin
  875.     for x := 0 to Items.Count-1 do begin
  876.       p := Pos('=',Items[x])+1;
  877.       Items[x] := copy(Items[x], p, Length(Items[x])-p+1);
  878.     end;
  879.   end;
  880. var
  881.   {$IFDEF DFS_WIN32}
  882.   RegSettings: TRegIniFile;
  883.   {$ENDIF}
  884.   IniSettings: TIniFile;
  885. begin
  886.   Result := FALSE;
  887.   if csDesigning in ComponentState then
  888.     exit;
  889.  
  890.   ClearAllItems;
  891.   if (FAutoSaveName = '') or (FAutoSaveKey = '') then exit;
  892.   {$IFDEF DFS_WIN32}
  893.   if FUseRegistry then
  894.   begin
  895.     RegSettings := TRegIniFile.Create(FAutoSaveName);
  896.     try
  897.       RegSettings.RootKey := FRegistryKey;
  898.       RegSettings.OpenKey(FAutoSaveName, TRUE);
  899.       RegSettings.ReadSectionValues(FAutoSaveKey, FMenuItems);
  900.     finally
  901.       RegSettings.Free;
  902.     end;
  903.   end else
  904.   {$ENDIF}
  905.   begin
  906.     IniSettings := TIniFile.Create(FAutoSaveName);
  907.     try
  908.       IniSettings.ReadSectionValues(FAutoSaveKey, FMenuItems);
  909.     finally
  910.       IniSettings.Free;
  911.     end;
  912.   end;
  913.   StripIdents(FMenuItems);
  914.   PopulateMenu;
  915.   Result := TRUE;
  916. end;
  917.  
  918. function TdfsMRUFileList.Save: boolean;
  919. var
  920.   {$IFDEF DFS_WIN32}
  921.   RegSettings: TRegIniFile;
  922.   {$ENDIF}
  923.   IniSettings: TIniFile;
  924.   x: integer;
  925. begin
  926.   Result := FALSE;
  927.   if (FAutoSaveName = '') or (FAutoSaveKey = '') or
  928.     (csDesigning in ComponentState) then
  929.     exit;
  930.     
  931.   {$IFDEF DFS_WIN32}
  932.   if FUseRegistry then
  933.   begin
  934.     RegSettings := TRegIniFile.Create(FAutoSaveName);
  935.     try
  936.       RegSettings.RootKey := FRegistryKey;
  937.       RegSettings.OpenKey(FAutoSaveName, TRUE);
  938.       RegSettings.EraseSection(FAutoSaveKey);
  939.       for x := 0 to Items.Count-1 do
  940.         RegSettings.WriteString(FAutoSaveKey, 'F'+IntToStr(x), Items[x]);
  941.       Result := TRUE;
  942.     finally
  943.       RegSettings.Free;
  944.     end;
  945.   end else
  946.   {$ENDIF}
  947.   begin
  948.     IniSettings := TIniFile.Create(FAutoSaveName);
  949.     try
  950.       IniSettings.EraseSection(FAutoSaveKey);
  951.       for x := 0 to Items.Count-1 do
  952.         IniSettings.WriteString(FAutoSaveKey, 'F'+IntToStr(x), Items[x]);
  953.       Result := TRUE;
  954.     finally
  955.       IniSettings.Free;
  956.     end;
  957.   end;
  958. end;
  959.  
  960. procedure TdfsMRUFileList.Notification(AComponent: TComponent; Operation: TOperation);
  961. begin
  962.   inherited Notification(AComponent, Operation);
  963.   if (Operation = opRemove) then
  964.   begin
  965.     if (AComponent = FFileMenu) then
  966.       { Our placement menu item has been deleted. }
  967.       FFileMenu := NIL
  968.     else if (AComponent = FPopupMenu) then
  969.       FPopupMenu := NIL;
  970.   end;
  971. end;
  972.  
  973. procedure TdfsMRUFileList.ClearAllItems;
  974. begin
  975.   RemoveAllItems;
  976.   FMenuItems.Clear;
  977. end;
  978.  
  979. procedure TdfsMRUFileList.RemoveObsoleteItems;
  980. var
  981.   i : integer;
  982.   Dirty: boolean;
  983.   RemoveItem: boolean;
  984. begin
  985.   Dirty := FALSE;
  986.   for i := FMenuItems.Count - 1 downto 0 do
  987.   begin
  988.     RemoveItem := FALSE;
  989.     if assigned(FOnRemoveObsolete) then
  990.       RemoveObsolete(FMenuItems[i], RemoveItem)
  991.     else
  992.       RemoveItem := not FileExists(FMenuItems[i]);
  993.     if RemoveItem then
  994.     begin
  995.       FMenuItems.Delete(i);
  996.       Dirty := TRUE;
  997.     end;
  998.   end;
  999.  
  1000.   if Dirty then
  1001.     PopulateMenu;
  1002. end;
  1003.  
  1004. function TdfsMRUFileList.GetVersion: string;
  1005. begin
  1006.   Result := DFS_COMPONENT_VERSION;
  1007. end;
  1008.  
  1009. procedure TdfsMRUFileList.SetVersion(const Val: string);
  1010. begin
  1011.   { empty write method, just needed to get it to show up in Object Inspector }
  1012. end;
  1013.  
  1014. procedure TdfsMRUFileList.GetDisplayName(AFilename: string; var ADisplayName: string);
  1015. begin
  1016.   if assigned(FOnGetDisplayName) then
  1017.     FOnGetDisplayName(Self, AFilename, ADisplayName);
  1018. end;
  1019.  
  1020. procedure TdfsMRUFileList.RemoveObsolete(AFilename: string; var Remove: boolean);
  1021. begin
  1022.   if assigned(FOnRemoveObsolete) then
  1023.     FOnRemoveObsolete(Self, AFilename, Remove);
  1024. end;
  1025.  
  1026. procedure TdfsMRUFileList.MRUItemClick(AFilename: string);
  1027. begin
  1028.   if assigned(FOnMRUItemClick) then
  1029.     FOnMRUItemClick(Self, AFilename);
  1030. end;
  1031.  
  1032. procedure TdfsMRUFileList.CreateMRUItem(AnItem: TMRUMenuItem);
  1033. begin
  1034.   if assigned(FOnCreateMRUItem) then
  1035.     FOnCreateMRUItem(Self, AnItem);
  1036. end;
  1037.  
  1038. procedure TdfsMRUFileList.DestroyMRUItem(AnItem: TMRUMenuItem);
  1039. begin
  1040.   if assigned(FOnDestroyMRUItem) then
  1041.     FOnDestroyMRUItem(Self, AnItem);
  1042. end;
  1043.  
  1044. procedure TdfsMRUFileList.Loaded;
  1045. begin
  1046.   inherited Loaded;
  1047.   if FAutoSave then
  1048.     Load;
  1049. end;
  1050.  
  1051. procedure TdfsMRUFileList.SetClearItemName(const Value: String);
  1052. begin
  1053.   if FClearItemName <> Value then
  1054.   begin
  1055.     FClearItemName := Value;
  1056.     if not (csDesigning in ComponentState) then
  1057.       PopulateMenu;
  1058.   end;
  1059. end;
  1060.  
  1061. procedure TdfsMRUFileList.SetRemoveObsoleteName(const Value: string);
  1062. begin
  1063.   if FRemoveObsoleteName <> Value then
  1064.   begin
  1065.     FRemoveObsoleteName := Value;
  1066.     if not (csDesigning in ComponentState) then
  1067.       PopulateMenu;
  1068.   end;
  1069. end;
  1070.  
  1071. procedure TdfsMRUFileList.SetShowClearItem(const Value: boolean);
  1072. begin
  1073.   if FShowClearItem <> Value then
  1074.   begin
  1075.     FShowClearItem := Value;
  1076.     if not (csDesigning in ComponentState) then
  1077.       PopulateMenu;
  1078.   end;
  1079. end;
  1080.  
  1081. procedure TdfsMRUFileList.SetShowRemoveObsolete(const Value: boolean);
  1082. begin
  1083.   if FShowRemoveObsolete <> Value then
  1084.   begin
  1085.     FShowRemoveObsolete := Value;
  1086.     if not (csDesigning in ComponentState) then
  1087.       PopulateMenu;
  1088.   end;
  1089. end;
  1090.  
  1091.  
  1092.  
  1093. {$IFNDEF DFS_WIN32}
  1094. procedure FreeMemoryBmp; far;
  1095. begin
  1096.   MenuBmp.Free;
  1097. end;
  1098. {$ENDIF}
  1099.  
  1100. var
  1101. {$IFDEF DFS_WIN32}
  1102.   NCM: TNonClientMetrics;
  1103. {$ELSE}
  1104.   LF: TLogFont;
  1105. {$ENDIF}
  1106.  
  1107. initialization
  1108.   MenuBmp:= TBitmap.Create;
  1109.   {$IFDEF DFS_WIN32}
  1110.   NCM.cbSize := SizeOf(TNonClientMetrics);
  1111.   SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0);
  1112.   MenuBmp.Canvas.Font.Handle := CreateFontIndirect(NCM.lfMenuFont);
  1113.   {$ELSE}
  1114.   GetObject(GetStockObject(SYSTEM_FONT), SizeOf(TLogFont), @LF);
  1115.   MenuBmp.Canvas.Font.Handle := CreateFontIndirect(LF);
  1116.   {$ENDIF}
  1117.  
  1118. {$IFDEF DFS_WIN32}
  1119. finalization
  1120.   MenuBmp.Free;
  1121. {$ELSE}
  1122.   AddExitProc(FreeMemoryBmp);
  1123. {$ENDIF}
  1124.  
  1125. end.
  1126.  
  1127.