// In einem modernen Windows-Icon befinden sich oft mehrere Icons in den
// verschiedensten Größen. Wenn man so ein Icon in ein Image lädt, wird es
// aber mit seiner Standardgröße geladen (meist 32x32). Mit dem folgenden
// Code kann man auch größere (bzw. kleinere) Icons zur Laufzeit aus einer
// Datei in ein TImage laden. Wenn sich ein so genanntes XP-Icon in der
// vorgegebenen Größe in dieser Datei befindet, wird es bevorzugt geladen.
// Wenn nicht, dann lädt der Code ein einfaches Icon der entsprechenden Größe.
// Ist das auch nicht vorhanden, dann wird ein anderes Icon gestreckt
// dargestellt. Die Variable Schatten legt bei einem XP-Icon die Farbe des
// (alpha)Schattenrandes fest. Man kann sie auch auf die Hintergrundfarbe
// setzen, dann fällt der Schatten bei gleichfarbigem Untergrund nicht auf. Bei
// nicht-XP-Icons sollte die die Schattenfarbe nicht innerhalb des Iconsbildes
// vorkommen, da es sonst zu "Löchern" kommen kann, falls Transparent=True ist.


// Variante 1: Ein Icon aus einer *.ico Datei laden

 
function LoadBigIco(const Datei: string; Image: TImage; 
  cx, cy: Integer; Schatten: TColor; Transparent: Boolean): Boolean; 
var 
  h: HIcon; 
  hb: HBrush; 
begin 
  Result := false; 
  Schatten := ColorToRGB(Schatten); 
  hb := CreateSolidBrush(Schatten); 
  h := LoadImage(0, pchar(Datei), IMAGE_ICON, cx, cy, LR_LOADFROMFILE); 
  if h <> 0 then begin 
    Image.Autosize := true; 
    Image.Transparent := Transparent; 
    with Image.picture.bitmap do begin 
      TransparentColor := Schatten; 
      with canvas do begin 
        width := cx; 
        height := cy; 
        brush.color := Schatten; 
        Fillrect(Cliprect); 
        DrawIconEx(handle, 0, 0, h, cx, cy, 0, hb, DI_NORMAL); 
      end; 
    end; 
    DeleteObject(hb); 
    DestroyIcon(h); 
    Result := true; 
  end; 
end; 


// Beispielaufruf

procedure TForm1.Button3Click(Sender: TObject); 
begin 
  if not 
    LoadBigIco('D:\Icons\test.ico', Image2, 48, 48, clBtnFace, true) 
    then showmessage('Icon nicht gefunden!'); 
end;


//----------------------------------------------------------------------------

// Variante 2: Ein Icon aus *.dll, *.ocx, *.tsp, *.rll, *.exe Datei laden. Dabei
               beginnt die Zählung der Icons bei Eins. Das bedeutet, dass man
               mit idx=29 auch das 29. Icon aus der Datei holt (falls überhaupt
               soviel drin sind). Ansonsten muss man die Namen der Icons kennen
               oder ermitteln und die Icons darüber aufrufen. Falls Icons mit
               16 Farben und gleichgroße mit mehr als 16 Farben vorhanden sind,
               kann man mit der Variablen "Art" vom Typ "anzeige" auswählen,
               welche man sehen will.
 

type 
  anzeige = (lrDefault, lrVGA); 
 
function LBIFL(lib: THandle; idx: pchar; Image: TImage; Art: anzeige; 
  cx, cy: Integer; Schatten: TColor; Transparent: Boolean): Boolean; 
var 
  h: HIcon; 
  hb: HBrush; 
begin 
  Result := false; 
  Schatten := colortorgb(Schatten); 
  hb := createsolidbrush(Schatten); 
  h := loadimage(lib, idx, IMAGE_ICON, cx, cy, ord(Art) * 128); 
  if h <> 0 then begin 
    Image.Autosize := true; 
    Image.Transparent := Transparent; 
    with Image.picture.bitmap do begin 
      TransparentColor := Schatten; 
      with canvas do begin 
        width := cx; 
        height := cy; 
        brush.color := Schatten; 
        fillrect(cliprect); 
        drawiconex(handle, 0, 0, h, cx, cy, 0, hb, DI_NORMAL); 
      end; 
    end; 
    deleteobject(hb); 
    destroyicon(h); 
    Result := true; 
  end; 
