Icons von spicial verzeichnisen bekommen

[MathiasSimmack]

Noch einfacher? Die ganzen Shell-Funktionen sind gekapselt, so dass man sie tatsächlich nur noch aufrufen muss. Hier mal ein Beispiel: leere Form erzeugen, ListView drauf (Icon-View), Button drauf. Dann zuerst die notwendigen Wrapper:

Delphi-Quellcode:

uses
  CommCtrl, ShellAPI, ShlObj, ActiveX;

{ ... }

procedure FreeItemIDList(var pidl: pItemIDList);
var
  ppMalloc : iMalloc;
begin
  if(SHGetMalloc(ppMalloc) = S_OK) then
  try
    ppMalloc.Free(pidl);
    pidl     := nil;
  finally
    ppMalloc := nil;
  end;
end;

function SHGetIDListFromPath(const Path: string; out pidl: PItemIDList):
  boolean;
var
  ppshf        : IShellFolder;
  wpath        : array[0..MAX_PATH]of widechar;
  pchEaten,
  dwAttributes : Cardinal;
begin
  // Standardergebnis
  Result       := false;

  // IShellFolder-Handle holen
  if(SHGetDesktopFolder(ppshf) = S_OK) then
  try
    if(StringToWideChar(Path,wpath,sizeof(wpath)) <> nil) then
    begin
      // Pfadname in "PItemIdList" umwandeln
      ppshf.ParseDisplayName(0,nil,wpath,pchEaten,pidl,dwAttributes);
      Result   := pidl <> nil;
    end;
  finally
    ppshf      := nil;
  end;
end;

function SHGetIDListFromCSIDL(const wnd: HWND; const Csidl: integer;
  out pidl: PItemIDList): boolean;
begin
  Result := SHGetSpecialFolderLocation(wnd, Csidl, pidl) = S_OK;
end;

function GetShellImg(const pidl: PItemIdList; fOpen: boolean): integer;
  overload;
var
  fi        : TSHFileInfo;
  dwFlags   : dword;
begin
  Result    := -1;

  if(pidl <> nil) then
  begin
    dwFlags := SHGFI_PIDL or SHGFI_SYSICONINDEX;
    if(fOpen) then dwFlags := dwFlags or SHGFI_OPENICON;

    SHGetFileInfo(pchar(pidl),0,fi,sizeof(fi),dwFlags);
    Result  := fi.iIcon;
  end;
end;

function GetShellImg(const iDesktop: IShellFolder; pidl: PItemIdList;
  fOpen: boolean): integer; overload;
var
  isi    : IShellIcon;
  uFlags : uint;
begin
  if(iDesktop.QueryInterface(IID_IShellIcon,isi) = S_OK) then
  begin
    if(fOpen) then uFlags := GIL_OPENICON
      else uFlags := 0;

    if(isi <> nil) then
    begin
      if(isi.GetIconOf(pidl,uFlags,Result) <> NOERROR) then
        Result := GetShellImg(pidl,fOpen);

      isi  := nil;
    end;
  end
  else
    Result := GetShellImg(pidl,fOpen);
end;

Und jetzt wird dafür gesorgt, dass die ListView die Systemsymbole anzeigen kann ("FormCreate"), und dass beim Buttonklick entsprechend Symbole erscheinen:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
var
  hBigSysImages : HIMAGELIST;
  fi : TSHFileInfo;
begin
  hBigSysImages := HIMAGELIST(SHGetFileInfo('', 0, fi, sizeof(fi),
    SHGFI_SYSICONINDEX or SHGFI_ICON));
  if hBigSysImages <> 0 then
    ListView_SetImageList(ListView1.Handle, hBigSysImages, LVSIL_NORMAL);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  CsidlArray : array[0..3]of integer =
    (CSIDL_DESKTOP, CSIDL_FAVORITES, CSIDL_DRIVES, CSIDL_BITBUCKET);
var
  li   : TListItem;
  i    : integer;
  pidl : PItemIDList;
begin
  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;

  // das Beispiel nutzt die CSIDL-Konstanten (s. Array)
  for i := low(CsidlArray) to high(CsidlArray) do
    if SHGetIDListFromCSIDL(self.Handle, CsidlArray[i], pidl) then
    begin
      li            := ListView1.Items.Add;
      li.Caption    := Format('Item %d', [i]);
      li.ImageIndex := GetShellImg(pidl, false);
      FreeItemIDList(pidl);
    end;

  // das Beispiel nutzt normale Dateipfade und -namen
  if SHGetIDListFromPath
    ('H:\Dokumente und Einstellungen\Mathias\Eigene Dateien\Eigene Bilder',
    // hier hätte ich auch die CSIDL_MYPICTURES-Konstante nehmen können
     pidl) then
  begin
    li            := ListView1.Items.Add;
    li.Caption    := 'Eigene Bilder';
    li.ImageIndex := GetShellImg(pidl, false);
    FreeItemIDList(pidl);
  end;

  if SHGetIDListFromPath
    ('E:\CSharp\Help2Utilities\net2\Help2Register\Help2Register.sln',
     pidl) then
  begin
    li            := ListView1.Items.Add;
    li.Caption    := 'Solution File';
    li.ImageIndex := GetShellImg(pidl, false);
    FreeItemIDList(pidl);
  end;

  ListView1.Items.EndUpdate;
end;