AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Icons von spicial verzeichnisen bekommen

Ein Thema von mimi · begonnen am 18. Aug 2006 · letzter Beitrag vom 19. Aug 2006
 
MathiasSimmack
(Gast)

n/a Beiträge
 
#6

Re: Icons von spicial verzeichnisen bekommen

  Alt 19. Aug 2006, 08:07
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;
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:13 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz