// Ab Windows 7 lassen sich Icons aus ICL-Dateien nicht mehr mit normalen
// Mitteln auslesen (16 Bit DLL). Deshalb hier der nachfolgende Code, für
// den Sie die Unit "UnitICL" hier downloaden müssen. Die Funktionen
// und Prozeduren dieser Unit stammen zu 98% von Jan Peter Stotz aus dem
// Jahr 1999.


// Getestet mit RS 10.4 unter W11
 

type 
  TForm1 = class(TForm) 
    OpenDialog1: TOpenDialog; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Label1: TLabel; 
    ImageList1: TImageList; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses UnitICL; 
 
 
// Anzahl der Icons in einer bestimmten Datei anzeigen 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  try 
    if not OpenDialog1.execute then 
      exit; 
    Label1.caption := 'Icon-Anzahl = ' + 
      inttostr(GetIconNumber(OpenDialog1.FileName)); 
  except 
    showmessage('FEHLER') 
  end; 
end; 
 
// Einzel-Icon ermitteln (Hier das Vierte; Zählung beginnt bei 0) 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  h: HIcon; 
begin 
  try 
    if not OpenDialog1.execute then 
      exit; 
    h := GetOneIcon(OpenDialog1.FileName, 3); 
    if h = 0 then 
      showmessage('Icon nicht gefunden') 
    else 
    begin 
      Canvas.Refresh; 
      DrawIconEx(Canvas.Handle, 50, 50, h, 32, 32, 0, 0, DI_NORMAL); // z.B. 
    end; 
  except 
    showmessage('FEHLER') 
  end; 
end; 
 
 
// Alle Icons auf Canvas anzeigen 
 
procedure TForm1.Button3Click(Sender: TObject); 
const 
  rand = 10; 
  abstand = 5; 
var 
  a, h, x, y, i, o: Integer; 
begin 
  y := rand; 
  try 
    if not OpenDialog1.execute then 
      exit; 
    a := GetAllIcons(OpenDialog1.FileName, ImageList1); 
    if a > 0 then 
    begin 
      o := 0; 
      with Canvas do 
      begin 
        for i := 0 to pred(a) do 
        begin 
          Canvas.Refresh; 
          h := GetOneIcon(OpenDialog1.FileName, i); 
          x := (i - o) * (ImageList1.Width + abstand); 
          if x + ImageList1.Width + abstand > clientwidth then 
          begin 
            inc(y, ImageList1.Height + abstand); 
            x := 0; 
            o := i; 
          end; 
          DrawIconEx(Canvas.Handle, rand + x, y, h, ImageList1.Width, 
            ImageList1.Height, 0, 0, DI_NORMAL); 
        end; 
      end; 
    end 
    else 
      showmessage('Keine Icons gefunden') 
  except 
    showmessage('FEHLER'); 
  end; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke