Paulo Nobre Postado Novembro 12, 2006 Denunciar Share Postado Novembro 12, 2006 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); Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 paulobergo Postado Novembro 12, 2006 Denunciar Share Postado Novembro 12, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 12, 2006 Autor Denunciar Share Postado Novembro 12, 2006 Olá, Paulo BergoVou 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 Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 12, 2006 Autor Denunciar Share Postado Novembro 12, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 paulobergo Postado Novembro 12, 2006 Denunciar Share Postado Novembro 12, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 13, 2006 Autor Denunciar Share Postado Novembro 13, 2006 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; Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Micheus Postado Novembro 13, 2006 Denunciar Share Postado Novembro 13, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 13, 2006 Autor Denunciar Share Postado Novembro 13, 2006 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 Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Micheus Postado Novembro 13, 2006 Denunciar Share Postado Novembro 13, 2006 Você faz esta pergunta pois acha que o código está incompleto?O código que estou usando é o do post #4Nã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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Thales Pontes Martins Postado Novembro 13, 2006 Denunciar Share Postado Novembro 13, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 14, 2006 Autor Denunciar Share Postado Novembro 14, 2006 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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Churc Postado Novembro 14, 2006 Denunciar Share Postado Novembro 14, 2006 pesquisando na internet achei issofunction 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 Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 14, 2006 Autor Denunciar Share Postado Novembro 14, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Thales Pontes Martins Postado Novembro 15, 2006 Denunciar Share Postado Novembro 15, 2006 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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 15, 2006 Autor Denunciar Share Postado Novembro 15, 2006 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? Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Thales Pontes Martins Postado Novembro 15, 2006 Denunciar Share Postado Novembro 15, 2006 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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Paulo Nobre Postado Novembro 15, 2006 Autor Denunciar Share Postado Novembro 15, 2006 É, Thales, segui os passos e também consegui achar.Interessante!! ValeuPS: É 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!!! Citar Link para o comentário Compartilhar em outros sites More sharing options...
Pergunta
Paulo Nobre
Uma procedure super simples para transformar Ícone para bitmap é a seguinte:
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:Link para o comentário
Compartilhar em outros sites
16 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.