mruflist.pas

动态提示控件

            s := ExtractFileName(NewItem.FullCaption);
            t := ExtractFileExt(s);
            if (Length(t) > 0) then
              Delete(s, Length(s) - Length(t) + 1, Length(t));
            NewItem.Caption := s;
          end;
        mdCustom:
          begin
            s := FMenuItems[x];
            t := NewItem.FullCaption;
            GetDisplayName(s, t);
            NewItem.Caption := t;
          end;
      end;
      NewItem.ItemNumber := x + 1;                { Index into FMenuItems list }
      NewItem.OnClick := MRUClicked;              { Set event handler }
      CreateMRUItem(NewItem);
      CurMenu.Insert(Offset, NewItem);            { Add to the menu }
      inc(Offset);
    end;

    if (y = 0) then
    begin
      { this is the seperator near the bottom of the menu, above the Clear MRU item }
      if (FShowClearItem) or (FShowRemoveObsolete) then
      begin
        NewMenuItem := TMRUMenuItem.Create(AddMenu);
        NewMenuItem.Caption := '-';
        TMRUMenuItem(NewMenuItem).FOwningList := Self;
        CreateMRUItem(TMRUMenuItem(NewMenuItem));
        AddMenu.Insert(Offset, NewMenuItem);
        Inc(Offset);
      end;

      { this is the Clear MRU item }
      if (FShowClearItem) then
      begin
        NewMenuItem := TMRUMenuItem.Create(AddMenu);
        if FClearItemName = '' then
          NewMenuItem.Caption := SClearItemCaption
        else
          NewMenuItem.Caption := FClearItemName;
        TMRUMenuItem(NewMenuItem).FOwningList := Self;
        NewMenuItem.OnClick := ClearClicked;
        CreateMRUItem(TMRUMenuItem(NewMenuItem));
        AddMenu.Insert(Offset, NewMenuItem);
        Inc(Offset);
      end;

      { this is the Remove Obsolete item }
      if (FShowRemoveObsolete) then
      begin
        NewMenuItem := TMRUMenuItem.Create(AddMenu);
        if FRemoveObsoleteName = '' then
          NewMenuItem.Caption := SRemoveObsoleteCaption
        else
          NewMenuItem.Caption := FRemoveObsoleteName;
        TMRUMenuItem(NewMenuItem).FOwningList := Self;
        NewMenuItem.OnClick := RemoveObsoleteClicked;
        CreateMRUItem(TMRUMenuItem(NewMenuItem));
        AddMenu.Insert(Offset, NewMenuItem);
      end;
    end;
  end;
end;

procedure TdfsMRUFileList.RemoveAllItems;
var
  i, x: integer;
  DeleteItem,
  ParentMenu: TMenuItem;
