AFFICHEUR D'ICÔNES

unit UExtractIcon;

interface

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

type
  TForm1 = class(TForm)
    btnLoadIcon: TButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    UpDown1: TUpDown;
    Label1: TLabel;
    Label2: TLabel;
    chbxSmall_Ico: TCheckBox;
    procedure btnLoadIconClick(Sender: TObject);
    procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
    procedure chbxSmall_IcoClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1             : TForm1;

implementation

{$R *.DFM}
uses
  ShellApi;

var
  phIconLarge       : HIcon = 0;
  phIconSmall       : HIcon = 0;
  Uicon             : Hicon;
  NbrIcons          : Longint = 0;
  Change            : boolean = True;

procedure TForm1.btnLoadIconClick(Sender: TObject);
const
  sContient         = 'Fichier : %s - Icônes : %d';
  CrLf              = #13#10;
begin
  if OpenDialog1.Execute then
    if FileExists(OpenDialog1.FileName) then
      begin
        //Effacer l'image actuelle
        Image1.Picture := nil;
        {Contrairement à ce qui est écrit dans l'aide
        de Delphi, on ne peut pas passer -1 comme valeur dans le
        dernier paramètre de la fonction ExtractIcon puisque ce
        paramètre est déclaré de type Cardinal !
        NbrIcons := ExtractIconEx(Handle, PChar(OpenDialog1.FileName), -1);
        Delphi refuse donc de compiler. Deux solutions : modifier le code
        source fourni avec Delphi ou bien trouver une solution plus élégante ?

        La deuxième solution est retenue car tout le monde n'a pas les codes
        sources de l'unité ShellApi. Nous utilisons donc la fonction
        ExtractIconEx qui nous permet de récupérer les petites comme les
        grandes icones. Avouez que nous n'avons rien perdu au change !}
        NbrIcons := ExtractIconEx(PChar(OpenDialog1.FileName),
          -1,
          phIconLarge,
          phIconSmall,
          MaxInt);
        //N'autoriser une action sur le contrôle UpDown1
        //que s'il y a au moins une icône dans le fichier
        UpDown1.Enabled := NbrIcons > 0;

        case NbrIcons of
          0: ShowMessage('Ce fichier ne contient aucune icône.');
          else
            with UpDown1 do
              begin
              //Le tableau d'icônes est indexé de 0..(n-1)
                Max := NbrIcons - 1;
              //Positionner sur le première
                Position := 0;

                Label1.Caption := Format(sContient,
                  [ExtractFileName(OpenDialog1.FileName),
                  NbrIcons]);
              //Simuler un clic sur le UpDown1
                UpDown1Changing(self, Change);
              end;
        end;
      end;
end;

procedure TForm1.UpDown1Changing(Sender: TObject;
  var AllowChange: Boolean);
const
  IcoPosition       = 'Icone %d/%d';
begin
  //Récupérer le handle selon propriété Position du contrôle UpDown
  UIcon := ExtractIconEx(pchar(OpenDialog1.FileName),
    UpDown1.Position,
    phIconLarge,
    phIconSmall,
    1);
  with Image1.Picture.Icon do
    case chbxSmall_Ico.Checked of
      False: //Affichage de la grande icône
        Handle := phIconLarge;
      True: //Affichage de la grande icône
        Handle := phIconSmall;
    end;

  //Informer sur la position dans le tableau des icônes
  Label2.Caption := Format(IcoPosition, [UpDown1.Position + 1, NbrIcons]);
end;

procedure TForm1.chbxSmall_IcoClick(Sender: TObject);
begin
  //Réactualiser affichage icône
  UpDown1Changing(nil, Change);
end;

end.