Главная » Delphi » Графика » Нарисовать иконку приложения с "сеточкой"

Нарисовать иконку приложения с "сеточкой"

20:56
unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
 
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
icoBmp: TBitmap;
icoMask: TBitmap;
bmpBuf: TBitmap;
public
{ Public declarations }
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
icoBmp := TBitmap.Create;
icoBmp.Width := 32;
icoBmp.Height := 32;
icoMask := TBitmap.Create;
icoMask.Width := 32;
icoMask.Height := 32;
icoBmp.Canvas.Draw(0, 0, application.icon);
DrawIconEx(icoMask.Canvas.Handle, 0, 0, application.icon.Handle, 32, 32, 0, 0, DI_Mask);
bmpBuf := TBitmap.Create;
bmpBuf.Height := 512;
bmpBuf.Width := 512;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
icoBmp.Free;
icoMask.Free;
bmpBuf.Free;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
i, j: integer;
clr: TColor;
begin
for i := 0 to 32 do
for j := 0 to 32 do begin
clr := icoBmp.Canvas.Pixels[i, j];
if icoMask.Canvas.Pixels[i, j] = clWhite then clr := clFuchsia;
bmpBuf.Canvas.Brush.Color := clr;
bmpBuf.Canvas.FillRect(rect(i * 16, j * 16, i * 16 + 15, j * 16 + 15));
end;
Canvas.Draw(0, 0, bmpBuf);
end;
 
end.