Сортировка хлебных крошек в Delphi: подход для различения типов файлов и папок

Delphi , Базы данных , Сортировка и Фильтр

В процессе разработки хлебных крошек в Delphi пользователь столкнулся с трудностями при сортировке выпадающего списка. Несмотря на то, что Windows Vista не демонстрирует последовательное поведение при отображении элементов, пользователь хочет добиться такого же результата, как при нажатии на ту же самую хлебную крошку в Проводнике Windows.

Пользователь пытался различать системные папки, обычные папки и архивные файлы (zip), но пока не нашел подходящего решения. Один из подходов заключается в использовании TypeDisplayName из TSHFileinfo, но он не гарантирует правильного порядка в каждом языке.

В приведенном коде пользователь заполняет меню, но не может добиться правильной сортировки элементов. Keith Giddings предложил решение, в котором создается список PIDL для сортировки, а затем используется метод CompareIDs для сравнения PIDL и получения правильного порядка элементов.

Подтвержденный ответ заключается в том, чтобы использовать метод CompareIDs для сортировки элементов в том же порядке, что и в Проводнике Windows, независимо от версии Windows и языка пользовательского интерфейса. При этом может потребоваться добавить SmallInt перед результатом из IShellFolder.CompareIDs.

Пример кода на Object Pascal (Delphi) для сортировки элементов хлебных крошек:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, SHDocVw, OleCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    IShellFolder: IShellFolder;
    DesktopShellFolder: IShellFolder;
    function GetDisplayName(IShellFolder: IShellFolder; PIDL: Pointer; Flags: Longint): string;
    function GetPIDLNameForAddressBar(IShellFolder: IShellFolder; PIDL: Pointer): string;
    function ConcatPIDLs(PIDL1, PIDL2: Pointer): Pointer;
    function IsDesktop(PIDL: Pointer): Boolean;
    function GetAttr(Attributes: Longint): string;
    function ComparePIDLs(Item1, Item2: Pointer): Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetDisplayName(IShellFolder: IShellFolder; PIDL: Pointer; Flags: Longint): string;
var
  DisplayName: string;
begin
  SetLength(DisplayName, 255);
  IShellFolder.GetDisplayNameOf(PIDL, Flags, DisplayName[1]);
  Result := DisplayName;
end;

function TForm1.GetPIDLNameForAddressBar(IShellFolder: IShellFolder; PIDL: Pointer): string;
var
  DisplayName: string;
begin
  SetLength(DisplayName, 255);
  IShellFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, DisplayName[1]);
  Result := DisplayName;
end;

function TForm1.ConcatPIDLs(PIDL1, PIDL2: Pointer): Pointer;
var
  PIDL1Size, PIDL2Size, TotalSize: Longint;
  PIDL: Pointer;
begin
  PIDL1Size := OleGetMemSize(PIDL1);
  PIDL2Size := OleGetMemSize(PIDL2);
  TotalSize := PIDL1Size + PIDL2Size + SizeOf(Longint);
  GetMem(PIDL, TotalSize);
  with PIDL^ do
  begin
    lData := PIDL1;
    lData[PIDL1Size div SizeOf(Longint)] := PIDL2;
  end;
  Result := PIDL;
end;

function TForm1.IsDesktop(PIDL: Pointer): Boolean;
var
  DesktopPIDL: Pointer;
begin
  OleCheck(SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, DesktopPIDL));
  Result := CompareIDs(0, DesktopPIDL, PIDL) = 0;
  CoTaskMemFree(DesktopPIDL);
end;

