Transformar Bitmap Em Ícone

[Paulo Nobre]

Uma procedure super simples para transformar Ícone para bitmap é a seguinte:

Procedure IcoToBmp;
var
   Icon : TIcon;
   Bitmap : TBitmap;
begin
   Icon := TIcon.Create;
   Bitmap := TBitmap.Create;
   Icon.LoadFromFile('c:\picture.ico');
   Bitmap.Width := Icon.Width;
   Bitmap.Height := Icon.Height;
   Bitmap.Canvas.Draw(0, 0, Icon );
   Bitmap.SaveToFile('c:\picture.bmp');
   Icon.Free;
   Bitmap.Free;
end; 

Alguém conhece uma tão fácil quanto esta para transformar Bitmap para ícone? Tentei adaptar a procedure acima mas não deu certo, pois Icon não possue o método canvas. Pelo menos deu erro quando fiz:

 
Icon.Canvas.Draw(0,0,Bitmap);

[paulobergo]

Olá...

Nem sei se isso vai ser muito complexo...

Mas, coloca um Image no form, com um botão... carrega uma figura no Image e experimenta o código abaixo...

Uso sempre isso para converter imagens para icones...

As vezes o efeito não fica bem o desejado, então, acabo editando a imagem primeiro (usando o efeito blur ou embaçar) antes de converter para icone...

Unit Bmp2iconUnit;

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

Type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Procedure bmp2ico(Image: TImage; FileName: TFilename);
Var
  Bmp: TBitmap;
  Icon: TIcon;
  ImageList: TImageList;
Begin
  Bmp  := TBitmap.Create;
  Icon := TIcon.Create;
  Try
    Bmp.Assign(Image.Picture);
    ImageList := TImageList.CreateSize(Bmp.Width, Bmp.Height);
    Try
      ImageList.AddMasked(Bmp, Bmp.TransparentColor);
      ImageList.GetIcon(0, Icon);
      // Salvar isso no arquivo que você quiser...
      // Poderia ter colocado um savedialog lá no Button1click
      // para escolher o nome.
      Icon.SaveToFile(FileName);
    Finally
      ImageList.Free;
    End;
  Finally
    Bmp.Free;
    Icon.Free;
  End;
End;

Procedure TForm1.Button1Click(Sender: TObject);
Begin
  // Se quiser, inclua um opendialog e Image1.Picture.LoadFromFile
  // aqui, e um save dialog para escolher o nome para salvar.
  bmp2ico(Image1, 'c:\test.ico');
End;

End.

Ok?

[Paulo Nobre]

Olá, Paulo Bergo

Vou tentar ver se adapto e se funciona para o que eu quero.

Pois eu não quero mostrar nada num imagem.

Quero apenas que o usuário pegue o caminho com opendialog transforme o bitmap em icon e salve ele no mesma pasta do programa que executa esta tarefa.

Vou ver se consigo adaptar.

Obrigado

[Paulo Nobre]

Paulo Bergo,

Adaptei a sua procedure para o que estava querendo e ficou da seguintre forma:

var
   Icon : TIcon;
   Bitmap : TBitmap;
   ImageList:TImageList;
   Origem,Destino:string;
   NomeDoArquivoSemExtensao:string;
