mruflist.pas

动态提示控件

  FMaxCaptionWidth := DEF_MAXCAPTIONWIDTH;
  FMenuItems := TStringList.Create;
  FMenuItems.Sorted := FALSE;
  FMRUDisplay := mdFullPath;
  FInhibitUpdate := FALSE;
  FShowClearItem := True;
  FShowRemoveObsolete := True;
  FClearItemName := SClearItemCaption;
  FRemoveObsoleteName := SRemoveObsoleteCaption;
  FAutoSave := TRUE;
  FUseRegistry := DEF_USEREGISTRY;
  if FUseRegistry then
    {$IFDEF DFS_DELPHI}
    FAutoSaveName := '\Software\My Application'
    {$ELSE}
    FAutoSaveName := '\Software\My Application\'
    {$ENDIF}
  else
    FAutoSaveName := 'MyINI.INI';
  FAutoSaveKey := 'MRU Items';
end;

destructor TdfsMRUFileList.Destroy;
begin
  if FAutoSave then
    Save;
  RemoveAllItems;
  { Cleanup the list variable }
  FMenuItems.Free;
  inherited Destroy;
end;

procedure TdfsMRUFileList.SetMaximum(Val: byte);
begin
  { Value not different or invalid, do nothing. }
  if (FMaximum = Val) then exit;
  if Val < FMaximum then begin    { If new less than old value, remove some. }
    while FMenuItems.Count > Val do { Remove extra items }
      if FAddToTop then
        FMenuItems.Delete(FMenuItems.Count-1)
      else
        FMenuItems.Delete(0);
    PopulateMenu;                 { Redo the MRU menu. }
  end;
  { Note: an ELSE clause is not needed since if new value is more than old,  }
  {       nothing needs to be done.                                          }
  FMaximum := Val;
end;

procedure TdfsMRUFileList.SetFileMenu(Val: TMenuItem);
begin
  RemoveAllItems;           { Remove MRU items from old menu. }
  FFileMenu := Val;
  PopulateMenu;             { Add MRU items to new menu.      }
end;

procedure TdfsMRUFileList.SetPopupMenu(const Val: TPopupMenu);
begin
  RemoveAllItems;           { Remove MRU items from old menu. }
  FPopupMenu := Val;
  PopulateMenu;             { Add MRU items to new menu.      }
end;

procedure TdfsMRUFileList.SetUseSubmenu(Val: boolean);
begin
  if FUseSubmenu = Val then exit; { Value not different, do nothing . }
  FUseSubmenu := Val;
  PopulateMenu;                   { Redo the menu according to new value. }
end;

procedure TdfsMRUFileList.SetInsertSeparator(Val: boolean);
begin
  If Val=FInsertSeparator then exit;
  FInsertSeparator:=Val;
  PopulateMenu;
end;

procedure TdfsMRUFileList.SetSubmenuName(Val: string);
begin
  if FSubmenuName = Val then exit; { Value not different, do nothing . }
  FSubmenuName := Val;
  if FUseSubmenu then         { Don't bother if we're not using the submenu. }
    PopulateMenu;             { Redo the menu according to new value. }
end;

procedure TdfsMRUFileList.SetMaxCaptionWidth(Val: integer);
begin
  if Val = FMaxCaptionWidth then exit; { Value not different, do nothing. }
  FMaxCaptionWidth := Val;
  PopulateMenu;
end;

{$IFDEF DFS_WIN32}
procedure TdfsMRUFileList.SetAutoSaveRootKey(Val: TRootKey);
const
  ORD_TO_VAL : array[TRootKey] of HKEY = (HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
     HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA);
begin
  FRegistryKey := ORD_TO_VAL[Val];
  if FAutoSave then
    Load;
end;

function TdfsMRUFileList.GetAutoSaveRootKey: TRootKey;
begin
  case FRegistryKey of
    HKEY_CLASSES_ROOT:   Result := rkClassesRoot;
    HKEY_LOCAL_MACHINE:  Result := rkLocalMachine;
    HKEY_USERS:          Result := rkUsers;
    HKEY_CURRENT_CONFIG: Result := rkCurrentConfig;
    HKEY_DYN_DATA:       Result := rkDynData;
  else
    Result := rkCurrentUser;
  end;
end;
{$ENDIF}

procedure TdfsMRUFileList.SetAutoSaveName(const Val: string);
begin
  if FAutoSaveName = Val then
    exit;
  FAutoSaveName := Val;
  {$IFDEF DFS_WIN32}
  // Causes wierd problems if it doesn't begin with a '\' character.
  if FUseRegistry and (FAutoSaveName <> '') then
  begin
    if FAutoSaveName[1] <> '\' then
      FAutoSaveName := '\' + FAutoSaveName;
    {$IFDEF DFS_CPPB}
    // C++Builder doesn't like it if the key doesn't end with a \ char.
    if FAutoSaveName[Length(FAutoSaveName)] <> '\' then
      FAutoSaveName := FAutoSaveName + '\';
    {$ENDIF}
  end;

  {$ENDIF}
  if FAutoSave and (not (csLoading in ComponentState)) then
    Load;
end;

procedure TdfsMRUFileList.SetAutoSaveKey(const Val: string);
begin
  if FAutoSaveKey = Val then
    exit;
  FAutoSaveKey := Val;
  if FAutoSave and (not (csLoading in ComponentState)) then
    Load;
end;

procedure TdfsMRUFileList.SetMRUDisplay(Val: TMRUDisplay);
begin
  FMRUDisplay := Val;
  if FAutoSave and (not (csLoading in ComponentState)) then
    Load;
end;

function TdfsMRUFileList.GetMRUDisplay: TMRUDisplay;
begin
  Result := FMRUDisplay;
end;

procedure TdfsMRUFileList.ClearClicked(Sender : TObject);
begin
  ClearAllItems;
end;

procedure TdfsMRUFileList.RemoveObsoleteClicked(Sender : TObject);
begin
  RemoveObsoleteItems;
end;

procedure TdfsMRUFileList.MRUClicked(Sender: TObject);
var
  ClickItem: string;
begin
  with Sender as TMRUMenuItem do begin
    if assigned(FOnMRUItemClick) then       { Save the clicked item's filename }
      ClickItem := FMenuItems[ItemNumber-1]
    else
      ClickItem := '';
    if FRemoveOnClick then begin        { Remove the item, if desired. }
      FMenuItems.Delete(ItemNumber-1);
      PopulateMenu;
    end;
    MRUItemClick(ClickItem);                  { Call the users event handler. }
  end;
end;

procedure TdfsMRUFileList.InsertItem(Index: integer; aFile: string);
var
  i: integer;
begin
  i := FMenuItems.IndexOf(aFile);        { Search list for item being added. }
  if i > -1 then                         { Find it? }
    FMenuItems.Move(i, Index)            { Yes, move it to the top. }
  else begin
    while FMenuItems.Count > (FMaximum-1) do { Remove extra items. }
      if FAddToTop then
        FMenuItems.Delete(FMenuItems.Count-1)
      else
        FMenuItems.Delete(0);
    FMenuItems.Insert(Index, aFile);     { No, add it. }
  end;
  if not FInhibitUpdate then             { Should we update the menu now? }
    PopulateMenu;                        { Yes, redo the menu. }
end;

procedure TdfsMRUFileList.ReplaceItem(OldItem, NewItem: string);
var
  i: integer;
begin
  i := FMenuItems.IndexOf(OldItem);      { Search list for item being added. }
  if i = -1 then                         { Find it? }
    exit                                 { No, get out. }
  else begin
    FMenuItems.Delete(i);                { Yes, remove it }
    FMenuItems.Insert(i, NewItem);       { and replace with the new one. }
  end;
  if not FInhibitUpdate then             { Should we update the menu now? }
    PopulateMenu;                        { Yes, redo the menu. }
end;

procedure TdfsMRUFileList.AddItem(aFile: string);
var
  i: integer;
begin
  i := FMenuItems.IndexOf(aFile);        { Search list for item being added. }
  if i > -1 then                         { Find it? }
  begin
    if FAddToTop then
      FMenuItems.Move(i, 0)              { Yes, move it to the top. }
    else
      FMenuItems.Move(i, FMenuItems.Count-1);
  end else begin
    if FAddToTop then
      FMenuItems.Insert(0, aFile)
    else
      FMenuItems.Add(aFile);             { No, add it to the bottom. }

    while FMenuItems.Count > FMaximum do { Remove extra items. }
      if FAddToTop then
        FMenuItems.Delete(FMenuItems.Count-1)
      else
        FMenuItems.Delete(0);
  end;
  if not FInhibitUpdate then             { Should we update the menu now? }
    PopulateMenu;                        { Yes, redo the menu. }
end;

procedure TdfsMRUFileList.AddStringList(Files: TStringList);
var
  x: integer;
begin
  FInhibitUpdate := TRUE;      { Don't let AddItem method call PopulateMenu. }
  for x := 0 to Files.Count - 1 do  { Add each item. }
    AddItem(Files[x]);
  FInhibitUpdate := FALSE;     { Clear inhibit flag. }
  PopulateMenu;                { Update menu now that all are added. }
end;

procedure TdfsMRUFileList.AddStrings(Files: TStrings);
var
  x: integer;
begin
  FInhibitUpdate := TRUE;      { Don't let AddItem method call PopulateMenu. }
  for x := 0 to Files.Count - 1 do  { Add each item. }
    AddItem(Files[x]);
  FInhibitUpdate := FALSE;     { Clear inhibit flag. }
  PopulateMenu;                { Update menu now that all are added. }
end;

procedure TdfsMRUFileList.PopulateMenu;
  function MakeAmpShortcut(i: integer): string;
  const
    sChars : array[0..35] of char = ('1','2','3','4','5','6','7','8','9','0',
                                     'A','B','C','D','E','F','G','H','I','J',
                                     'K','L','M','N','O','P','Q','R','S','T',
                                     'U','V','W','X','Y','Z');
  begin
    if i < 36 then
      Result := '&' + SChars[i] + ' '
    else
      Result := '';
  end;
var
  Offset,
  x, y: integer;
  NewItem: TMRUMenuItem;
  ParentMenu,
  AddMenu,
  CurMenu,
  NewMenuItem : TMenuItem;
  s, t: string;
begin
  { No menus assigned, nothing to do. }
  if (FFileMenu = NIL) and (FPopupMenu = NIL) then exit;
  RemoveAllItems;                        { Remove all old items. }
  if (FMenuItems.Count = 0) then exit;   { Don't have any items, we're done. }

  if FFileMenu <> NIL then
  begin
    { If FFileMenu is an item, insert before it.  If not, it's a submenu }
    { so just add to the end of it                                       }
    if FFileMenu.Count <> 0 then
    begin
      Offset := FFileMenu.Count;
      ParentMenu := FFileMenu;
    end else begin
  {$IFDEF DFS_WIN32}
      Offset := FFileMenu.MenuIndex;
  {$ELSE}
      Offset := FFileMenu.Parent.IndexOf(FFileMenu);
  {$ENDIF}
      ParentMenu := FFileMenu.Parent;
    end;

    { Create separator item. }
    if FInsertSeparator then
    begin
      NewItem := TMRUMenuItem.Create(ParentMenu);
      NewItem.Caption := '-';
      NewItem.FOwningList := Self;
      CreateMRUItem(NewItem);
      ParentMenu.Insert(Offset, NewItem);
      inc(Offset);
    end;

    { Create submenu if needed }
    if FUseSubmenu then
    begin
      AddMenu := TMRUMenuItem.Create(ParentMenu);
      AddMenu.Caption := FSubmenuName;
      TMRUMenuItem(AddMenu).FOwningList := Self;
      CreateMRUItem(TMRUMenuItem(AddMenu));
      ParentMenu.Insert(Offset, AddMenu);
      Offset := 0;
    end else
      AddMenu := ParentMenu; { Don't need submenu, just set to the file menu. }
  end else begin
    AddMenu := NIL;
    Offset := 0;
  end;

  { Create MRU items }
  for y := 0 to 1 do
  begin
    CurMenu := NIL;
    if (y = 0) then
    begin
      if assigned(AddMenu) then
        CurMenu := AddMenu
    end else begin
      Offset := 0;
      if assigned(FPopupMenu) then
        CurMenu := FPopupMenu.Items
    end;
    if CurMenu = NIL then continue;

    for x := 0 to FMenuItems.Count - 1 do
    begin
      NewItem := TMRUMenuItem.Create(CurMenu);
      NewItem.FullCaption := MakeAmpShortcut(x) + FMenuItems[x];
      NewItem.FOwningList := Self;
      case FMRUDisplay of
        mdFullPath:
          if FMaxCaptionWidth = 0 then
            NewItem.Caption := NewItem.FullCaption
          else
            NewItem.Caption := MakeAmpShortcut(x) + MinimizeName(FMenuItems[x],
              MenuBmp.Canvas, FMaxCaptionWidth);
        mdFileNameExt:
          { Can't minimize a filename only, so don't bother with MaxCaptionWidth }
          NewItem.Caption := ExtractFileName(NewItem.FullCaption);
        mdFileNameOnly:
          begin
            { Can't minimize a filename only, so don't bother with MaxCaptionWidth }