end; 
 
function Proc(modul: THandle; rtype, rname: PChar; 
  Liste: TStrings): Integer; stdcall; 
begin 
  if HiWord(ULong(rname)) <> 0 then Liste.Add(rname) 
  else Liste.Add(Format('#%d', [Word(rname)])); 
  Result := 1; 
end; 
 
function LoadBigIcoFromLib(const Datei: string; idx: PChar; Image: TImage; 
  cx, cy: Integer; Schatten: TColor; Art: anzeige; Transparent: Boolean): Boolean; 
var 
  sl: Tstringlist; 
  lib: THandle; 
  id: Word; 
begin 
  result := false; 
  try 
    id := strtointdef(idx, maxword); 
  except 
    exit; 
  end; 
  sl := TStringlist.create; 
  lib := LoadLibraryEx(PChar(Datei), 0, LOAD_LIBRARY_AS_DATAFILE); 
  if lib <> 0 then begin 
    EnumResourceNames(lib, RT_GROUP_ICON, @Proc, Integer(sl)); 
    if (id > 0) and (id <= sl.count) or (id = maxword) then begin 
      if id < maxword then idx := pchar(sl[pred(id)]); 
      result := LBIFL(lib, idx, Image, Art, cx, cy, Schatten, Transparent); 
    end; 
    FreeLibrary(lib); 
  end; 
  sl.free; 
end; 
 
 
// Beispielaufruf mittels Index (Stellung des Icons innerhalb der Datei) 
 
procedure TForm1.Button3Click(Sender: TObject); 
var 
  idx: word; 
begin 
  idx := 60; 
  if not LoadBigIcoFromLib('c:\windows\system32\shell32.dll', 
    PChar(IntToStr(idx)), Image1, 48, 48, clBtnFace, lrVGA, false) 
    then showmessage('Icon konnte nicht geladen werden!'); 
end; 
 
 
// Zwei Beispielaufrufe mittels Name (bei Zahlen # vorangesetzt) 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
if not LoadBigIcoFromLib('c:\windows\system32\shell32.dll', 
    PChar('#139'), Image1, 48, 48, clBtnFace, lrDefault, false) 
    then showmessage('Icon konnte nicht geladen werden!'); 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  if not LoadBigIcoFromLib('c:\windows\system32\hhctrl.ocx', 
    PChar('ICONCDROM'), Image1, 32, 32, clBtnFace, lrDefault, false) 
    then showmessage('Icon konnte nicht geladen werden!'); 
end; 

// Falls man die Namen der Icons in der Datei nicht kennt, kann man sie
// mit dem folgenden Code herausfinden. Die Namen werden in einem Memo
// aufgelistet, und bei Doppelklick auf eine Zeile des Memos, im Image angezeigt.

var 
  Datei: string = 'c:\windows\system32\shell32.dll'; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  lib: THandle; 
begin 
  Memo1.clear; 
  Memo1.scrollbars := ssVertical; 
  lib := LoadLibraryEx(PChar(Datei), 0, LOAD_LIBRARY_AS_DATAFILE); 
  if lib <> 0 then begin 
    Memo1.Lines.BeginUpdate; 
    EnumResourceNames(lib, RT_GROUP_ICON, @Proc, Integer(Memo1.Lines)); 
    Memo1.Lines.EndUpdate; 
    FreeLibrary(lib); 
  end; 
end; 
 
procedure TForm1.Memo1DblClick(Sender: TObject); 
var 
  p: TPoint; 
  s: string; 
begin 
  p := Memo1.CaretPos; 
  s := Trim(Memo1.lines[p.y]); 
  if not LoadBigIcoFromLib(Datei, 
    PChar(s), Image1, 48, 48, clBtnFace, lrDefault, true) 
    then showmessage('Icon konnte nicht geladen werden!'); 
end;