begin
  Messagebox(handle,'Na janela que aparecerá a seguir escolha um bitmap, que deseja transformar em ícone.  '+#13+ 'O ícone criado a partir do bitmap será salvo na pasta deste programa.','AUTOMAÇÃO',MB_IconExclamation);
  OpenDialogBitmap.FileName :='';
  OpenDialogBitmap.Execute;
  Origem := OpenDialogBitmap.FileName;
  If OpenDialogBitmap.FileName = '' Then
    Begin
      MessageBox(Handle,'Você deve selecionar um bitmap e clicar em abrir !'+#13 + 'Clicando em cancelar nada acontecerá !','OPERAÇÃO NÃO EFETUADA',MB_ICONSTOP);
      Abort;
    end;
  //Transformação de Bitmap para ícone
  NomeDoArquivoSemExtensao:=MidStr(ExtractFileName(Origem),1,Length(ExtractFileName(Origem))-4);
  Icon := TIcon.Create;
  Bitmap := TBitmap.Create;
  Image1.Picture.LoadFromFile(Origem);
  Bitmap.Assign(Image1.Picture);
  ImageList := TImageList.CreateSize(Bitmap.Width, Bitmap.Height);
  ImageList.AddMasked(Bitmap, Bitmap.TransparentColor);
  ImageList.GetIcon(0, Icon);
  Destino:= ExtractFileDir(application.ExeName) + '\'+ NomeDoArquivoSemExtensao+'.ico';
  Icon.SaveToFile(Destino);
  Messagebox(handle,'O bitmap foi transformado para ícone com sucesso!!' + #13+'O nome é o mesmo do bitmap, com a nova extensão ico.   ','AUTOMAÇÃO',MB_IconInformation);

  Icon.Free;
  Bitmap.Free;
  ImageList.Free;
end;

Mas não entendo algumas coisas:

Porque só é possível esta transformação com um image presente, mesmo que até com a propriedade visible = false;

Por que tenho que ter um imagelist no código.

O que esta propriedade(método) AddMasked faz?

Será que não existe uma maneira mais simples?

[paulobergo]

Que bom que deu certo...

Quanto à propriedade... acredito que seja necessário apenas porque não foi criada uma propriedade GetIcon em TImage...

Assim, temos que usar um componente para fazer esta, digamos, transação... mesmo porque o Imagelist é bastante usado com lista de ícones, que transformam-se em ícones animados quando usamos um componente que coloca a aplicação na systray, como o componente "TrayIcons"...

Acho que foi até a partir deste componente ("TrayIcons") que fiz essa rotina de passar bitmap para icone...

E quanto à AddMasked, tem alguma coisa ligada à combinação da imagem a ser carregada com uma cor de fundo... e quando não usada com TransparentColor, provoca distorções no ícone...

Agora... acho que o código não ficou complicado não...

Mas, pode ser que alguém saiba algum jeitinho mais, digamos, direto!

OK?

[Paulo Nobre]

OK!, Paulo Bergo,

Veja a proposta encontrada no site oficial da BORLAND..

How do I create an icon from a bitmap? - by 
Rating:                  Ratings:  6     Rate it 


Abstract: Instructions for creating an icon. 

 Question and Answer Database

FAQ2748D.txt   How do I create an icon from a bitmap?
Category   :Windows API
Platform    :All
Product    :All 32 bit  

Question:
How do I create an icon from an bitmap?


Answer:
You must create two bitmaps, a mask bitmap (called the "AND"
bitmap) and a image bitmap (called the XOR bitmap). You can pass the
handles to the "AND" and "XOR"  bitmaps to the Windows API function
CreateIconIndirect() and use the returned icon handle in your
application.

Example:

procedure TForm1.Button1Click(Sender: TObject);
var
  IconSizeX : integer;
  IconSizeY : integer;
  AndMask : TBitmap;
  XOrMask : TBitmap;
  IconInfo : TIconInfo;
  Icon : TIcon;
begin
 {Get the icon size}
  IconSizeX := GetSystemMetrics(SM_CXICON);
  IconSizeY := GetSystemMetrics(SM_CYICON);

 {Create the "And" mask}
  AndMask := TBitmap.Create;
  AndMask.Monochrome := true;
  AndMask.Width := IconSizeX;
  AndMask.Height := IconSizeY;

 {Draw on the "And" mask}
  AndMask.Canvas.Brush.Color := clWhite;
  AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
  AndMask.Canvas.Brush.Color := clBlack;
  AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);

 {Draw as a test}
  Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);

 {Create the "XOr" mask}
  XOrMask := TBitmap.Create;
  XOrMask.Width := IconSizeX;
  XOrMask.Height := IconSizeY;

 {Draw on the "XOr" mask}
  XOrMask.Canvas.Brush.Color := ClBlack;
  XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
  XOrMask.Canvas.Pen.Color := clRed;
  XOrMask.Canvas.Brush.Color := clRed;
  XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);

 {Draw as a test}
  Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);

 {Create a icon}
  Icon := TIcon.Create;
  IconInfo.fIcon := true;
  IconInfo.xHotspot := 0;
  IconInfo.yHotspot := 0;
  IconInfo.hbmMask := AndMask.Handle;
  IconInfo.hbmColor := XOrMask.Handle;
  Icon.Handle := CreateIconIndirect(IconInfo);

 {Destroy the temporary bitmaps}
  AndMask.Free;
  XOrMask.Free;

 {Draw as a test}
  Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);

 {Assign the application icon}
  Application.Icon := Icon;

 {Force a repaint}
  InvalidateRect(Application.Handle, nil, true);

 {Free the icon}
  Icon.Free;
