Moin Moin ...

Um ein ShellIcon (Systemsteuerung, Netzwerk, Arbeitsplatz etc.) zu bekommen benutze ich foldende Routine:

markieren

Delphi-Quellcode:

function GetCSIDLIcon(CSIDL: integer): hIcon;
var FileInfo: TSHFileInfo; PIDL: PItemIDList; Flag: Cardinal;
begin
 SHGetSpecialFolderLocation(Application.Handle, CSIDL, PIDL);
 if Small = True then Flag := SHGFI_SMALLICON
 else Flag := SHGFI_LARGEICON;
 SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(TSHFileInfo),
 SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON or Flag);
 Result := FileInfo.hIcon;
end;

Das klappt auch sehr gut für 16x16 und 32x32 Icons. Die großen Icons, mit der Auflösung 48x48 bekommt man über diese Routine nicht. Dafür muss man die Funktion SHGetImageList anzapfen.
Genau das bereitet mir Schwierigkeiten. Einen scheinbar recht nützlichen Artikel habe ich hier ausgegraben.
Dieser ist jedoch in C# geschrieben und die Umsetzung gelingt mir nicht. Vielleicht könnte ja mal ein 'Mehrsprachiger' einen kurzen Blick darauf werfen und eine nette Delphi-Funktion daraus basteln.

Auf 'Abwegen', grüßt ...

Moin SittingDuck,

mit deinem Problem, habe ich mich noch mal befasst. Obwohl ich WinXP besitze, ist die Funktion 'SHGetImageList' nicht in meiner 'Shell32.dll' enthalten. Darum konnte ich nicht weiter testen.
Die Parameter für die Funktion kann man ja hier SHGetImageList schön nachlesen.

zusammenfalten · markieren

Delphi-Quellcode:

//so soll der Funktionsaufruf später aussehen
//DllFunc : function (iImageList : integer; riid : TIID; var ppvObj : Pointer) : hresult; stdcall;

procedure TForm1.Button1Click(Sender: TObject);
var
  hInstShell32: THandle;
  DllFunc: Pointer;
  ProcName: PChar;
begin
  hInstShell32:= LoadLibrary('Shell32.dll');
  if hInstShell32<> 0 then
  try
    DllFunc:= GetProcAddress(hInstShell32, PChar(727));
    if DllFunc= nil then
      Showmessage('Die Funktion "SHGetImageList" ist in der "Shell32.dll" NICHT vorhanden!')
    else
      Showmessage('Die Funktion "SHGetImageList" ist in der "Shell32.dll" vorhanden!')
  finally
    FreeLibrary(hInstShell32);
  end;
end;

edit: jetzt mit Index

Da hat jemand zwar den richtigen Link ins MSDN gesetzt, aber den Text selbst nicht gelesen. Die Funktion wird auch nicht per Name exportiert, sondern per Index:

Zitat:

Remarks

SHGetImageList is not exported by name from Shell32.dll. Use LoadLibrary to load Shell32.dll and GetProcAddress to access SHGetImageList at ordinal 727.

Moin Moin,

mein Code stellt jetzt ShellIcone wie Systemsteuerung, Netzwerk usw. in einer Größe von 48X48 dar. Um die ShellIcone zu bekommen, habe ich die von dir benutzte Funktion mitbenutzt. Deine Funktion fügt das Icon der ImageListe hinzu, und ich habe es, da es dann ja das letzte in der Imageliste ist, mit "commctrl.ImageList_GetIcon()" ausgelesen. Eventuell gibt es da noch eine bessere Möglichkeit.
Mein Beispiel zeigt oben das normale 32X32 Icon des Ordners "eigene Dateien" und darunter das große Symbol von 48X48.
Ich nehme mal an, dass es das ist was du erreichen wolltest.

zusammenfalten · markieren

Delphi-Quellcode:

uses ShellApi, Commctrl, ShlObj;

function GetCSIDLIcon(CSIDL: integer): hIcon;
var FileInfo: TSHFileInfo; PIDL: PItemIDList; Flag: Cardinal;
begin
  SHGetSpecialFolderLocation(Application.Handle, CSIDL, PIDL);
  Flag:= SHGFI_LARGEICON;
  SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(TSHFileInfo),
  SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON or Flag);
  Result := FileInfo.hIcon;
end;

function ImageListExtraLarge: HIMAGELIST;
type
  TSHGetImageList = function (iImageList: integer; const riid: TGUID; var ppv: Pointer): hResult; stdcall;
var
  hInstShell32: THandle;
  SHGetImageList: TSHGetImageList;
const
  //SHIL_LARGE= 0;//32X32
  //SHIL_SMALL= 1;//16X16
  SHIL_EXTRALARGE= 2;
  IID_IImageList: TGUID= '{46EB5926-582E-4017-9FDF-E8998DAA0950}';
begin
  Result:= 0;
  hInstShell32:= LoadLibrary('Shell32.dll');
  if hInstShell32<> 0 then
  try
    SHGetImageList:= GetProcAddress(hInstShell32, PChar(727));
    if Assigned(SHGetImageList) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
      SHGetImageList(SHIL_EXTRALARGE, IID_IImageList, pointer(Result));
  finally
    FreeLibrary(hInstShell32);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hIcon: TIcon;
  hImgList: HIMAGELIST;
begin
  hIcon:= TIcon.Create;
  try
    hImgList:= ImageListExtraLarge;
    hIcon.Handle:= GetCSIDLIcon(CSIDL_PERSONAL);//32X32
    self.Canvas.Draw(10, 10, hIcon);
    hIcon.Handle:= commctrl.ImageList_GetIcon(hImgList, Pred(ImageList_GetImageCount(hImgList)), 0);//48X48
    self.Canvas.Draw(10, 50, hIcon);
  finally
    hIcon.Free;
  end;
end;

EDIT: Code übersichtlicher gemacht

Moin Moin ...

Superklasse bitsetter ! Hut ab vor Deiner Leistung Deine Routine trifft mitten ins Schwarze ! Wieder ein heißer Tip für die Code-Lib ... Einem Launcher mit einer 48er Auflösung steht nun nix mehr im Wege.

Tief verneigt, grüßt ...