Icons aus Shell32.dll

[Christian Seehase]

Moin Tpercon,

ich hab' hier mal eine etwas umfangreichere Lösung:

Code:

unit MAIN;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ImgList, ComCtrls, ExtCtrls,filectrl;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    MainMenu1: TMainMenu;
    ffnen1: TMenuItem;
    ImageList1: TImageList;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListView1: TListView;
    TabSheet2: TTabSheet;
    ImageList2: TImageList;
    ListView2: TListView;
    procedure ffnen1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FSaveAsIcon : Boolean;
  public
    { Public-Deklarationen }
    property SaveAsIcon : Boolean read FSaveAsIcon write FSaveAsIcon;
  end;

var
  Form1: TForm1;

type
  PHICON = ^HICON;

  TcsExtractIconEx = function(
    const lpszFile    : PChar;
    const nIconIndex  : integer;
    const phiconLarge : PHICON;
    const phiconSmall : PHICON;
    const nIcons      : DWORD
    ) : DWORD; stdcall;

var
  ExtractIconEx : TcsExtractIconEx;

implementation

{$R *.DFM}

var
  hDLL : DWORD;


procedure TForm1.ffnen1Click(Sender: TObject);

var
  pLarge  : PHICON;
  pSmall  : PHICON;
  pWork   : PHICON;
  icoWork : TIcon;
  dwCount : DWord;
  i       : integer;

begin
  if OpenDialog1.Execute then
  begin
    Caption := '['+OpenDialog1.FileName+']';
    ImageList1.Clear;
    ImageList2.Clear;
    ImageList1.Width  := GetSystemMetrics(SM_CXSMICON);
    ImageList1.Height := GetSystemMetrics(SM_CYSMICON);
    ImageList2.Width  := GetSystemMetrics(SM_CXICON);
    ImageList2.Height := GetSystemMetrics(SM_CYICON);
    ListView1.Items.Clear;
    ListView2.Items.Clear;
    ListView1.Items.BeginUpdate;
    ListView2.Items.BeginUpdate;
    try
      dwCount := ExtractIconEx(PChar(OpenDialog1.FileName),-1,nil,nil,0);
      pLarge  := AllocMem(dwCount*SizeOf(HICON));
      pSmall  := AllocMem(dwCount*SizeOf(HICON));
      icoWork := TIcon.Create;
      try
        ExtractIconEx(PChar(OpenDialog1.FileName),0,pLarge,pSmall,dwCount);
        pWork := pSmall;
        for i := 0 to dwCount-1 do
        begin
          icoWork.Handle := pWork^;
          ImageList1.AddIcon(icoWork);
          ListView1.Items.Add;
          ListView1.Items[ListView1.Items.Count-1].ImageIndex := ImageList1.Count-1;
          ListView1.Items[ListView1.Items.Count-1].Caption := IntToStr(ImageList1.Count-1);
          inc(pWork);
        end;
        pWork := pLarge;
        for i := 0 to dwCount-1 do
        begin
          icoWork.Handle := pWork^;
          ImageList2.AddIcon(icoWork);
          ListView2.Items.Add;
          ListView2.Items[ListView2.Items.Count-1].ImageIndex := ImageList2.Count-1;
          ListView2.Items[ListView2.Items.Count-1].Caption := IntToStr(ImageList2.Count-1+ImageList1.Count);
          inc(pWork);
        end;
      finally
        FreeAndNil(icoWork);
        FreeMem(pLarge,dwCount*SizeOf(HICON));
        FreeMem(pSmall,dwCount*SizeOf(HICON));
      end;
    finally
      ListView1.Items.EndUpdate;
      ListView2.Items.EndUpdate;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.ActivePage := TabSheet1;
end;

initialization
begin
  hDLL := LoadLibrary('shell32.dll');
  if hDLL = 0 then
  begin
    ShowMessage('Laden von SHELL32.DLL fehlgeschlagen');
    exit;
  end;
  @ExtractIconEx := GetProcAddress(hDLL,'ExtractIconEx');
  if @ExtractIconEx = nil then
  begin
    ShowMessage('ExtractIconEx');
    exit;
  end;
end;

finalization
begin
  if hDLL <> 0 then
  begin
    FreeLibrary(hDLL);
  end;
end;
end.

Welche Kompos Du brauchst ergibt sich wohl aus der Deklaration von TForm1.
Delphi hat zwar eine Implementation von ExtractIconEx, die ist aber leider Fehlerhaft, so dass ein eigener Import notwendig wird.
Mit diesem Code bekommst Du alle Icon's im OpenDialog (Filter auf EXE und DLL) angegebenen Datei angezeigt.
Die ListViews müssen auf ViewStyle vsICON eingestellt sein.

Das ist nur ein Fragment