end;

E no mesmo site sugestão de leitores:

Here's another way to do it (both Bmp and Icon is allocated by the caller):

procedure IconFromBitmap(Bmp:TBitmap;var Icon:TIcon);

var il:TImageList;

begin

il := TImageList.CreateSize(bmp.Width,bmp.Height);

try

il.AddMasked(bmp,bmp.TransparentColor);

il.GetIcon(0,Icon);

finally

il.Free;

end;

end;

[Micheus]

Paulo Nobre, mas está conseguindo gerar um icone com 256 cores, ou está ficando aquela coisa estranha, tipo, como se fosse em apenas 16 cores?

[Paulo Nobre]

Paulo Nobre, mas está conseguindo gerar um icone com 256 cores, ou está ficando aquela coisa estranha, tipo, como se fosse em apenas 16 cores?

Micheus, não sei se está com 256 cores, mas não está estranho, não.

Na realidade quando finalizei ontem a rotina,não cheguei a testar o ícone usando, por exemplo num form.

Vi pelo explorer que a transformação foi feita, inclusive fazendo o ícone aparecer para mostrar qual é o arquivo. Tudo isto pelo explorer. Agora, a julgar pela imagem que tenho em mente, está com 256 cores sim!!

Você faz esta pergunta pois acha que o código está incompleto?

O código que estou usando é o do post #4

[Micheus]

Você faz esta pergunta pois acha que o código está incompleto?

O código que estou usando é o do post #4

Não. Fiz porque estava justamente trabalhando com o CreateIconIndirect. Estava utilizando uma imagem de entrada de 24bits de cor, mas a saída ficava uma porcaria. Logo após a criação eu associava a um TImage para visualizar na tela também. O estranho é que na tela estava correto, mas o do disco não.

[Thales Pontes Martins]

Paulo, uma pergunta: Se você não quer mostrar nada no form então porque está usando o TImage? Porque está fazendo ->

Image1.Picture.LoadFromFile..
Bitmap.Assign(Image1.picture);

? Porque não faz direto->

Bitmap.LoadFromFile...

e manda esse Timage pro inferno?

[Paulo Nobre]

Thales,

No post#4, fiz algumas perguntas, que o Paulo Bergo respondeu, mas não ficou 100%

claro, para mim. Na realidade adaptei o código do Paulo Bergo.

Alguém disse que oTListImage é necessário, por conta do

ImageList.GetIcon(0, Icon);

Mas realmente você escrevendo fica claro que

Image1.Picture.LoadFromFile..
Bitmap.Assign(Image1.picture);

está sem sentido, apenas fazendo o compilador trabalhar mais.

Valeu pelo toque.

Mandei o Image para o inferno.

[Churc]

pesquisando na internet achei isso

function BitmapToIcon(Bitmap: TBitmap): TIcon; 
var 
  IconSizeX, IconSizeY : integer; 
  IconInfo: TIconInfo; 
  IconBitmap, MaskBitmap: TBitmap; 
  x, y: Integer; 
  TransparentColor: TColor; 
begin 
  IconSizeX := GetSystemMetrics(SM_CXICON); 
  IconSizeY := GetSystemMetrics(SM_CYICON); 
  IconBitmap:= TBitmap.Create; 
  IconBitmap.Width:= IconSizeX; 
  IconBitmap.Height:= IconSizeY; 
  IconBitmap.Canvas.StretchDraw(Rect(0, 0, IconSizeX, IconSizeY), Bitmap); 
  IconBitmap.TransparentColor:= Bitmap.TransparentColor; 
  TransparentColor:= IconBitmap.TransparentColor and $FFFFFF; 
  MaskBitmap:= TBitmap.Create; 
  MaskBitmap.Assign(IconBitmap); 
  for y:= 0 to IconSizeY - 1 do 
    for x:= 0 to IconSizeX - 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;

function ConvertBitmapToIcon (src : HBITMAP; width, height, 
bitsPerPixel : Integer) : HICON; 
var 
  iconBits : PByte; 
  iconSize : Integer; 
  iconColorTableSize : Integer; 
  iconColorBitsSize : Integer; 
  iconMaskBitsSize : Integer; 
  dc, sourceDC : HDC; 
  nBits : Integer; 


  function BytesPerScanline (PixelsPerScanline, BitsPerPixel, 
Alignment: Longint): Longint; 
  begin 
    Dec(Alignment); 
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not 
Alignment; 
    Result := Result div 8; 
  end; 