function TForm1.GetAttr(Attributes: Longint): string;
begin
  if Attributes and SFGAO_FOLDER then
    Result := 'Папка'
  else if Attributes and SFGAO_FILESYSTEM then
    Result := 'Файловая система'
  else if Attributes and SFGAO_FILESYSANCESTOR then
    Result := 'Предок файловой системы'
  else if Attributes and SFGAO_FILECONTENT then
    Result := 'Содержимое файла'
  else if Attributes and SFGAO_FOLDER then
    Result := 'Папка'
  else if Attributes and SFGAO_SYSTEM then
    Result := 'Системный'
  else if Attributes and SFGAO_HIDDEN then
    Result := 'Скрытый'
  else if Attributes and SFGAO_DISPLAYATTRMASK then
    Result := 'Маска атрибутов отображения'
  else if Attributes and SFGAO_HASSUBFOLDER then
    Result := 'Есть подпапка'
  else if Attributes and SFGAO_HASPROPSHEET then
    Result := 'Есть свойства'
  else if Attributes and SFGAO_DRIVE then
    Result := 'Диск'
  else if Attributes and SFGAO_REMOVABLE then
    Result := 'Удаляемый'
  else if Attributes and SFGAO_COMPRESSED then
    Result := 'Сжатый'
  else if Attributes and SFGAO_BROWSABLE then
    Result := 'Обозреваемый'
  else if Attributes and SFGAO_NONENUMERATED then
    Result := 'Не перечисляемый'
  else if Attributes and SFGAO_NEWCONTENT then
    Result := 'Новое содержимое'
  else if Attributes and SFGAO_HASINITIALCONTENTS then
    Result := 'Есть начальное содержимое'
  else if Attributes and SFGAO-content then
    Result := 'Содержимое'
  else if Attributes and SFGAO_PROPERTYSTORE then
    Result := 'Хранилище свойств'
  else if Attributes and SFGAO_DROPTARGET then
    Result := 'Целевой объект для перетаскивания'
  else if Attributes and SFGAO_CAPABILITYMASK then
    Result := 'Маска возможностей'
  else if Attributes and SFGAO_MONIKO then
    Result := 'Монико'
  else
    Result := '';
end;

function TForm1.ComparePIDLs(Item1, Item2: Pointer): Integer;
begin
  Result := SmallInt(IShellFolder.CompareIDs(0, Item1, Item2));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  CurPidl, NewPidl: Pointer;
  CurFolder: IShellFolder;
  Fetched: Boolean;
  SFI: TSHFileInfo;
  FName, Text: string;
  PidlList: TList;
  i: Integer;
begin
  OleCheck(CoCreateInstance(CLSID_ShellFolder, nil, CLSCTX_INPROC_SERVER, IID_IShellFolder, Pointer(IShellFolder)));
  OleCheck(CoCreateInstance(CLSID_ShellFolder, nil, CLSCTX_INPROC_SERVER, IID_IShellFolder, Pointer(DesktopShellFolder)));

  PidlList := TList.Create;
  // Add PIDLs for sorting
  if IsDesktop(nil) then
    OleCheck(SHGetDesktopFolder(CurFolder))
  else
    OleCheck(DesktopShellFolder.BindToObject(nil, nil, IID_IShellFolder, Pointer(CurFolder)));
  if CurFolder.EnumObjects(0, SHCONTF_FOLDERS, IShellFolder.EnumObjects) = NOERROR then
    while IShellFolder.EnumObjects.Next(1, CurPidl, Fetched) = S_OK do
      PidlList.Add(CurPidl);
  // Sort it ...
  PidlList.Sort(ComparePIDLs);
  // Get display name and icon for item
  for i := 0 to PidlList.Count - 1 do
  begin
    CurPidl := PidlList[i];
    FName := GetDisplayName(CurFolder, CurPidl, SHGDN_NORMAL);
    Text := GetPIDLNameForAddressBar(CurFolder, CurPidl);
    if IsDesktop(nil) then
      Text := PSpecialFolderItem(SpecialFolders[0]).Name + '\' + Text;
    if Text[Length(Text)] <> '\' then
      Text := Text + '\';
    NewPidl := ConcatPIDLs(nil, CurPidl);
    SHGetFileInfo(PChar(NewPidl), 0, SFI, SizeOf(SFI), SHGFI_ATTRIBUTES or SHGFI_PIDL or
      SHGFI_SYSICONINDEX or SHGFI_TYPENAME);
    // Add menu item with sorted order
    AddMenuItem(Text, FName, SFI.iIcon);
    CoTaskMemFree(NewPidl);
  end;
  CoTaskMemFree(nil);
  for i := PidlList.Count - 1 downto 0 do
  begin
    CoTaskMemFree(PidlList[i]);
    PidlList.Delete(i);
  end;
  // We are done free it
  PidlList.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  IShellFolder := nil;
  DesktopShellFolder := nil;
end;

end.

Создано по материалам из источника по ссылке.

Пользователь разрабатывает хлебные крошки в Delphi и столкнулся с трудностями при сортировке выпадающего списка, желая добиться такого же результата, как в Проводнике Windows. ```

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Сортировка и Фильтр ::