recupérer une iconeRésolu

Question

Bonjour à tous et bonne année 2007


Je voudrais récupérer l'icone d'un executable et l'intégrer dans un timagelist...

Le problème c'est que l'icone est en 32X32 et que je voudrais un bmp dans mon imagelist en 16X16

Je sais récupérer l'icone et la transférer en 32X32, ce qu'il me manque
c'est la conversion du bmp de 32X32 en 16X16. Quelqu'un a une petite
idée ? merci


Simon

WhiteHippo · Accepted Answer

Bonsoir,
Petite idée, petit code :

procedure Redimensionnement( Src, Dst : TBitmap ) ;
begin
  Dst.Canvas.StretchDraw( Dst.Canvas.ClipRect, Src ) ;
end;

N.B. Ne pas oublier de fixer la taille du bitmap de destination à la taille souhaitée. Attention le code ne contient pas de vérification de l'existence ou non des bitmaps. 

Cordialement. 
<hr />"Frappe ta tête contre une calebasse... et si tu entends un son creux, ne te presse pas d'en déduire que c'est la calebasse qui est vide..."

Guillemouze · Answer

demarrer=>programmes=>accessoires=>paint
fichier=>ouvrir=>"Monfichier.bmp"
Image=>etirer/incliner
Etirement: 50% / 50%
fichier=>enregistrer

Cirec · Answer

Salut,

que de complications ... 
" Je voudrais récupérer l'icone d'un executable et l'intégrer dans un timagelist...
Le problème c'est que l'icone est en 32X32 et que je voudrais un bmp dans mon imagelist en 16X16"

Le TImageList addapte la taille des icônes automatiquement.

Si je crée deux ImageList (LargeImageList et SmallImageList) :
LargeImageList : Width & Height à 32 * 32
SmallImageList:  Width & Height à 16 * 16

J'extrais l'icône d'un executable et je l'affecte aux deux ImageList :

                LargeImageList.AddIcon(Icon);
                SmallImageList.AddIcon(Icon);

peu importe la taille initiale de l'icône ... j'obtiens, au final, les deux tailles 

donc si tu crées ton ImageList avec Width & Heigth à 16 * 16 tu n'as absolument rien à faire 

 
@+
Cirec

<hr size="2" />

sp40 · Answer

