BMP -> Icônes 32 bits

Signaler
Messages postés
207
Date d'inscription
mercredi 5 mars 2003
Statut
Membre
Dernière intervention
29 mars 2013
-
Messages postés
5
Date d'inscription
mardi 28 février 2006
Statut
Membre
Dernière intervention
18 août 2011
-
Bonjour, je sais convertir un fichier BMP en ICO mais mon code ne conserve pas les vraies couleurs, quelqu'un sait-il comment faire ?

SISI231

8 réponses

Messages postés
131
Date d'inscription
lundi 20 novembre 2006
Statut
Membre
Dernière intervention
11 octobre 2010

Comment tu as fait pour convertir l'image??
essai avec paint   , ouvre ton image bmp avec paint et puis fait enregistrer sous ensuite change le format de l'enregistrement (*.ico) et le tour est joué
Messages postés
207
Date d'inscription
mercredi 5 mars 2003
Statut
Membre
Dernière intervention
29 mars 2013
5
Pour convertir mon bitmap j'ai utilisé la fonction suivante :

function BitmapToIcon(Bitmap: TBitmap): TIcon;
var



  IconInfo: TIconInfo;
  IconBitmap, MaskBitmap: TBitmap;
  x, y: Integer;
  TransparentColor: TColor;
begin



  IconBitmap:= TBitmap.Create;
  IconBitmap.Width:= bitmap.width;
  IconBitmap.Height:= bitmap.height;
  IconBitmap.Canvas.StretchDraw(Rect(0, 0, IconBitmap.Width,
   IconBitmap.Height), Bitmap);
  IconBitmap.TransparentColor:= Bitmap.TransparentColor;
  TransparentColor:= IconBitmap.TransparentColor and $FFFFFF;
  MaskBitmap:= TBitmap.Create;
  MaskBitmap.Assign(IconBitmap);
  for y:= 0 to IconBitmap.Height - 1 do
    for x:= 0 to IconBitmap.Width - 1 do
      if IconBitmap.Canvas.Pixels[x, y] = TransparentColor then
        IconBitmap.Canvas.Pixels[x, y]:= clBlack;
  IconInfo.fIcon:= True;
  IconInfo.hbmMask:= MaskBitmap.MaskHandle;
  IconInfo.hbmColor:= IconBitmap.Handle;
  Result:= TIcon.Create;
  Result.Handle:= CreateIconIndirect(IconInfo);
  MaskBitmap.Free;
  IconBitmap.Free;
end;


Je sais le faire avec Paint mais je veux pouvoir le faire en Delphi pour pouvoir l'utiliser avec Delphi.
SISI231
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
Salut,

J'ai testé : ce code  restitue correctement les couleurs.

Mais il est bizarrement arrangé. En particulier, le TIcon créé (Result) n'est jamais libéré.
A mon avis, il vaudrait mieux le reconstruire sous forme de procedure :

procedure BitmapToIcon(const BmpFileName, IcoFileName: string);

N'aurais-tu pas plutôt un problème avec le pixel qui détermine la couleur transparente (c'est celui qui est situé en bas à gauche de l'image) ?

A +
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
Où l'as-tu trouvé, ce code ?

J'ai bien envie de le refaire (en l'état il n'est pas très propre, avec un TBitmap inutile, etc...) et de le mettre à disposition de tous sous forme de snippet.
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
Ouais, en fait ce code traîne un peu partout sur le net (merci Google).
Ça simplifie pour le copyleft. Je me méfie, depuis quelques temps...^^

Voici ma procedure :

procedure BitmapToIcon(const BmpFileName, IcoFileName: string);
var
  IconBitmap, MaskBitmap: TBitmap;
  TransparentColor: TColor;
  x, y: Integer;
  IconInfo: TIconInfo;
begin
  IconBitmap := TBitmap.Create;
  try
    IconBitmap.LoadFromFile(BmpFileName);
    TransparentColor := IconBitmap.TransparentColor and $FFFFFF;
    MaskBitmap := TBitmap.Create;
    try
      MaskBitmap.Assign(IconBitmap);
      for y := 0 to IconBitmap.Height - 1 do
        for x := 0 to IconBitmap.Width - 1 do
          if IconBitmap.Canvas.Pixels[x, y] = TransparentColor then
            IconBitmap.Canvas.Pixels[x, y] := clBlack;
      with IconInfo do
      begin
        fIcon := True;
        hbmMask := MaskBitmap.MaskHandle;
        hbmColor := IconBitmap.Handle;
      end;
      with TIcon.Create do
      try
        Handle := CreateIconIndirect(IconInfo);
        SaveToFile(IcoFileName);
      finally
        Free;
      end;
    finally
      MaskBitmap.Free;
    end;
  finally
    IconBitmap.Free;
  end;
end;

// exemple d'utilisation :

procedure TForm1.Button1Click(Sender: TObject);
begin
  BitmapToIcon('image.bmp', 'image.ico');
end;

J'ai épuré et protégé dans des blocs try...finally.
Ça fonctionne parfaitement.

A +
Messages postés
207
Date d'inscription
mercredi 5 mars 2003
Statut
Membre
Dernière intervention
29 mars 2013
5
Je persiste à dire que je n'obtiens pas la même résolution.
J'ai uploadé un source pour que tu puisse voire :
http://sylvain.ard.free.fr/TEMP/BitmapToIco.zip

Lis le readme.txt inclus STP.

Merci.

Cordialement.

SISI231
Messages postés
207
Date d'inscription
mercredi 5 mars 2003
Statut
Membre
Dernière intervention
29 mars 2013
5
Tu dis que ce code t'intéresse et que tu voudrais le mettre sous forme de snippet, j'ai aussi un code pour passer de bmp à tiff et vice-versa : ça t'intéresse ?

SISI231
Messages postés
5
Date d'inscription
mardi 28 février 2006
Statut
Membre
Dernière intervention
18 août 2011

var
icony : ticon;
image : timage;
iconyh : hicon;
begin


image.picture.loadfromfile('fichier.bmp');
iconyh := image.picture.graphic.handle;
drawicon(image.canvas.srethdraw,0,0,iconyh);
icony.handle := iconyh;
icony.savetofile('fichier.ico');

end;

ça marche 100 % mieux ke cette fonction longue bmptoico

bye