DBR Delphi-Ecke

// Es wird der Icondialog zum Aussuchen eines Icons aufgerufen.
// Dabei bezeichnet "Datei" die entsprechende Datei (welche
// mindestens 1 Icon enthalten sollte) und "IconIndex" welches
// Icon bei der Anzeige markiert ist. Nach dem Klick auf OK gibt
// dann "Datei" die Datei zurück, auf die man gewechselt hat, und
// "IconIndex" den Index des gewählten Icons.

// Variante 1
// Getestet mit D4 unter XP

uses shellapi; 
 
function PickIconDlgA(OwnerWnd: HWND; lpstrFile: PAnsiChar; 
  var nMaxFile: LongInt; var lpdwIconIndex: LongInt): LongBool; stdcall; 
  external 'SHELL32.DLL' index 62; 
 
function IconDialog(H: THandle; var IconIndex: integer; var Datei: TFilename): boolean; 
var 
  nMaxF, x, lg: Integer; 
  buffer: PChar; 
begin 
  Result := false; 
  if not Fileexists(Datei) then exit; 
  nMaxF := MAX_PATH * 2; 
  buffer := AllocMem(nMaxF); 
  lg := length(Datei); 
  x := 1; 
  repeat 
    buffer[pred(x) * 2] := Datei[x]; 
    inc(x); 
  until x > lg; 
  try 
    if PickIconDlgA(H, buffer, nMaxF, IconIndex) 
      then begin 
      Datei := ''; 
      x := 0; 
      while x < nMaxF do begin 
        if (buffer[x] = #0) and (buffer[x + 1] = #0) then break; 
        Datei := Datei + buffer[x]; 
        inc(x, 2); 
      end; 
      Result := IconIndex > -1; 
    end; 
  except 
  end; 
  FreeMem(buffer); 
end; 
 
// Beispielaufrufe 
 
var 
  Datei: TFilename; 
  IconIndex: Integer; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  IconIndex := 0; 
  Datei := Application.Exename; 
  if IconDialog(Handle, IconIndex, Datei) then 
    DrawIcon(Canvas.Handle, 10, 10, 
      ExtractIcon(Hinstance, PChar(Datei), IconIndex)); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  IconIndex := 13; 
  Datei := 'C:\WINDOWS\system32\shell32.dll'; 
  if IconDialog(Handle, IconIndex, Datei) then 
    Icon.Handle := ExtractIcon(Hinstance, PChar(Datei), IconIndex); 
end;

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

// Variante 2
// Getestet mit D2010 unter W7

uses shellapi; 
 
var 
  Datei: String; 
  IconIndex: integer; 
 
function PickIconDlgA(OwnerWnd: HWND; lpstrFile: String; var nMaxFile: LongInt; 
  var lpdwIconIndex: LongInt): LongBool; stdcall; 
external 'SHELL32.DLL' index 62; 
 
function IconDialog(H: THandle; var IconIndex: integer; 
  Filename: String): boolean; 
var 
  nMaxF: integer; 
begin 
  Result := false; 
  nMaxF := Max_Path; 
  if not Fileexists(Datei) then 
    exit; 
  try 
    if PickIconDlgA(H, Filename, nMaxF, IconIndex) then 
    begin 
      Result := IconIndex > -1; 
    end; 
  except 
  end; 
end;

// Beispielaufruf
 
procedure TForm2.Button2Click(Sender: TObject); 
var 
  ic: TIcon; 
begin 
  ic := TIcon.Create; 
  IconIndex := 5; 
  Datei := 'D:\Program Files\Microsoft Office\OFFICE11\Excel.exe'; 
  if IconDialog(Handle, IconIndex, Datei) then 
    ic.Handle := ExtractIcon(Hinstance, PChar(Datei), IconIndex); 
  Form2.Icon := ic; 
  ic.Free; 
end;