Hélas, Cirec... 
Quand je récupère un bitmap en 32 (car mon icone est en 32 et provient
de mon exécutable via "ExtractIcon" et "DrawIcon") que je place dans
une TImageList en 16, l'imagelist intègre bien les images mais chaque
image est découpée en 4 !!!   Je n'ai pas trouvé comment dire
à l'imagelist qu'elle doit "strecher" l'image plutot que de la découper
en 4... (Désolé mais j'ai pas encore testé le code de WhiteHippo)

Simon

cincap · Answer

Bonjour,

Essaye un peu ceci :

var
  Form1: TForm1;
  HIconLarge:Hicon;
  HIconSmall:Hicon;
  nIcons:Integer;

implementation


{$R *.DFM}

procedure TForm1.ButtonChoixFichierClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    nIcons:=ExtractIconEx( Pchar(OpenDialog1.FileName),-1,HIconLarge,HIconSmall,0);
    Label2.Caption:=IntToStr(nIcons);
    ButtonAfichageIconeClick(Sender);
  end;
end;


procedure TForm1.ButtonAfichageIconeClick(Sender: TObject);
Var
  ValeurDeRetour:integer;


begin
  ValeurDeRetour:=ExtractIconEx( Pchar(OpenDialog1.FileName),SpinEdit1.Value,HIconLarge,HIconSmall,1);
  LabelValeurDeRetour.Caption:=IntToStr(ValeurDeRetour);
  image1.Picture.Icon.ReleaseHandle; //libére les ressources allouées pour représenter l'icône
  image1.Picture.Icon.Handle:=HIconLarge;     //l'icône conenu dans picture devient l'icône désigné par le Handle H
                                     //Un Handle sert à windows pour référencer les ressources


  image2.Picture.Icon.ReleaseHandle;
  image2.Picture.Icon.Handle:=HIconSmall;
  image2.Picture.Icon.Palette


 end;

Cela pourra peut être t'aider.

@+,

Cincap
[url]mailto:/url

cincap · Answer

Bonjour,

Une autre approche de ta demande qui confirme la suggestion de l'ami CIREC. 

En utilisant 2 TimageList, un TFileListBox, un TDirectoryListBox, un TDriveComboBox et 2 Timage.

Code :

uses
   ShellApi

var
   MainForm: TMainForm;


 implementation


 {$R *.dfm}




function GetIconIndex(Extension: String; Attribus: DWORD; var TypeFichier :string):Integer;
var SHFileInfo: TSHFileInfo;
  begin
   if Extension[1] <> '.' then Extension := '.' + Extension;
   
   SHGetFileInfo(PChar(Extension), Attribus, SHFileInfo, SizeOf(TSHFileInfo),
                 SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or SHGFI_TYPENAME);


   TypeFichier := SHFileInfo.szTypeName;
   Result := SHFileInfo.iIcon;
  end;
  


procedure TMainForm.FormCreate(Sender: TObject);
 var SHFileInfo :TSHFileINfo;
  begin
Ico_Big.Handle := SHGetFileInfo('', 0, SHFileInfo, SizeOF(SHFileInfo), SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
Ico_Small.Handle := SHGetFileInfo('', 0, SHFileInfo, SizeOF(SHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  end;


procedure TMainForm.Button1Click(Sender: TObject);
 var TypeFichier :string;
  begin
   Ico_Big.GetIcon(GetIconIndex(FileListBox1.filename,0,TypeFichier),Image1.Picture.Icon.Create);
   
Ico_Small.GetIcon(GetIconIndex(FileListBox1.filename,0,TypeFichier),Image2.Picture.Icon.Create);
   Label1.Caption := TypeFichier;
end;


procedure TMainForm.FileListBox1Change(Sender: TObject);
begin
//Button1Click(Sender);
end;


procedure TMainForm.FileListBox1Click(Sender: TObject);
begin
Button1Click(Sender);
end;


procedure TMainForm.DirectoryListBox1Click(Sender: TObject);
begin
Directorylistbox1.Opencurrent;
Filelistbox1.setfocus;
end;


end.

@+,

Cincap

[url]mailto:/url

Guillemouze · Answer

@cincap: quel est l'interet de ta methode par rapport a celle de WhiteHippo (qui tient en une ligne) ?

Cirec · Answer

Salut,
@ Guillemouze :
elle est tout aussi courte que celle de WhiteHippo, et même plus,  c'est juste qu'il a donné un exemple complet avec DirListBox & FileListBox etc ... et que WhiteHippo ne te donne pas le code pour mettre l'icône dans l'ImageList.

Sinon la méthode utilisé par Cincap (la dernièrre) est encore plus rapide que celle de WhiteHippo puisque l'on arrive au même résultat sans retravailler l'image.

Il suffisait de lire le code pour comprendre cela ...

@ SimonPelloquin : si ton image est divisée en quatre c'est que tu fais un truc que tu ne devrais pas faire.

ImgList : TImageList;

ImgList := TImageList.Create(Self);
ImgList.Width := 16;
ImgList.Height := 16;

...
ImgList.AddIcon(Icon);

Voilà je ne fait rien d'autre et mes icônes s'adapte automatiquement 

Il n'y a pas plus court 
 
@+
Cirec

<hr size="2" />

Guillemouze · Answer

@cirec : ouais, j'ai pas eu le courage de lire le code.

@tout le monde : je pense qu'il est souhaitable, quand on met un code complet comme whitehippo, de mettre en avant la partie importante du code (gras, couleur, ...).
Voila, c'etait juste une petite revendication

cincap · Answer

Rebonjour à tous,

Le 1er code suggéré n'utilisait que 2 composants Timage au lieu et place de 2 TImageList et un spinedit qui permet de voir combien d'icones se trouvent dans le fichier *.exe ou *.dll

L'exemple complet permet aussi de sauvegarder l'icone en bitmap.

unit Main_Form;



 interface



 uses
   ShellApi,
   Windows, SysUtils, Classes, Controls, Forms, StdCtrls, Graphics,
   ExtCtrls, FileCtrl, Spin, Dialogs, ExtDlgs ;



 type
   TMainForm =  class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Label2: TLabel;
    Label3: TLabel;
    SpinEdit1: TSpinEdit;
    Label4: TLabel;
    Button2: TButton;
    SavePictureDialog1: TSavePictureDialog;
    Label5: TLabel;

    procedure Button1Click(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure DirectoryListBox1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);



   private
   public
   end;



 var
   MainForm: TMainForm;



 HIconLarge:Hicon;
 HIconSmall:Hicon;
 nIcons:Integer;



  implementation 



 {$R *.dfm}



procedure TMainForm.Button1Click(Sender: TObject);
 var
 TypeFichier :string;
 VDR:integer;



 begin



  VDR: =ExtractIconEx( Pchar(FileListBox1.FileName),SpinEdit1.Value,HIconLarge,HIconSmall,1);
  nIcons:= ExtractIconEx( Pchar(FileListBox1.FileName),-1,HIconLarge,HIconSmall,0);
  Label4.Caption:=IntToStr(nIcons);



  image1.Picture.Icon.ReleaseHandle; //height 32 width 32
  image1.Picture.Icon.Handle:=HIconLarge;



  image2.Picture.Icon.ReleaseHandle; //height 16 width 16
  image2.Picture.Icon.Handle:=HIconSmall;
  image2.Picture.Icon.Palette ;



 end; 





procedure TMainForm.FileListBox1Click(Sender: TObject);
begin
Button1Click(Sender);
end;



procedure TMainForm.DirectoryListBox1Click(Sender: TObject);
begin
Directorylistbox1.Opencurrent;
Filelistbox1.setfocus;
end;



procedure TMainForm.SpinEdit1Change(Sender: TObject);
Var
  VDR:integer;



begin
  VDR: =ExtractIconEx( Pchar(FileListBox1.FileName),SpinEdit1.Value,HIconLarge,HIconSmall,1);
  
  image1.Picture.Icon.ReleaseHandle;
  image1.Picture.Icon.Handle:= HIconLarge;     



  image2.Picture.Icon.ReleaseHandle;
  image2.Picture.Icon.Handle:=HIconSmall;
  image2.Picture.Icon.Palette



 end; 



procedure TMainForm.Button2Click(Sender: TObject);
var BTemp:TBitmap;
begin
//Pour format 32 x 32
 if SavePictureDialog1.Execute then
 begin
 BTemp : =TBitmap.Create;
  BTemp.PixelFormat := pf24bit;
  BTemp.TransparentColor := clblack;
  BTemp.Width := Image1.Picture.Width;
  BTemp.Height := Image1.Picture.Height;
  BTemp.Canvas.Draw(0,0,image1.Picture.Graphic);
  BTemp.SaveToFile(SavePictureDialog1.FileName);
  BTemp.free;
 end;
end;
end.

@+,

Cincap

[url]mailto:/url

Recupérer une icone

10 réponses

Votre réponse

Discussions similaires