unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
BGRABitmap, BGRABitmapTypes, Math, LCLIntf;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
x, y, midLine, t1, t2: integer;
C, N, dx, dy: single;
cb: byte;
sky: TBGRABitmap;
begin
sky := TBGRABitmap.Create(Width, Height, BGRA(0, 0, 0));
t1 := GetTickCount;
midLine := 512 div 2;
N := 4;
for y := 0 to midLine do
begin
for X := 0 to midLine do
begin
dx := X / (midLine);
dy := Y / (midLine);
C := 1 - sqrt(dx * dx + dy * dy);
if C < 0 then
C := 0;
C := power(C, N);
cb := round(C * 255);
if cb > 0 then
begin
sky.SetPixel(midLine - x, midLine - y, BGRA(cb, cb, cb));
sky.SetPixel(midLine + x + 1, midLine - y, BGRA(cb, cb, cb));
sky.SetPixel(midLine - x, midLine + y + 1, BGRA(cb, cb, cb));
sky.SetPixel(midLine + x + 1, midLine + y + 1, BGRA(cb, cb, cb));
end;
end;
end;
t2 := GetTickCount;
Form1.Caption := IntToStr(t2 - t1);
sky.Draw(Canvas, 0, 0, False);
sky.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBGRABitmap;
tt: integer;
procedure Glow(AR, AX, AY: integer;AColor:TBGRAPixel);
var
x, y: integer;
dx, dy, dc: single;
p: PBGRAPixel;
a:byte;
begin
for y := MAX(AY - AR,0) to MIN(AY + AR,bmp.Height) - 1 do
begin
p := bmp.Scanline[y];
dy := abs(AR - y) / AR;
for x := MAX(AX - AR,0) to MIN(AX + AR,bmp.Height) - 1 do
begin
dx := abs(AR - x) / AR;
dc := power(1 - sqrt(dx * dx + dy * dy), 4);
a := round(dc * 255);
p^:=AColor;
p^.alpha := a;
Inc(p);
end;
end;
bmp.InvalidateBitmap;
end;
begin
bmp := TBGRABitmap.Create(Width, Height, BGRABlack);
tt := GetTickCount;
Glow(256, 256, 256,BGRA(255, 255, 190));
Caption := IntToStr(GetTickCount - tt);
bmp.Draw(Canvas, 0, 0,False);
bmp.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
end.