home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / MRULIST.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  16KB  |  552 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1997, 1998 Master-Bank          }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit MRUList;
  10.  
  11. {$I RX.INC}
  12. {$R-,B-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Classes, Menus, IniFiles {$IFDEF WIN32}, Registry {$ENDIF},
  17.   Placemnt;
  18.  
  19. type
  20.   TRecentStrings = class;
  21.  
  22. { TMRUManager }
  23.  
  24.   TGetItemEvent = procedure (Sender: TObject; var Caption: string;
  25.     var ShortCut: TShortCut; UserData: Longint) of object;
  26.   TReadItemEvent = procedure (Sender: TObject; IniFile: TObject;
  27.     const Section: string; Index: Integer; var RecentName: string;
  28.     var UserData: Longint) of object;
  29.   TWriteItemEvent = procedure (Sender: TObject; IniFile: TObject;
  30.     const Section: string; Index: Integer; const RecentName: string;
  31.     UserData: Longint) of object;
  32.   TClickMenuEvent = procedure (Sender: TObject; const RecentName,
  33.     Caption: string; UserData: Longint) of object;
  34.  
  35.   TAccelDelimiter = (adTab, adSpace);
  36.   TRecentMode = (rmInsert, rmAppend);
  37.  
  38.   TMRUManager = class(TComponent)
  39.   private
  40.     FList: TStrings;
  41.     FItems: TList;
  42.     FIniLink: TIniLink;
  43.     FSeparateSize: Word;
  44.     FAutoEnable: Boolean;
  45.     FAutoUpdate: Boolean;
  46.     FShowAccelChar: Boolean;
  47.     FRemoveOnSelect: Boolean;
  48.     FStartAccel: Cardinal;
  49.     FAccelDelimiter: TAccelDelimiter;
  50.     FRecentMenu: TMenuItem;
  51.     FOnChange: TNotifyEvent;
  52.     FOnGetItem: TGetItemEvent;
  53.     FOnClick: TClickMenuEvent;
  54.     FOnReadItem: TReadItemEvent;
  55.     FOnWriteItem: TWriteItemEvent;
  56.     procedure ListChanged(Sender: TObject);
  57.     procedure ClearRecentMenu;
  58.     procedure SetRecentMenu(Value: TMenuItem);
  59.     procedure SetSeparateSize(Value: Word);
  60.     function GetStorage: TFormPlacement;
  61.     procedure SetStorage(Value: TFormPlacement);
  62.     function GetCapacity: Integer;
  63.     procedure SetCapacity(Value: Integer);
  64.     function GetMode: TRecentMode;
  65.     procedure SetMode(Value: TRecentMode);
  66.     procedure SetStartAccel(Value: Cardinal);
  67.     procedure SetShowAccelChar(Value: Boolean);
  68.     procedure SetAccelDelimiter(Value: TAccelDelimiter);
  69.     procedure SetAutoEnable(Value: Boolean);
  70.     procedure AddMenuItem(Item: TMenuItem);
  71.     procedure MenuItemClick(Sender: TObject);
  72.     procedure IniSave(Sender: TObject);
  73.     procedure IniLoad(Sender: TObject);
  74.     procedure InternalLoad(Ini: TObject; const Section: string);
  75.     procedure InternalSave(Ini: TObject; const Section: string);
  76.   protected
  77.     procedure Change; dynamic;
  78.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  79.     procedure DoReadItem(Ini: TObject; const Section: string;
  80.       Index: Integer; var RecentName: string; var UserData: Longint); dynamic;
  81.     procedure DoWriteItem(Ini: TObject; const Section: string; Index: Integer;
  82.       const RecentName: string; UserData: Longint); dynamic;
  83.     procedure GetItemData(var Caption: string; var ShortCut: TShortCut;
  84.       UserData: Longint); dynamic;
  85.     procedure DoClick(const RecentName, Caption: string; UserData: Longint); dynamic;
  86.   public
  87.     constructor Create(AOwner: TComponent); override;
  88.     destructor Destroy; override;
  89.     procedure Add(const RecentName: string; UserData: Longint);
  90.     procedure Clear;
  91.     procedure Remove(const RecentName: string);
  92.     procedure UpdateRecentMenu;
  93. {$IFDEF WIN32}
  94.     procedure LoadFromRegistry(Ini: TRegIniFile; const Section: string);
  95.     procedure SaveToRegistry(Ini: TRegIniFile; const Section: string);
  96. {$ENDIF WIN32}
  97.     procedure LoadFromIni(Ini: TIniFile; const Section: string);
  98.     procedure SaveToIni(Ini: TIniFile; const Section: string);
  99.     property Strings: TStrings read FList;
  100.   published
  101.     property AccelDelimiter: TAccelDelimiter read FAccelDelimiter write SetAccelDelimiter default adTab;
  102.     property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
  103.     property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate default True;
  104.     property Capacity: Integer read GetCapacity write SetCapacity default 10;
  105.     property Mode: TRecentMode read GetMode write SetMode default rmInsert;
  106.     property RemoveOnSelect: Boolean read FRemoveOnSelect write FRemoveOnSelect default False;
  107.     property IniStorage: TFormPlacement read GetStorage write SetStorage;
  108.     property SeparateSize: Word read FSeparateSize write SetSeparateSize default 0;
  109.     property RecentMenu: TMenuItem read FRecentMenu write SetRecentMenu;
  110.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  111.     property StartAccel: Cardinal read FStartAccel write SetStartAccel default 1;
  112.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  113.     property OnClick: TClickMenuEvent read FOnClick write FOnClick;
  114.     property OnGetItemData: TGetItemEvent read FOnGetItem write FOnGetItem;
  115.     property OnReadItem: TReadItemEvent read FOnReadItem write FOnReadItem;
  116.     property OnWriteItem: TWriteItemEvent read FOnWriteItem write FOnWriteItem;
  117.   end;
  118.  
  119. { TRecentStrings }
  120.  
  121.   TRecentStrings = class(TStringList)
  122.   private
  123.     FMaxSize: Integer;
  124.     FMode: TRecentMode;
  125.     procedure SetMaxSize(Value: Integer);
  126.   public
  127.     constructor Create;
  128.     function Add(const S: string): Integer; override;
  129.     procedure AddStrings(Strings: TStrings); override;
  130.     procedure DeleteExceed;
  131.     procedure Remove(const S: String);
  132.     property MaxSize: Integer read FMaxSize write SetMaxSize;
  133.     property Mode: TRecentMode read FMode write FMode;
  134.   end;
  135.  
  136. implementation
  137.  
  138. uses Controls, MaxMin, AppUtils;
  139.  
  140. const
  141.   siRecentItem = 'Item_%d';
  142.   siRecentData = 'User_%d';
  143.  
  144. { TMRUManager }
  145.  
  146. constructor TMRUManager.Create(AOwner: TComponent);
  147. begin
  148.   inherited Create(AOwner);
  149.   FList := TRecentStrings.Create;
  150.   FItems := TList.Create;
  151.   TRecentStrings(FList).OnChange := ListChanged;
  152.   FIniLink := TIniLink.Create;
  153.   FIniLink.OnSave := IniSave;
  154.   FIniLink.OnLoad := IniLoad;
  155.   FAutoUpdate := True;
  156.   FAutoEnable := True;
  157.   FShowAccelChar := True;
  158.   FStartAccel := 1;
  159. end;
  160.  
  161. destructor TMRUManager.Destroy;
  162. begin
  163.   ClearRecentMenu;
  164.   FIniLink.Free;
  165.   TRecentStrings(FList).OnChange := nil;
  166.   FList.Free;
  167.   FItems.Free;
  168.   FItems := nil;
  169.   inherited Destroy;
  170. end;
  171.  
  172. procedure TMRUManager.Notification(AComponent: TComponent; Operation: TOperation);
  173. begin
  174.   inherited Notification(AComponent, Operation);
  175.   if (AComponent = RecentMenu) and (Operation = opRemove) then
  176.     RecentMenu := nil;
  177. end;
  178.  
  179. procedure TMRUManager.GetItemData(var Caption: string; var ShortCut: TShortCut;
  180.   UserData: Longint);
  181. begin
  182.   if Assigned(FOnGetItem) then FOnGetItem(Self, Caption, ShortCut, UserData);
  183. end;
  184.  
  185. procedure TMRUManager.DoClick(const RecentName, Caption: string; UserData: Longint);
  186. begin
  187.   if Assigned(FOnClick) then FOnClick(Self, RecentName, Caption, UserData);
  188. end;
  189.  
  190. procedure TMRUManager.MenuItemClick(Sender: TObject);
  191. var
  192.   I: Integer;
  193. begin
  194.   if Sender is TMenuItem then begin
  195.     I := TMenuItem(Sender).Tag;
  196.     if (I >= 0) and (I < FList.Count) then
  197.       try
  198.         DoClick(FList[I], TMenuItem(Sender).Caption, Longint(FList.Objects[I]));
  199.       finally
  200.         if RemoveOnSelect then Remove(FList[I]);
  201.       end;
  202.   end;
  203. end;
  204.  
  205. function TMRUManager.GetCapacity: Integer;
  206. begin
  207.   Result := TRecentStrings(FList).MaxSize;
  208. end;
  209.  
  210. procedure TMRUManager.SetCapacity(Value: Integer);
  211. begin
  212.   TRecentStrings(FList).MaxSize := Value;
  213. end;
  214.  
  215. function TMRUManager.GetMode: TRecentMode;
  216. begin
  217.   Result := TRecentStrings(FList).Mode;
  218. end;
  219.  
  220. procedure TMRUManager.SetMode(Value: TRecentMode);
  221. begin
  222.   TRecentStrings(FList).Mode := Value;
  223. end;
  224.  
  225. function TMRUManager.GetStorage: TFormPlacement;
  226. begin
  227.   Result := FIniLink.Storage;
  228. end;
  229.  
  230. procedure TMRUManager.SetStorage(Value: TFormPlacement);
  231. begin
  232.   FIniLink.Storage := Value;
  233. end;
  234.  
  235. procedure TMRUManager.SetAutoEnable(Value: Boolean);
  236. begin
  237.   if FAutoEnable <> Value then begin
  238.     FAutoEnable := Value;
  239.     if Assigned(FRecentMenu) and FAutoEnable then
  240.       FRecentMenu.Enabled := FRecentMenu.Count > 0;
  241.   end;
  242. end;
  243.  
  244. procedure TMRUManager.SetStartAccel(Value: Cardinal);
  245. begin
  246.   if FStartAccel <> Value then begin
  247.     FStartAccel := Value;
  248.     if FAutoUpdate then UpdateRecentMenu;
  249.   end;
  250. end;
  251.  
  252. procedure TMRUManager.SetAccelDelimiter(Value: TAccelDelimiter);
  253. begin
  254.   if FAccelDelimiter <> Value then begin
  255.     FAccelDelimiter := Value;
  256.     if FAutoUpdate and ShowAccelChar then UpdateRecentMenu;
  257.   end;
  258. end;
  259.  
  260. procedure TMRUManager.SetShowAccelChar(Value: Boolean);
  261. begin
  262.   if FShowAccelChar <> Value then begin
  263.     FShowAccelChar := Value;
  264.     if FAutoUpdate then UpdateRecentMenu;
  265.   end;
  266. end;
  267.  
  268. procedure TMRUManager.Add(const RecentName: string; UserData: Longint);
  269. begin
  270.   FList.AddObject(RecentName, TObject(UserData));
  271. end;
  272.  
  273. procedure TMRUManager.Clear;
  274. begin
  275.   FList.Clear;
  276. end;
  277.  
  278. procedure TMRUManager.Remove(const RecentName: string);
  279. begin
  280.   TRecentStrings(FList).Remove(RecentName);
  281. end;
  282.  
  283. procedure TMRUManager.AddMenuItem(Item: TMenuItem);
  284. begin
  285.   if Assigned(Item) then begin
  286.     FRecentMenu.Add(Item);
  287.     FItems.Add(Item);
  288.   end;
  289. end;
  290.  
  291. procedure TMRUManager.UpdateRecentMenu;
  292. const
  293.   AccelDelimChars: array[TAccelDelimiter] of Char = (#9, ' ');
  294. var
  295.   I: Integer;
  296.   L: Cardinal;
  297.   S: string;
  298.   C: string[2];
  299.   ShortCut: TShortCut;
  300.   Item: TMenuItem;
  301. begin
  302.   ClearRecentMenu;
  303.   if Assigned(FRecentMenu) then begin
  304.     if (FList.Count > 0) and (FRecentMenu.Count > 0) then
  305.       AddMenuItem(NewLine);
  306.     for I := 0 to FList.Count - 1 do begin
  307.       if (FSeparateSize > 0) and (I > 0) and (I mod FSeparateSize = 0) then
  308.         AddMenuItem(NewLine);
  309.       S := FList[I];
  310.       ShortCut := scNone;
  311.       GetItemData(S, ShortCut, Longint(FList.Objects[I]));
  312.       Item := NewItem(GetShortHint(S), ShortCut, False, True,
  313.         MenuItemClick, 0, '');
  314.       Item.Hint := GetLongHint(S);
  315.       if FShowAccelChar then begin
  316.         L := Cardinal(I) + FStartAccel;
  317.         if L < 10 then
  318.           C := '&' + Char(Ord('0') + L)
  319.         else if L <= (Ord('Z') + 10) then
  320.           C := '&' + Char(L + Ord('A') - 10)
  321.         else
  322.           C := ' ';
  323.         Item.Caption := C + AccelDelimChars[FAccelDelimiter] + Item.Caption;
  324.       end;
  325.       Item.Tag := I;
  326.       AddMenuItem(Item);
  327.     end;
  328.     if AutoEnable then FRecentMenu.Enabled := FRecentMenu.Count > 0;
  329.   end;
  330. end;
  331.  
  332. procedure TMRUManager.ClearRecentMenu;
  333. var
  334.   Item: TMenuItem;
  335. begin
  336.   while FItems.Count > 0 do begin
  337.     Item := TMenuItem(FItems.Last);
  338.     if Assigned(FRecentMenu) and (FRecentMenu.IndexOf(Item) >= 0) then
  339.       Item.Free;
  340.     FItems.Remove(Item);
  341.   end;
  342.   if Assigned(FRecentMenu) and AutoEnable then
  343.     FRecentMenu.Enabled := FRecentMenu.Count > 0;
  344. end;
  345.  
  346. procedure TMRUManager.SetRecentMenu(Value: TMenuItem);
  347. begin
  348.   ClearRecentMenu;
  349.   FRecentMenu := Value;
  350. {$IFDEF WIN32}
  351.   if Value <> nil then Value.FreeNotification(Self);
  352. {$ENDIF}
  353.   UpdateRecentMenu;
  354. end;
  355.  
  356. procedure TMRUManager.SetSeparateSize(Value: Word);
  357. begin
  358.   if FSeparateSize <> Value then begin
  359.     FSeparateSize := Value;
  360.     if FAutoUpdate then UpdateRecentMenu;
  361.   end;
  362. end;
  363.  
  364. procedure TMRUManager.ListChanged(Sender: TObject);
  365. begin
  366.   Change;
  367.   if FAutoUpdate then UpdateRecentMenu;
  368. end;
  369.  
  370. procedure TMRUManager.IniSave(Sender: TObject);
  371. begin
  372.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  373.     InternalSave(FIniLink.IniObject, FIniLink.RootSection +
  374.       GetDefaultSection(Self));
  375. end;
  376.  
  377. procedure TMRUManager.IniLoad(Sender: TObject);
  378. begin
  379.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  380.     InternalLoad(FIniLink.IniObject, FIniLink.RootSection +
  381.       GetDefaultSection(Self));
  382. end;
  383.  
  384. procedure TMRUManager.Change;
  385. begin
  386.   if Assigned(FOnChange) then FOnChange(Self);
  387. end;
  388.  
  389. procedure TMRUManager.DoReadItem(Ini: TObject; const Section: string;
  390.   Index: Integer; var RecentName: string; var UserData: Longint);
  391. begin
  392.   if Assigned(FOnReadItem) then
  393.     FOnReadItem(Self, Ini, Section, Index, RecentName, UserData)
  394.   else begin
  395.     RecentName := IniReadString(Ini, Section, Format(siRecentItem, [Index]), RecentName);
  396.     UserData := IniReadInteger(Ini, Section, Format(siRecentData, [Index]), UserData);
  397.   end;
  398. end;
  399.  
  400. procedure TMRUManager.DoWriteItem(Ini: TObject; const Section: string;
  401.   Index: Integer; const RecentName: string; UserData: Longint);
  402. begin
  403.   if Assigned(FOnWriteItem) then
  404.     FOnWriteItem(Self, Ini, Section, Index, RecentName, UserData)
  405.   else begin
  406.     IniWriteString(Ini, Section, Format(siRecentItem, [Index]), RecentName);
  407.     if UserData = 0 then
  408.       IniDeleteKey(Ini, Section, Format(siRecentData, [Index]))
  409.     else
  410.       IniWriteInteger(Ini, Section, Format(siRecentData, [Index]), UserData);
  411.   end;
  412. end;
  413.  
  414. procedure TMRUManager.InternalLoad(Ini: TObject; const Section: string);
  415. var
  416.   I: Integer;
  417.   S: string;
  418.   UserData: Longint;
  419.   AMode: TRecentMode;
  420. begin
  421.   AMode := Mode;
  422.   FList.BeginUpdate;
  423.   try
  424.     FList.Clear;
  425.     Mode := rmInsert;
  426.     for I := TRecentStrings(FList).MaxSize - 1 downto 0 do begin
  427.       S := '';
  428.       UserData := 0;
  429.       DoReadItem(Ini, Section, I, S, UserData);
  430.       if S <> '' then Add(S, UserData);
  431.     end;
  432.   finally
  433.     Mode := AMode;
  434.     FList.EndUpdate;
  435.   end;
  436. end;
  437.  
  438. procedure TMRUManager.InternalSave(Ini: TObject; const Section: string);
  439. var
  440.   I: Integer;
  441. begin
  442.   IniEraseSection(Ini, Section);
  443.   for I := 0 to FList.Count - 1 do
  444.     DoWriteItem(Ini, Section, I, FList[I], Longint(FList.Objects[I]));
  445. end;
  446.  
  447. {$IFDEF WIN32}
  448. procedure TMRUManager.LoadFromRegistry(Ini: TRegIniFile; const Section: string);
  449. begin
  450.   InternalLoad(Ini, Section);
  451. end;
  452.  
  453. procedure TMRUManager.SaveToRegistry(Ini: TRegIniFile; const Section: string);
  454. begin
  455.   InternalSave(Ini, Section);
  456. end;
  457. {$ENDIF WIN32}
  458.  
  459. procedure TMRUManager.LoadFromIni(Ini: TIniFile; const Section: string);
  460. begin
  461.   InternalLoad(Ini, Section);
  462. end;
  463.  
  464. procedure TMRUManager.SaveToIni(Ini: TIniFile; const Section: string);
  465. begin
  466.   InternalSave(Ini, Section);
  467. end;
  468.  
  469. { TRecentStrings }
  470.  
  471. constructor TRecentStrings.Create;
  472. begin
  473.   inherited Create;
  474.   FMaxSize := 10;
  475.   FMode := rmInsert;
  476. end;
  477.  
  478. procedure TRecentStrings.SetMaxSize(Value: Integer);
  479. begin
  480.   if FMaxSize <> Value then begin
  481.     FMaxSize := Max(1, Value);
  482.     DeleteExceed;
  483.   end;
  484. end;
  485.  
  486. procedure TRecentStrings.DeleteExceed;
  487. var
  488.   I: Integer;
  489. begin
  490.   BeginUpdate;
  491.   try
  492.     if FMode = rmInsert then begin
  493.       for I := Count - 1 downto FMaxSize do Delete(I);
  494.     end
  495.     else begin { rmAppend }
  496.       while Count > FMaxSize do Delete(0);
  497.     end;
  498.   finally
  499.     EndUpdate;
  500.   end;
  501. end;
  502.  
  503. procedure TRecentStrings.Remove(const S: String);
  504. var
  505.   I: Integer;
  506. begin
  507.   I := IndexOf(S);
  508.   if I >= 0 then Delete(I);
  509. end;
  510.  
  511. function TRecentStrings.Add(const S: String): Integer;
  512. begin
  513.   Result := IndexOf(S);
  514.   if Result >= 0 then begin
  515.     if FMode = rmInsert then Move(Result, 0)
  516.     else { rmAppend } Move(Result, Count - 1);
  517.   end
  518.   else begin
  519.     BeginUpdate;
  520.     try
  521.       if FMode = rmInsert then Insert(0, S)
  522.       else { rmAppend } Insert(Count, S);
  523.       DeleteExceed;
  524.     finally
  525.       EndUpdate;
  526.     end;
  527.   end;
  528.   if FMode = rmInsert then Result := 0
  529.   else { rmAppend } Result := Count - 1;
  530. end;
  531.  
  532. procedure TRecentStrings.AddStrings(Strings: TStrings);
  533. var
  534.   I: Integer;
  535. begin
  536.   BeginUpdate;
  537.   try
  538.     if FMode = rmInsert then begin
  539.       for I := Min(Strings.Count, FMaxSize) - 1 downto 0 do
  540.         AddObject(Strings[I], Strings.Objects[I]);
  541.     end
  542.     else begin { rmAppend }
  543.       for I := 0 to Min(Strings.Count, FMaxSize) - 1 do
  544.         AddObject(Strings[I], Strings.Objects[I]);
  545.     end;
  546.     DeleteExceed;
  547.   finally
  548.     EndUpdate;
  549.   end;
  550. end;
  551.  
  552. end.