BMP в ICO
Материал из DRKB
Вам необходимо создать два битмапа, битмап маски (назовём его "AND" bitmap) и битмап изображения (назовём его XOR bitmap). Вы можете пропустить обработчики для "AND" и "XOR" битмапов в Windows API функции CreateIconIndirect() и использовать обработчик возвращённой иконки в Вашем приложении.
procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX: Integer;
IconSizeY: Integer;
AndMask: TBitmap;
XOrMask: TBitmap;
IconInfo: TIconInfo;
Icon: TIcon;
begin
{ Получаем размер иконки }
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);
{ Создаём маску "And" }
AndMask := TBitmap.Create;
AndMask.Monochrome := True;
AndMask.Width := IconSizeX;
AndMask.Height := IconSizeY;
{ Рисуем на маске "And" }
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);
{ Рисуем для теста }
Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);
{ Создаём маску "XOR" }
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;
{ Рисуем на маске "XOR" }
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);
{ Рисуем в качестве теста }
Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);
{ Создаём иконку }
Icon := TIcon.Create;
IconInfo.fIcon := True;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);
{ Уничтожаем временные битмапы }
AndMask.Free;
XOrMask.Free;
{ Рисуем в качестве теста }
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);
{ Объявляем иконку в качестве иконки приложения }
Application.Icon := Icon;
{ генерируем перерисовку }
InvalidateRect(Application.Handle, nil, True);
{ Освобождаем иконку }
Icon.Free;
end;
Author: Bernhard Angerer
Source: http://forum.sources.ru
ID: 04268
Способ преобразования изображения размером 32x32 в иконку.[править | править код]
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
WinDC, SrcDC, DestDC: HDC;
OldBitmap: HBitmap;
iinfo: TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);
WinDC := getDC(Handle);
SrcDC := CreateCompatibleDC(WinDC);
DestDC := CreateCompatibleDC(WinDC);
OldBitmap := SelectObject(DestDC, iinfo.hbmColor);
OldBitmap := SelectObject(SrcDC, iinfo.hbmMask);
BitBlt(destDC, 0, 0, Image1.Picture.Icon.Width,
Image1.Picture.Icon.Height,
SrcDC, 0, 0, SRCPAINT);
Image2.Picture.Bitmap.Handle := SelectObject(DestDC, OldBitmap);
DeleteDC(DestDC);
DeleteDC(SrcDC);
DeleteDC(WinDC);
Image2.Picture.Bitmap.SaveToFile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Icon.LoadFromFile('c:\myicon.ico');
end;
end.
Source: http://delphiworld.narod.ru
ID: 04267
ID: 04278