...(Ваша старая программа вроде не работает) Нужно создать два bitmap, маску
(называемую "AND") и bitmap с картинкой (называемый "XOR" bitmap). Можно
передать handles к "AND" и "XOR" bitmap Windows API функции CreateIconIndirect()
ииспользовать полученный handle иконки в вашем приложении
| |
|
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);
{Удаляем временные
bitmap}
AndMask.Free;
XOrMask.Free;
{Рисуем для проверки}
Form1.Canvas.Draw(IconSizeX *
6, IconSizeY, Icon);
{Присвамваем иконку приложению}
Application.Icon :=
Icon;
{Заставляем
перерисоваться}
InvalidateRect(Application.Handle, nil,
true);
{Освобождаем
иконку}
Icon.Free;
end; |
Прислал Alexander Vozny. | 
