unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
const
Rd = 230;//*2
Circ = 20; // n circle
DPerCircle = 30; // dot / circle 30 if circle
PerspectiveZ = 1000;
type
TDots = record
x, y, z: Single;
clr: TBGRAPixel;
end;
{ TForm1 }
TForm1 = class(TForm)
BGRAVirtualScreen1: TBGRAVirtualScreen;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
private
FDots: array of TDots;
FX, FY: Single;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
function ClampByte(Value: Integer): Byte;
begin
if Value < 0 then
Result := 0
else if Value > 255 then
Result := 255
else
Result := Value;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
lat, lon: Integer;
phi, theta: Single;
y, r: Single;
d: TDots;
begin
SetLength(FDots, Circ * DPerCircle);
for lat := 0 to Circ-1 do
begin
phi := (lat / (Circ - 1)) * Pi;
y := Cos(phi) * Rd;
r := Sin(phi) * Rd+30; // premier cercle
for lon := 0 to DPerCircle - 1 do
begin
theta := (lon / DPerCircle) * Pi * 2;
d.x := Cos(theta) * r;
d.y := y;
d.z := Sin(theta) * r;
d.clr := BGRA(255, 255, 0); // blanc
FDots[lat * DPerCircle + lon] := d;
end;
end;
FX := 0;
FY := 0;
end;
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
var
dot: TDots;
x, y, z: Single;
rx, ry, rz: Single;
cosX, sinX, cosY, sinY: Single;
scale: Single;
projX, projY: Integer;
alpha: Byte;
sz: Single;
begin
Bitmap.Fill(BGRABlack);
cosX := Cos(FX); sinX := Sin(FX);
cosY := Cos(FY); sinY := Sin(FY);
for dot in FDots do
begin
// Rotation X
x := dot.x;
y := dot.y * cosX - dot.z * sinX;
z := dot.y * sinX + dot.z * cosX;
// Rotation Y
rx := x * cosY - z * sinY;
rz := x * sinY + z * cosY;
ry := y;
// Projection
if (PerspectiveZ + rz) <> 0 then
begin
scale := PerspectiveZ / (PerspectiveZ + rz);
projX := Round(Bitmap.Width / 2 + rx * scale);
projY := Round(Bitmap.Height / 2 + ry * scale);
sz := 2 * scale;
alpha := ClampByte(Round(255 * (rz + Rd) / ( Rd/2)));
Bitmap.FillEllipseAntialias(projX, projY, sz, sz, BGRA(255, 255, 255, alpha));// or alpha
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FX += 0.008;
FY += 0.032;
BGRAVirtualScreen1.RedrawBitmap;
end;
end.