Un petit bug dans Delphi empêche d'utiliser correctement la fonction ExtractIcon. Cet exemple démontre l'utilisation, à la place, de la fonction ExtractIconEx et comment récupérer les grandes comme les petites icônes.
Source / Exemple :
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.
Conclusion :
Ecrit avec Delphi 4 pour permettre au maximum de personnes de profiter de ce code.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.