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


См. также[править | править код]