begin
  { No menu, nothing to delete. }
  if (FFileMenu = NIL) and (FPopupMenu = NIL) then exit;

  for i := 0 to 1 do
  begin
    if (i = 0) and (FFileMenu <> NIL) then
    begin
      if FFileMenu.Count <> 0 then
        ParentMenu := FFileMenu
      else
        ParentMenu := FFileMenu.Parent;
    end else if (i = 1) and (FPopupMenu <> NIL) then
      ParentMenu := FPopupMenu.Items
    else
      ParentMenu := NIL;

    if ParentMenu = NIL then continue;           { No menu, nothing to delete. }

    { We don't know exactly which items are ours, so we have to check them all }
    for x := ParentMenu.Count-1 downto 0 do begin
      { Use RTTI to determine if item is of our special descenadant type. }
      if (ParentMenu[x] is TMRUMenuItem) and
         (TMRUMenuItem(ParentMenu[x]).FOwningList = Self) then
      begin
        DeleteItem := ParentMenu[x];
        ParentMenu.Delete(x);   { Yes, it is, delete it. }
        DeleteItem.Free;        { Don't forget the object, too! - RGL }
      end;
    end;
  end;
end;

procedure TdfsMRUFileList.ClearItem(aFile: string);
var
  i: integer;
begin
  i := FMenuItems.IndexOf(aFile);        { Search list for item being removed. }
  if i > -1 then                         { Find it? }
  begin
    FMenuItems.Delete(i);                { Yes, delete it. }
    PopulateMenu;                        { redo the menu. }
  end;
end;

function TdfsMRUFileList.Load: boolean;
  procedure StripIdents(Items: TStringList);
  var
    p: byte;
    x: integer;
  begin
    for x := 0 to Items.Count-1 do begin
      p := Pos('=',Items[x])+1;
      Items[x] := copy(Items[x], p, Length(Items[x])-p+1);
    end;
  end;
var
  {$IFDEF DFS_WIN32}
  RegSettings: TRegIniFile;
  {$ENDIF}
  IniSettings: TIniFile;
begin
  Result := FALSE;
  if csDesigning in ComponentState then
    exit;

  ClearAllItems;
  if (FAutoSaveName = '') or (FAutoSaveKey = '') then exit;
  {$IFDEF DFS_WIN32}
  if FUseRegistry then
  begin
    RegSettings := TRegIniFile.Create(FAutoSaveName);
    try
      RegSettings.RootKey := FRegistryKey;
      RegSettings.OpenKey(FAutoSaveName, TRUE);
      RegSettings.ReadSectionValues(FAutoSaveKey, FMenuItems);
    finally
      RegSettings.Free;
    end;
  end else
  {$ENDIF}
  begin
    IniSettings := TIniFile.Create(FAutoSaveName);
    try
      IniSettings.ReadSectionValues(FAutoSaveKey, FMenuItems);
    finally
      IniSettings.Free;
    end;
  end;
  StripIdents(FMenuItems);
  PopulateMenu;
  Result := TRUE;
end;

function TdfsMRUFileList.Save: boolean;
var
  {$IFDEF DFS_WIN32}
  RegSettings: TRegIniFile;
  {$ENDIF}
  IniSettings: TIniFile;
  x: integer;
begin
  Result := FALSE;
  if (FAutoSaveName = '') or (FAutoSaveKey = '') or
    (csDesigning in ComponentState) then
    exit;
    
  {$IFDEF DFS_WIN32}
  if FUseRegistry then
  begin
    RegSettings := TRegIniFile.Create(FAutoSaveName);
    try
      RegSettings.RootKey := FRegistryKey;
      RegSettings.OpenKey(FAutoSaveName, TRUE);
      RegSettings.EraseSection(FAutoSaveKey);
      for x := 0 to Items.Count-1 do
        RegSettings.WriteString(FAutoSaveKey, 'F'+IntToStr(x), Items[x]);
      Result := TRUE;
    finally
      RegSettings.Free;
    end;
  end else
  {$ENDIF}
  begin
    IniSettings := TIniFile.Create(FAutoSaveName);
    try
      IniSettings.EraseSection(FAutoSaveKey);
      for x := 0 to Items.Count-1 do
        IniSettings.WriteString(FAutoSaveKey, 'F'+IntToStr(x), Items[x]);
      Result := TRUE;
    finally
      IniSettings.Free;
    end;
  end;
end;

procedure TdfsMRUFileList.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if (AComponent = FFileMenu) then
      { Our placement menu item has been deleted. }
      FFileMenu := NIL
    else if (AComponent = FPopupMenu) then
      FPopupMenu := NIL;
  end;
end;

procedure TdfsMRUFileList.ClearAllItems;
begin
  RemoveAllItems;
  FMenuItems.Clear;
end;

procedure TdfsMRUFileList.RemoveObsoleteItems;
var
  i : integer;
  Dirty: boolean;
  RemoveItem: boolean;
begin
  Dirty := FALSE;
  for i := FMenuItems.Count - 1 downto 0 do
  begin
    RemoveItem := FALSE;
    if assigned(FOnRemoveObsolete) then
      RemoveObsolete(FMenuItems[i], RemoveItem)
    else
      RemoveItem := not FileExists(FMenuItems[i]);
    if RemoveItem then
    begin
      FMenuItems.Delete(i);
      Dirty := TRUE;
    end;
  end;

  if Dirty then
    PopulateMenu;
end;

function TdfsMRUFileList.GetVersion: string;
begin
  Result := DFS_COMPONENT_VERSION;
end;

procedure TdfsMRUFileList.SetVersion(const Val: string);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;

procedure TdfsMRUFileList.GetDisplayName(AFilename: string; var ADisplayName: string);
begin
  if assigned(FOnGetDisplayName) then
    FOnGetDisplayName(Self, AFilename, ADisplayName);
end;

procedure TdfsMRUFileList.RemoveObsolete(AFilename: string; var Remove: boolean);
begin
  if assigned(FOnRemoveObsolete) then
    FOnRemoveObsolete(Self, AFilename, Remove);
end;

procedure TdfsMRUFileList.MRUItemClick(AFilename: string);
begin
  if assigned(FOnMRUItemClick) then
    FOnMRUItemClick(Self, AFilename);
end;

procedure TdfsMRUFileList.CreateMRUItem(AnItem: TMRUMenuItem);
begin
  if assigned(FOnCreateMRUItem) then
    FOnCreateMRUItem(Self, AnItem);
end;

procedure TdfsMRUFileList.DestroyMRUItem(AnItem: TMRUMenuItem);
begin
  if assigned(FOnDestroyMRUItem) then
    FOnDestroyMRUItem(Self, AnItem);
end;

procedure TdfsMRUFileList.Loaded;
begin
  inherited Loaded;
  if FAutoSave then
    Load;
end;

procedure TdfsMRUFileList.SetClearItemName(const Value: String);
begin
  if FClearItemName <> Value then
  begin
    FClearItemName := Value;
    if not (csDesigning in ComponentState) then
      PopulateMenu;
  end;
end;

procedure TdfsMRUFileList.SetRemoveObsoleteName(const Value: string);
begin
  if FRemoveObsoleteName <> Value then
  begin
    FRemoveObsoleteName := Value;
    if not (csDesigning in ComponentState) then
      PopulateMenu;
  end;
end;

procedure TdfsMRUFileList.SetShowClearItem(const Value: boolean);
begin
  if FShowClearItem <> Value then
  begin
    FShowClearItem := Value;
    if not (csDesigning in ComponentState) then
      PopulateMenu;
  end;
end;

procedure TdfsMRUFileList.SetShowRemoveObsolete(const Value: boolean);
begin
  if FShowRemoveObsolete <> Value then
  begin
    FShowRemoveObsolete := Value;
    if not (csDesigning in ComponentState) then
      PopulateMenu;
  end;
end;



{$IFNDEF DFS_WIN32}
procedure FreeMemoryBmp; far;
begin
  MenuBmp.Free;
end;
{$ENDIF}

var
{$IFDEF DFS_WIN32}
  NCM: TNonClientMetrics;
{$ELSE}
  LF: TLogFont;
{$ENDIF}

initialization
  MenuBmp:= TBitmap.Create;
  {$IFDEF DFS_WIN32}
  NCM.cbSize := SizeOf(TNonClientMetrics);
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0);
  MenuBmp.Canvas.Font.Handle := CreateFontIndirect(NCM.lfMenuFont);
  {$ELSE}
  GetObject(GetStockObject(SYSTEM_FONT), SizeOf(TLogFont), @LF);
  MenuBmp.Canvas.Font.Handle := CreateFontIndirect(LF);
  {$ENDIF}

{$IFDEF DFS_WIN32}
finalization
  MenuBmp.Free;
{$ELSE}
  AddExitProc(FreeMemoryBmp);
{$ENDIF}

end.