begin 
  iconColorTableSize := 1 shl BitsPerPixel * sizeof (RGBQUAD); 
  iconColorBitsSize := height * BytesPerScanLine (width, bitsPerPixel, 
32); 
  iconMaskBitsSize := height * BytesPerScanLine (width, 1, 32); 


  iconSize := sizeof (TBitmapInfoHeader) + iconColorTableSize + 
iconColorBitsSize + iconMaskBitsSize; 


  iconBits := AllocMem (iconSize);         // Allocate (and zero) icon 
bits 
  try 
    with PBitmapInfoHeader (iconBits)^ do  // Fill in InfoHeader 
    begin 
      biSize := sizeof (TBitmapInfoHeader); 
      biWidth := width; 
      biHeight := height; 
      biPlanes := 1; 
      biBitCount := bitsPerPixel; 
      biCompression := BI_RGB; 
    end; 


    dc := GetDC (0); 
    if dc <> 0 then 
    try 
                                           // Get the color bits in the 
format specified 
                                           // in the info header above.   
This also tacks the color 
                                           // table onto the end of the 
info header and fills in the 
                                           // biSizeImage field in the 
info header. 


      nBits := GetDIBits (dc, src, 0, height, PByte (PChar (iconBits) + 
sizeof (TBitmapInfoHeader) + iconColorTableSize), PBitmapInfo 
(iconBits)^, DIB_RGB_COLORS); 
      if nBits = 0 then 
        RaiseLastWin32Error; 


      if PBitmapInfoHeader (iconBits)^.biSizeImage <> iconColorBitsSize 
then 
        raise Exception.Create ('Error calculating iconColorBitsSize'); 


      with PBitmapInfoHeader (iconBits)^ do 
        biHeight := biHeight + biHeight; 

      result := CreateIconFromResourceEx (iconBits, iconSize, True, 
$30000, width, height, LR_DEFAULTCOLOR); 
      if result = 0 then 
        RaiseLastWin32Error; 
    finally 
      ReleaseDC (0, dc) 
    end 
    else 
      RaiseLastWin32Error 
  finally 
    FreeMem (iconBits) 
  end 
end;

não testei não...

abraço

[Paulo Nobre]

Churc, aquela lá de cima que coloquei já funciona.

Mas, a sua parece ser mais completa e complexa.

Você poderia dizer o que ela está fazendo a mais do que a mencionada?

[Thales Pontes Martins]

Você poderia dizer o que ela está fazendo a mais do que a mencionada?

Ela está fazendo toda a conversão que no código sugerido pelo Paulo Bergo está sendo feita no método TImageList.GetIcon que chama o procedimento ImageList_GetIcon que está na dll comctl32.dll e que já faz todo o trabalho bruto.

[Paulo Nobre]

Ela está fazendo toda a conversão que no código sugerido pelo Paulo Bergo está sendo feita no método TImageList.GetIcon que chama o procedimento ImageList_GetIcon que está na dll comctl32.dll e que já faz todo o trabalho bruto.

Thales, como se sabe que está na dll comctl32.dll?

[Thales Pontes Martins]

Thales, como se sabe que está na dll comctl32.dll?

Bom,

1. Eu digitei TImageList.GetIcon em qualquer lugar.
2. Cliquei com botão direito em GetIcon e depois em "Find Declaration".
    Apareceu a classe TCustomImageList com seu respectivo método GetIcon.
3. Novamente clicando nesse GetIcon e depois em "Find Declaration" apareceu 
    outro método overloaded da mesma classe.
4. Dentro desse método fazia-se chamada ao procedimento ImageList_GetIcon 
    da unit CommCtrl, fui novamente em "Find Declaration".
5. Na unit CommCtrl tinha um external para uma dll cujo nome estava 
    na unit Windows, fui 2 vezes em "Find Declaration" e achei o valor 'comctl32.dll'.

Abraço.

[Paulo Nobre]

É, Thales, segui os passos e também consegui achar.

Interessante!!

Valeu

PS: É impressão minha ou o relógio que marca a hora que os posts estão sendo escritos ainda não foi para o horário de verão. Aqui por exemplo se post oas 9 horas(horário de verão) aparece no post como se tivesse postado às 8 horas!!!