2D Starfield with BGRA component

[Gigatron]

Hi all,

First of all thanks all the lazarus and freepascal team for their work;
Thanks for the author of the BGRA (circular).
I made a little demo with BGRA canvas2d the maximum stars i ve used was 300 , so is it possible to
make this demo with more stars like 1500(slow)  ? Thanks in advance ;

https://www.youtube.com/watch?v=mJWiyshndpc 

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
9.   ExtCtrls, ComCtrls,  BGRAVirtualScreen, BGRACustomDrawn,
10.   BGRABitmap, BGRABitmapTypes, BGRACanvas2D, BGRAGraphics;
11.  
12. const
13.   timeGrain = 15/1000/60/60/24;
14.  
15. type
16.   TStar = record        //
17.     X, Y, Z: Double;
18.     Speed:   Double;
19.   end;
20.  
21.   { TForm1 }
22.  
23.   TForm1 = class(TForm)
24.     Image1: TImage;
25.     VirtualScreen: TBGRAVirtualScreen;
26.     Timer1: TTimer;
27.  
28.     procedure FormCreate(Sender: TObject);
29.     procedure Timer1Timer(Sender: TObject);
30.     procedure VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
31.  
32.   private
33.     { private declarations }
34.  
35.     lastTime: TDateTime;
36.     timeGrainAcc: double;
37.     count : integer;
38.     sin_count : integer;
39.    // col : TColor;
40.  
41.     Stars: array of TStar;
42.     ScreenCenter: TPoint;
43.     FocalLength: Double;
44.     FFieldDepth: integer;
45.     procedure InitializeStarfield;
46.     procedure UpdateStarfield;
47.  
48.     procedure UpdateIn(ms: integer);
49.  
50.   public
51.     { public declarations }
52.  
53.     procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
54.  
55.  
56.   end;
57.  
58. var
59.   Form1: TForm1;
60.  
61. implementation
62.  
63.  
64.  
65. {$R *.lfm}
66.  
67.  
68.  
69. { TForm1 }
70.  
71.  
72. procedure TForm1.FormCreate(Sender: TObject);
73.  
74. begin
75.   count :=0;
76.   lastTime := Now;
77.   VirtualScreen.Color := $d0d0ff;
78.   Randomize;
79.   ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);
80.   FocalLength := 100.0;
81.   FFieldDepth := 1000;
82.   //col := 16382457; // default couleur
83.   InitializeStarfield;
84.  
85.  
86.  
87.  
88. end;
89.  
90. procedure TForm1.InitializeStarfield;
91. var
92.   i: Integer;
93. begin
94.   SetLength(Stars, 300); // Nombre d'étoiles
95.   for i := 0 to High(Stars) do
96.   begin
97.     Stars[i].X := Random(ClientWidth);
98.     Stars[i].Y := Random(ClientHeight);
99.     Stars[i].Z := Random(FFieldDepth);
100.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
101.  
102.   end;
103. end;
104.  
105. procedure TForm1.UpdateStarfield;
106. var
107.   i: Integer;
108.  
109. begin
110.  
111.   for i := 0 to High(Stars) do
112.   begin
113.     // 3D
114.     // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse
115.     // 2D
116.        Stars[i].X := Stars[i].X - Stars[i].Speed ;
117.     // 3D
118.     //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
119.     //begin
120.     //  Stars[i].X := Random(ClientWidth);
121.     //  Stars[i].Y := Random(ClientHeight);
122.     //  Stars[i].Z := FFieldDepth;
123.     //  Stars[i].Speed := Random * 7 + 1;
124.     //
125.     //end;
126.     // 2D
127.  
128.     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
129.     begin
130.       Stars[i].X := ClientWidth;
131.       Stars[i].Y := Random(ClientHeight);
132.       Stars[i].Speed := Random * 7 + 1;
133.  
134.     end;
135.   end;
136.  
137.  
138. end;
139.  
140. procedure TForm1.Timer1Timer(Sender: TObject);
141. begin
142.   Timer1.Enabled := false;
143.   VirtualScreen.DiscardBitmap;
144. end;
145.  
146.  
147.  
148. procedure TForm1.VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
149. var ctx: TBGRACanvas2D;
150.   grainElapse: integer;
151.   newTime: TDateTime;
152. begin
153.   newTime := Now;
154.   timeGrainAcc += (newTime - lastTime)/timeGrain;
155.   lastTime := newTime;
156.   if timeGrainAcc < 1 then timeGrainAcc := 1;
157.   if timeGrainAcc > 50 then timeGrainAcc := 50;
158.   grainElapse := trunc(timeGrainAcc);
159.   timeGrainAcc -= grainElapse;
160.   ctx := Bitmap.Canvas2D;
161.   ctx.save;
162.   Star_field(ctx, grainElapse);
163.  
164.   ctx.restore;
165. end;
166.  
167. procedure TForm1.UpdateIn(ms: integer);
168.  
169. begin
170.   Timer1.Interval := ms;
171.   Timer1.Enabled := false;
172.   Timer1.Enabled := true;
173.  
174.  
175.  
176. end;
177.  
178. procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
179. var
180.   i: Integer;
181.   StarPosition: TPoint;
182.   StarSize: Integer;
183.   sttype : integer = 7;
184.   col: TBGRAPixel;
185.  
186.  
187. begin
188.    //ctx.fillStyle ('#000');
189.    ctx.fillRect (0, 0, ctx.Width, ctx.Height);
190.  
191.     ctx.fillStyle ('rgb(150,150,150)');
192.  
193.     //ctx.antialiasing:= true;
194.  
195.    for i := 0 to High(Stars) do
196.    begin
197.  
198.     //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);
199.     //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);
200.  
201.     StarPosition.X := Round(Stars[i].X );
202.     StarPosition.Y := Round(Stars[i].Y);
203.     sttype := Round(Stars[i].Speed);
204.  
205.    /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur
206.  
207.  
208.     case  (sttype)  of
209.     1: col := BGRAGraphics.RGBToColor(50,50,50);
210.     2: col := BGRAGraphics.RGBToColor(75,75,75);
211.     3: col := BGRAGraphics.RGBToColor(100,100,100);
212.     4: col := BGRAGraphics.RGBToColor(125,125,125);
213.     5: col := BGRAGraphics.RGBToColor(150,150,150);
214.     6: col := BGRAGraphics.RGBToColor(175,175,175);
215.     7: col := BGRAGraphics.RGBToColor(200,200,200);
216.     8: col := BGRAGraphics.RGBToColor(254,254,254);
217.  
218.     end;
219.     ctx.fillStyle (col);
220.     ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);
221.     //
222.   end;
223.    count := count +1;
224.    if (count>150) then
225.    begin
226.    col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));
227.    if(count>600) then count:=0;
228.  
229.    end;
230.  
231.    inc(sin_count);
232.  
233.    ctx.fillStyle (col);
234.    ctx.fontEmHeight := 40;
235.    ctx.fontStyle:= [fsBold];
236.    ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);
237.    ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);
238.  
239.    UpdateStarfield;
240.    UpdateIn(5);
241. end;
242.  
243.  
244.  
245. //End
246. end.
247.  
248.  

[TRon]

Nice example Gigatron.

A couple of remarks:
- There is no actual need to use BGRA controls but, I dig it
- if you paste some custom form code then make sure to either add instructions on which components to drop and/or what properties to set or do it in code
- Trigo functions can be pre calculated to gain speed
- indexes are faster than if-then/case

I have added some comments, adjusted indexing for star colours, and created a logo on the fly using BGRA unit functionality. The other suggestions are something for the reader to implement.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   BGRAVirtualScreen, BGRABitmap, BCTypes,
10.   BGRACanvas2D;
11.  
12. const
13.   StarCount = 2500;
14.   MaxSpeed  = 8;
15.  
16. type
17.   TStar = record        //
18.     X, Y, Z: Double;
19.     Speed:   Double;
20.   end;
21.  
22.   { TForm1 }
23.  
24.   TForm1 = class(TForm)
25.     BGRAVirtualScreen1: TBGRAVirtualScreen;
26.     Image1: TImage;
27.     Timer1: TTimer;
28.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
29.     procedure FormCreate(Sender: TObject);
30.     procedure Timer1Timer(Sender: TObject);
31.   private
32.     lastTime     : TDateTime;
33.     timeGrainAcc : double;
34.     count        : integer;
35.     sin_count    : integer;
36.     Stars        : array of TStar;
37.     ScreenCenter : TPoint;
38.     FocalLength  : Double;
39.     FFieldDepth  : integer;
40.     procedure InitializeStarfield;
41.     procedure UpdateStarfield;
42.     procedure UpdateIn(ms: integer);
43.     procedure CreateLogo;
44.     procedure CreateColours;
45.   public
46.     procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
47.   end;
48.  
49. const
50.   timeGrain = 15/1000/60/60/24;
51.  
52. var
53.   Form1: TForm1;
54.  
55. implementation
56.  
57. uses
58.   BGRAGradientScanner,
59.   BGRAGraphics,
60.   BGRABitmapTypes;
61.  
62. {$R *.lfm}
63.  
64. var
65.   StarColours  : array[1..maxSpeed] of TBGRAPixel;
66.  
67.  
68.  
69. { TForm1 }
70.  
71. procedure TForm1.FormCreate(Sender: TObject);
72. begin
73.   // On the form:
74.   // - drop a TTimer
75.   // - drop a BGRAVirtualScreen
76.   // On the BGRAVirtualScreen:
77.   // - Drop a Image
78.  
79.   // init components
80.   BGRAVirtualScreen1.Align := alClient;
81.   CreateLogo;
82.   Image1.Left := 100;
83.   Image1.Top := 10;
84.  
85.   CreateColours;
86.   count :=0;
87.   lastTime := Now;
88.   BGRAVirtualScreen1.Color := $d0d0ff;
89.   Randomize;
90.   ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);
91.   FocalLength := 100.0;
92.   FFieldDepth := 1000;
93.   //col := 16382457; // default couleur
94.   InitializeStarfield;
95. end;
96.  
97. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
98. var
99.   ctx: TBGRACanvas2D;
100.   grainElapse: integer;
101.   newTime: TDateTime;
102. begin
103.   newTime := Now;
104.   timeGrainAcc += (newTime - lastTime)/timeGrain;
105.   lastTime := newTime;
106.   if timeGrainAcc < 1 then timeGrainAcc := 1;
107.   if timeGrainAcc > 50 then timeGrainAcc := 50;
108.   grainElapse := trunc(timeGrainAcc);
109.   timeGrainAcc -= grainElapse;
110.   ctx := Bitmap.Canvas2D;
111.   ctx.save;
112.   Star_field(ctx, grainElapse);
113.  
114.   ctx.restore;
115. end;
116.  
117. procedure TForm1.Timer1Timer(Sender: TObject);
118. begin
119.   Timer1.Enabled := false;
120.   BGRAVirtualScreen1.DiscardBitmap;
121. end;
122.  
123. procedure TForm1.InitializeStarfield;
124. var
125.   i: Integer;
126. begin
127.   SetLength(Stars, StarCount); // Nombre d'étoiles
128.   for i := 0 to High(Stars) do
129.   begin
130.     Stars[i].X := Random(ClientWidth);
131.     Stars[i].Y := Random(ClientHeight);
132.     Stars[i].Z := Random(FFieldDepth);
133.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
134.   end;
135. end;
136.  
137. procedure TForm1.UpdateStarfield;
138. var
139.   i : integer;
140. begin
141.   for i := 0 to High(Stars) do
142.   begin
143.     // 3D
144.     // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse
145.     // 2D
146.        Stars[i].X := Stars[i].X - Stars[i].Speed ;
147.     // 3D
148.     //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
149.     //begin
150.     //  Stars[i].X := Random(ClientWidth);
151.     //  Stars[i].Y := Random(ClientHeight);
152.     //  Stars[i].Z := FFieldDepth;
153.     //  Stars[i].Speed := Random * 7 + 1;
154.     //
155.     //end;
156.     // 2D
157.  
158.     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
159.     begin
160.       Stars[i].X := ClientWidth;
161.       Stars[i].Y := Random(ClientHeight);
162.       Stars[i].Speed := Random * 7 + 1;
163.  
164.     end;
165.   end;
166. end;
167.  
168. procedure TForm1.UpdateIn(ms: integer);
169. begin
170.   Timer1.Interval := ms;
171.   Timer1.Enabled := false;
172.   Timer1.Enabled := true;
173. end;
174.  
175. procedure TForm1.CreateLogo;
176. var
177.   bmp: TBGRABitmap;
178.   grad: TBGRAGradientScanner;
179. begin
180.   bmp := TBGRABitmap.Create(550, 100); // eyeballing size
181.   grad := TBGRAGradientScanner.Create(BGRA(255,55,0),BGRA(0,0,25),gtLinear,PointF(0,0),PointF(0,35),True,True);
182.   bmp.FontHeight := 100;
183.   bmp.FontAntialias := true;
184.   bmp.FontStyle := [fsBold];
185.   bmp.TextOut(1,1,'GIGATRON', ColorToBGRA(ColorToRGB(clYellow)));  // draw border
186.   bmp.TextOut(2,2,'GIGATRON',grad);       // draw gradient text
187.   grad.free;
188.  
189.   Image1.AutoSize:= true;
190.   Image1.Picture.Assign(bmp);
191.   Image1.Picture.Bitmap.TransparentColor := clBlack;
192.   Image1.Transparent := true;
193.  
194.   // TODO: position of the image. But the position needs to change on a resize of the form anyhows.
195.   bmp.free;
196. end;
197.  
198. procedure TForm1.CreateColours;
199. var
200.   index : integer;
201. begin
202.   for index := Low(StarColours) to High(StarColours) do
203.     case index of
204.       1: StarColours[index]:= BGRAGraphics.RGBToColor(50,50,50);
205.       2: StarColours[index]:= BGRAGraphics.RGBToColor(75,75,75);
206.       3: StarColours[index]:= BGRAGraphics.RGBToColor(100,100,100);
207.       4: StarColours[index]:= BGRAGraphics.RGBToColor(125,125,125);
208.       5: StarColours[index]:= BGRAGraphics.RGBToColor(150,150,150);
209.       6: StarColours[index]:= BGRAGraphics.RGBToColor(175,175,175);
210.       7: StarColours[index]:= BGRAGraphics.RGBToColor(200,200,200);
211.       8: StarColours[index]:= BGRAGraphics.RGBToColor(254,254,254);
212.     end;
213. end;
214.  
215. procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
216. var
217.   i: Integer;
218.   StarPosition: TPoint;
219.   StarSize: Integer;
220.   sttype : integer = 7;
221.   col: TBGRAPixel;
222. begin
223.   //ctx.fillStyle ('#000');
224.   ctx.fillRect (0, 0, ctx.Width, ctx.Height);
225.   ctx.fillStyle('rgb(150,150,150)');
226.  
227.   //ctx.antialiasing:= true;
228.  
229.   for i := 0 to High(Stars) do
230.   begin
231.     //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);
232.     //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);
233.  
234.     StarPosition.X := Round(Stars[i].X );
235.     StarPosition.Y := Round(Stars[i].Y);
236.     sttype := Round(Stars[i].Speed);
237.  
238.     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur
239.  
240.     col := StarColours[sttype];
241.  
242. {    case  (sttype)  of
243.       1: col := BGRAGraphics.RGBToColor(50,50,50);
244.       2: col := BGRAGraphics.RGBToColor(75,75,75);
245.       3: col := BGRAGraphics.RGBToColor(100,100,100);
246.       4: col := BGRAGraphics.RGBToColor(125,125,125);
247.       5: col := BGRAGraphics.RGBToColor(150,150,150);
248.       6: col := BGRAGraphics.RGBToColor(175,175,175);
249.       7: col := BGRAGraphics.RGBToColor(200,200,200);
250.       8: col := BGRAGraphics.RGBToColor(254,254,254);
251.     end;
252. }
253.     ctx.fillStyle (col);
254.     ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);
255.     //
256.   end;
257.   count := count +1;
258.   if (count>150) then
259.   begin
260.     col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));
261.     if(count>600) then count:=0;
262.   end;
263.  
264.   inc(sin_count);
265.  
266.   ctx.fillStyle (col);
267.   ctx.fontEmHeight := 40;
268.   ctx.fontStyle:= [fsBold];
269.   ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);
270.   ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);
271.  
272.   UpdateStarfield;
273.   UpdateIn(5);
274. end;
275.  
276. end.
277.  

2500 stars without issues on this tiny machine here 

[circular]

Pretty cool along with the music. It gives pleasant Amiga/Atari demo vibes. 

Computing the logo on loading is a nice addition.

I've added some wavy effect on the text, something I remember from demos.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   AsyncProcess, BGRAVirtualScreen, BGRABitmap, BCTypes, BGRACanvas2D;
10.  
11. const
12.   StarCount = 2500;
13.   MaxSpeed  = 8;
14.  
15. type
16.   TStar = record        //
17.     X, Y, Z: Double;
18.     Speed:   Double;
19.   end;
20.  
21.   { TForm1 }
22.  
23.   TForm1 = class(TForm)
24.     BGRAVirtualScreen1: TBGRAVirtualScreen;
25.     Image1: TImage;
26.     Timer1: TTimer;
27.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
28.     procedure FormCreate(Sender: TObject);
29.     procedure Timer1Timer(Sender: TObject);
30.   private
31.     lastTime     : TDateTime;
32.     timeGrainAcc : double;
33.     count        : integer;
34.     sin_count    : integer;
35.     Stars        : array of TStar;
36.     ScreenCenter : TPoint;
37.     FocalLength  : Double;
38.     FFieldDepth  : integer;
39.     procedure InitializeStarfield;
40.     procedure UpdateStarfield;
41.     procedure UpdateIn(ms: integer);
42.     procedure CreateLogo;
43.     procedure CreateColours;
44.   public
45.     procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
46.   end;
47.  
48. const
49.   timeGrain = 15/1000/60/60/24;
50.  
51. var
52.   Form1: TForm1;
53.  
54. implementation
55.  
56. uses
57.   BGRAGradientScanner,
58.   BGRAGraphics,
59.   BGRABitmapTypes,
60.   BGRAUTF8;
61.  
62. {$R *.lfm}
63.  
64. var
65.   StarColours  : array[1..maxSpeed] of TBGRAPixel;
66.  
67.  
68.  
69. { TForm1 }
70.  
71. procedure TForm1.FormCreate(Sender: TObject);
72. begin
73.   // On the form:
74.   // - drop a TTimer
75.   // - drop a BGRAVirtualScreen
76.   // On the BGRAVirtualScreen:
77.   // - Drop a Image
78.  
79.   // init components
80.   BGRAVirtualScreen1.Align := alClient;
81.   CreateLogo;
82.   Image1.Left := 100;
83.   Image1.Top := 10;
84.   ClientWidth := 800;
85.   ClientHeight := 600;
86.  
87.   CreateColours;
88.   count :=0;
89.   lastTime := Now;
90.   BGRAVirtualScreen1.Color := $d0d0ff;
91.   Randomize;
92.   ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);
93.   FocalLength := 100.0;
94.   FFieldDepth := 1000;
95.   //col := 16382457; // default couleur
96.   InitializeStarfield;
97. end;
98.  
99. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
100. var
101.   ctx: TBGRACanvas2D;
102.   grainElapse: integer;
103.   newTime: TDateTime;
104. begin
105.   newTime := Now;
106.   timeGrainAcc += (newTime - lastTime)/timeGrain;
107.   lastTime := newTime;
108.   if timeGrainAcc < 1 then timeGrainAcc := 1;
109.   if timeGrainAcc > 50 then timeGrainAcc := 50;
110.   grainElapse := trunc(timeGrainAcc);
111.   timeGrainAcc -= grainElapse;
112.   ctx := Bitmap.Canvas2D;
113.   ctx.save;
114.   Star_field(ctx, grainElapse);
115.  
116.   ctx.restore;
117. end;
118.  
119. procedure TForm1.Timer1Timer(Sender: TObject);
120. begin
121.   Timer1.Enabled := false;
122.   BGRAVirtualScreen1.DiscardBitmap;
123. end;
124.  
125. procedure TForm1.InitializeStarfield;
126. var
127.   i: Integer;
128. begin
129.   SetLength(Stars, StarCount); // Nombre d'étoiles
130.   for i := 0 to High(Stars) do
131.   begin
132.     Stars[i].X := Random(ClientWidth);
133.     Stars[i].Y := Random(ClientHeight);
134.     Stars[i].Z := Random(FFieldDepth);
135.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
136.   end;
137. end;
138.  
139. procedure TForm1.UpdateStarfield;
140. var
141.   i : integer;
142. begin
143.   for i := 0 to High(Stars) do
144.   begin
145.     // 3D
146.     // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse
147.     // 2D
148.        Stars[i].X := Stars[i].X - Stars[i].Speed ;
149.     // 3D
150.     //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
151.     //begin
152.     //  Stars[i].X := Random(ClientWidth);
153.     //  Stars[i].Y := Random(ClientHeight);
154.     //  Stars[i].Z := FFieldDepth;
155.     //  Stars[i].Speed := Random * 7 + 1;
156.     //
157.     //end;
158.     // 2D
159.  
160.     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
161.     begin
162.       Stars[i].X := ClientWidth;
163.       Stars[i].Y := Random(ClientHeight);
164.       Stars[i].Speed := Random * 7 + 1;
165.  
166.     end;
167.   end;
168. end;
169.  
170. procedure TForm1.UpdateIn(ms: integer);
171. begin
172.   Timer1.Interval := ms;
173.   Timer1.Enabled := false;
174.   Timer1.Enabled := true;
175. end;
176.  
177. procedure TForm1.CreateLogo;
178. var
179.   bmp: TBGRABitmap;
180.   grad: TBGRAGradientScanner;
181. begin
182.   bmp := TBGRABitmap.Create(550, 100); // eyeballing size
183.   grad := TBGRAGradientScanner.Create(BGRA(255,55,0),BGRA(0,0,25),gtLinear,PointF(0,0),PointF(0,35),True,True);
184.   bmp.FontHeight := 100;
185.   bmp.FontAntialias := true;
186.   bmp.FontStyle := [fsBold];
187.   bmp.TextOut(1,1,'GIGATRON', ColorToBGRA(ColorToRGB(clYellow)));  // draw border
188.   bmp.TextOut(2,2,'GIGATRON',grad);       // draw gradient text
189.   grad.free;
190.  
191.   Image1.AutoSize:= true;
192.   Image1.Picture.Assign(bmp);
193.   Image1.Picture.Bitmap.TransparentColor := clBlack;
194.   Image1.Transparent := true;
195.  
196.   // TODO: position of the image. But the position needs to change on a resize of the form anyhows.
197.   bmp.free;
198. end;
199.  
200. procedure TForm1.CreateColours;
201. var
202.   index : integer;
203. begin
204.   for index := Low(StarColours) to High(StarColours) do
205.     case index of
206.       1: StarColours[index]:= BGRAGraphics.RGBToColor(50,50,50);
207.       2: StarColours[index]:= BGRAGraphics.RGBToColor(75,75,75);
208.       3: StarColours[index]:= BGRAGraphics.RGBToColor(100,100,100);
209.       4: StarColours[index]:= BGRAGraphics.RGBToColor(125,125,125);
210.       5: StarColours[index]:= BGRAGraphics.RGBToColor(150,150,150);
211.       6: StarColours[index]:= BGRAGraphics.RGBToColor(175,175,175);
212.       7: StarColours[index]:= BGRAGraphics.RGBToColor(200,200,200);
213.       8: StarColours[index]:= BGRAGraphics.RGBToColor(254,254,254);
214.     end;
215. end;
216.  
217. procedure WavyText(ctx: TBGRACanvas2D; AText: string; X,Y,
218.   AWavePosDeg, AWaveStepDeg, AWaveSize: single);
219. var cursor : TGlyphCursorUtf8;
220.   glyph: TGlyphUtf8;
221.   glyphText: string;
222. begin
223.   cursor := TGlyphCursorUtf8.New(AText, fbmAuto);
224.   while not cursor.EndOfString do
225.   begin
226.     glyph := cursor.GetNextGlyph;
227.     if glyph.MirroredGlyphUtf8 <> '' then
228.       glyphText := glyph.MirroredGlyphUtf8
229.     else
230.       glyphText := glyph.GlyphUtf8;
231.     ctx.fillText(glyphText, x,y + AWaveSize*Sin(AWavePosDeg*Pi/180));
232.     x += ctx.measureText(glyphText).width;
233.     AWavePosDeg += AWaveStepDeg;
234.   end;
235. end;
236.  
237. procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);
238. var
239.   i: Integer;
240.   StarPosition: TPoint;
241.   StarSize: Integer;
242.   sttype : integer = 7;
243.   col: TBGRAPixel;
244. begin
245.   //ctx.fillStyle ('#000');
246.   ctx.fillRect (0, 0, ctx.Width, ctx.Height);
247.   ctx.fillStyle('rgb(150,150,150)');
248.  
249.   //ctx.antialiasing:= true;
250.  
251.   for i := 0 to High(Stars) do
252.   begin
253.     //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);
254.     //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);
255.  
256.     StarPosition.X := Round(Stars[i].X );
257.     StarPosition.Y := Round(Stars[i].Y);
258.     sttype := Round(Stars[i].Speed);
259.  
260.     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur
261.  
262.     col := StarColours[sttype];
263.  
264. {    case  (sttype)  of
265.       1: col := BGRAGraphics.RGBToColor(50,50,50);
266.       2: col := BGRAGraphics.RGBToColor(75,75,75);
267.       3: col := BGRAGraphics.RGBToColor(100,100,100);
268.       4: col := BGRAGraphics.RGBToColor(125,125,125);
269.       5: col := BGRAGraphics.RGBToColor(150,150,150);
270.       6: col := BGRAGraphics.RGBToColor(175,175,175);
271.       7: col := BGRAGraphics.RGBToColor(200,200,200);
272.       8: col := BGRAGraphics.RGBToColor(254,254,254);
273.     end;
274. }
275.     ctx.fillStyle (col);
276.     ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);
277.     //
278.   end;
279.   count := count +1;
280.   if (count>150) then
281.   begin
282.     col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));
283.     if(count>600) then count:=0;
284.   end;
285.  
286.   inc(sin_count);
287.  
288.   ctx.fillStyle (col);
289.   ctx.fontEmHeight := 40;
290.   ctx.fontStyle:= [fsBold];
291.  
292.   WavyText(ctx,'PRESENTS',280+30*sin(sin_count/10),200,
293.     180*sin(sin_count/13), 40, 20);
294.   WavyText(ctx,'LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400,
295.     180*sin(sin_count/17), 20, 40);
296.  
297.   UpdateStarfield;
298.   UpdateIn(5);
299. end;
300.  
301. end.

[Gigatron]

Yeah !! Thanks Tron & Circular , i am from Amiga World and making demos with c#,javascript,threejs, lua tic-80 ...  and now trying with pascal , i will study the codes you sent and make nice stuff !

Thanks again

Amiga Rulez !

Gigatron

[Gigatron]

Hi,
I didn't know you could code intros with lazarus

Here is  an example of Amiga Paranoimia cracktro quickly converted to lazarus pascal;
Original music from Felix Schmidt ; Suntronic format (custom amiga) but i used .wav ;

https://www.youtube.com/watch?v=BPRaewrmglM

here is the source code ;

Enjoy , Gigatron  et Merci Circular ;

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, MPlayerCtrl,
9.   BGRABitmap, BGRACanvas2D, BGRABitmapTypes, BGRATextFX,mmsystem;
10.  
11. const
12.   StarCount = 300;
13.   MaxSpeed  = 6;
14.  
15. type
16.     TStar = record        //
17.     X, Y, Z: Double;
18.     Speed:   Double;
19.   end;
20.  
21.  
22.  
23.   { TForm1 }
24.  
25.   TForm1 = class(TForm)
26.   Timer1: TTimer;
27.  
28.     procedure FormCreate(Sender: TObject);
29.     procedure FormDestroy(Sender: TObject);
30.     procedure Timer1Timer(Sender: TObject);
31.  
32.   private
33.        const dat : Array [0..110] of Int16 = (-400,-60,0,-340,-60,0,-340,0,0,-400,0,0,-400,60,0,
34.        -320,60,0,-292,-60,0,-260,60,0,-240,-60,0,-180,-60,0,-180,0,0,-240,0,0,-240,60,0,-180,60,
35.        0,-160,60,0,-132,-60,0,-100,60,0,-80,-60,0,-80, 60,0,-20,-60,0,-20,60,0,0,-60,0,0,60,0,60,
36.        60,0,60,-60,0,80,-60,0,80,60,0,100,-60,0,100,60,0,140,0,0,180,-60,0,180,60,0,200,-60,0,200,
37.        60,0,220,60,0,252,-60,0,280,60,0);
38.  
39.   private
40.     Stars        : array of TStar;
41.     ScreenCenter : TPoint;
42.     FocalLength  : Double;
43.     FFieldDepth  : integer;
44.     procedure   CreateColours;
45.     procedure InitializeStarfield;
46.     procedure UpdateStarfield;
47.  
48.   public
49.     MyFile: AnsiString;
50.     WavStream : TMemoryStream;
51.     procedure Update_Demo;
52.     procedure Init();
53.  
54.  
55.   end;
56.  
57. var
58.   Form1: TForm1;
59.   ctx: TBGRACanvas2D;
60.   count : integer;
61.   bmp : TBGRABitmap;
62.  
63.  
64.   cx : integer = 400;
65.   cy : integer = 256;
66.   cz : integer = 140;
67.   cs : integer = 0;
68.   xr : double = 0;
69.   yr : double = 0;
70.   zr : integer = 0;
71.   StarColours  : array[1..maxSpeed] of TBGRAPixel;
72.  
73.  
74.  
75. implementation
76.  
77. {$R *.lfm}
78.  
79. { TForm1 }
80.  
81. procedure TForm1.FormCreate(Sender: TObject);
82.  
83. begin
84.     MyFile := Application.Location + 'paranoimia.wav';
85.     WavStream := TMemoryStream.Create;
86.     WavStream.LoadFromFile(MyFile);
87.     PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
88.  
89.     Init();
90. end;
91.  
92. procedure TForm1.FormDestroy(Sender: TObject);
93.  
94. begin
95.        WavStream.Free;
96. end;
97.  
98.  
99. procedure TForm1.Init();
100. begin
101.  
102.   Randomize;
103.   ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);
104.   FocalLength := 100.0;
105.   FFieldDepth := 1000;
106.   CreateColours;
107.   InitializeStarfield;
108. end;
109. procedure TForm1.CreateColours;
110. var
111.   index : integer;
112. begin
113.   for index := Low(StarColours) to High(StarColours) do
114.     case index of
115.       1: StarColours[index]:= BGRA(50,50,50);
116.       2: StarColours[index]:= BGRA(75,75,75);
117.       3: StarColours[index]:= BGRA(100,100,100);
118.       4: StarColours[index]:= BGRA(125,125,125);
119.       5: StarColours[index]:= BGRA(150,150,150);
120.       6: StarColours[index]:= BGRA(175,175,175);
121.       7: StarColours[index]:= BGRA(200,200,200);
122.       8: StarColours[index]:= BGRA(254,254,254);
123.     end;
124. end;
125. procedure TForm1.InitializeStarfield;
126. var
127.   i: Integer;
128. begin
129.   SetLength(Stars, StarCount); // Nombre d'étoiles
130.   for i := 0 to High(Stars) do
131.   begin
132.     Stars[i].X := Random(ClientWidth);
133.     Stars[i].Y := Random(ClientHeight);
134.     Stars[i].Z := 0.1+Random(FFieldDepth);  // div / 0 !! if not !
135.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
136.   end;
137. end;
138. procedure TForm1.UpdateStarfield;
139. var
140.   i : integer;
141. begin
142.   for i := 0 to High(Stars) do
143.   begin
144.     // 3D
145.       Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse
146.  
147.     if Stars[i].Z < 0 then // Réinitialiser la position si l'étoile sort de l'écran
148.     begin
149.       Stars[i].X := Random(ClientWidth);
150.       Stars[i].Y := Random(ClientHeight);
151.       Stars[i].Z := 0.1+Random(FFieldDepth);
152.       Stars[i].Speed := Random * 7 + 1;
153.  
154.     end;
155.   end;
156. end;
157.  
158.  
159. procedure TForm1.Update_Demo();
160. var
161.     i, j : integer ;
162.     x, y, z, xa, ya : double;
163.     xc, xs, yc, ys, zc, zs : double ;
164.     px,py :  array [0..110]  of integer;
165.  
166.     couleur: TBGRAPixel;
167.     // st
168.     st : integer;
169.     sttype : integer = 7;
170.     col: TBGRAPixel;
171.     StarPosition: TPoint;
172.  
173.  
174. begin
175.   bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, clBtnFace);
176.   ctx := bmp.Canvas2D;
177.  
178.   i:=0;
179.   j:=0;
180.   x:=0;
181.   y:=0;
182.   z:=0;
183.   xc :=0;
184.   xs :=0;
185.   yc :=0;
186.   ys :=0;
187.   zc :=0;
188.   zs :=0;
189.  
190.   xc := cos(xr);
191.   xs := sin(xr);
192.   yc := cos(yr);
193.   ys := sin(yr);
194.   zc := cos(zr);
195.   zs := sin(zr);
196.  
197.  
198.   ctx.fillRect(0,0,ClientWidth, ClientHeight);
199.  
200.   ctx.fillStyle (BGRA(0, 0, 220, 255));
201.                 ctx.fillRect(0,25,ClientWidth,30);
202.                 ctx.fillRect(0,460,ClientWidth,30);
203.   bmp.FontName:='paranoimia';
204.   bmp.TextOut(820-count,466,'PARANOIMIA     PRESENTS     !!!     SHINOBI      WHAT     A     PRIMITIVE     PROTECTION  !!!!!!   NOTE   DO   NOT   CHANGE   ANYTHING   ON   TRACK   0                 ',BGRA(255,255,255));
205.   bmp.TextOut(820-count,30, 'PARANOIMIA     PRESENTS     !!!     SHINOBI      WHAT     A     PRIMITIVE     PROTECTION  !!!!!!   NOTE   DO   NOT   CHANGE   ANYTHING   ON   TRACK   0                 ',BGRA(255,255,255));
206.  
207.  
208.   // starfield
209.  
210.   for st := 0 to High(Stars) do
211.   begin
212.     StarPosition.X := Round((Stars[st].X - ScreenCenter.X) * (FocalLength / Stars[st].Z) + ScreenCenter.X);
213.     StarPosition.Y := Round((Stars[st].Y - ScreenCenter.Y) * (FocalLength / Stars[st].Z) + ScreenCenter.Y);
214.  
215.     sttype := Round(Stars[st].Speed);
216.     col := StarColours[sttype];
217.     ctx.fillStyle (col);
218.     ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);
219.     // end stars !!
220.   end;
221.  
222.  
223.  
224.    for i := 0 to High(dat) do
225.     begin
226.         x := dat[j];
227.         y := dat[j+1];
228.         z := dat[j+2];
229.         j := j +3;
230.  
231.         ya := (y * xc) + (z * xs);
232.         z := (z * xc) - (y * xs);
233.         y := ya;
234.         xa := (x * yc) + (z * ys);
235.         z := (z * yc) - (x * ys);
236.         x := xa;
237.  
238.         xa := (x * zc) - (y * zs);
239.         y := (y * zc) + (x * zs);
240.         x := xa;
241.  
242.         z := 256 / (869 + z);
243.  
244.         x := round(x * z) shl(8);
245.         y := round(y * z) shl(8);
246.  
247.         z := z + cz;
248.         px[i] := round((x / z) + cx) ;//&0xffff;
249.         py[i] := round((y / z) + cy) ; //&0xffff;
250.  
251.         end;
252.  
253.          xr := xr - 0.04;
254.          yr := yr + 0.03;
255.  
256.  
257.   couleur := BGRA(255, 255, 255, 255);
258.   // P   logo vertex draw !
259.   bmp.DrawLineAntialias(px[0],py[0],px[1],py[1], couleur,2);
260.   bmp.DrawLineAntialias(px[1],py[1],px[2],py[2], couleur,2);
261.   bmp.DrawLineAntialias(px[2],py[2],px[3],py[3], couleur,2);
262.   bmp.DrawLineAntialias(px[3],py[3],px[4],py[4], couleur,2);
263.   bmp.DrawLineAntialias(px[4],py[4],px[0],py[0], couleur,2);
264.   //A
265.   bmp.DrawLineAntialias(px[5],py[5],px[6],py[6],couleur,2);
266.   bmp.DrawLineAntialias(px[6],py[6],px[7],py[7],couleur,2);
267.   //R
268.   bmp.DrawLineAntialias(px[8],py[8],px[9],py[9],couleur,2);
269.   bmp.DrawLineAntialias(px[9],py[9],px[10],py[10],couleur,2);
270.   bmp.DrawLineAntialias(px[10],py[10],px[11],py[11],couleur,2);
271.   bmp.DrawLineAntialias(px[11],py[11],px[12],py[12],couleur,2);
272.   bmp.DrawLineAntialias(px[12],py[12],px[8],py[8],couleur,2);
273.   bmp.DrawLineAntialias(px[11],py[11],px[13],py[13],couleur,2);
274.   //A
275.   bmp.DrawLineAntialias(px[14],py[14],px[15],py[15],couleur,2);
276.   bmp.DrawLineAntialias(px[15],py[15],px[16],py[16],couleur,2);
277.   //N
278.   bmp.DrawLineAntialias(px[17],py[17],px[18],py[18],couleur,2);
279.   bmp.DrawLineAntialias(px[17],py[17],px[20],py[20],couleur,2);
280.   bmp.DrawLineAntialias(px[19],py[19],px[20],py[20],couleur,2);
281.   //O
282.   bmp.DrawLineAntialias(px[21],py[21],px[22],py[22],couleur,2);
283.   bmp.DrawLineAntialias(px[22],py[22],px[23],py[23],couleur,2);
284.   bmp.DrawLineAntialias(px[23],py[23],px[24],py[24],couleur,2);
285.   bmp.DrawLineAntialias(px[24],py[24],px[21],py[21],couleur,2);
286.   //I
287.   bmp.DrawLineAntialias(px[25],py[25],px[26],py[26],couleur,2);
288.   //M
289.   bmp.DrawLineAntialias(px[28],py[28],px[27],py[27],couleur,2);
290.   bmp.DrawLineAntialias(px[27],py[27],px[29],py[29],couleur,2);
291.   bmp.DrawLineAntialias(px[29],py[29],px[30],py[30],couleur,2);
292.   bmp.DrawLineAntialias(px[30],py[30],px[31],py[31],couleur,2);
293.   //I
294.   bmp.DrawLineAntialias(px[32],py[32],px[33],py[33],couleur,2);
295.   //A
296.   bmp.DrawLineAntialias(px[34],py[34],px[35],py[35],couleur,2);
297.   bmp.DrawLineAntialias(px[35],py[35],px[36],py[36],couleur,2);
298.   //
299.  
300.  
301.  
302.   bmp.Draw(Canvas,0,0);
303.   bmp.Free;
304.  
305. end;
306.  
307.  
308. procedure TForm1.Timer1Timer(Sender: TObject);
309. begin
310.        count := count + 4;
311.        if (count>3000) then count :=0;
312.        Update_Demo;
313.        UpdateStarfield;
314. end;
315.  
316.  
317.  
318. end.
319.  
320.  

[circular]

Cool 

[DrakkTheSeafarer]

hello,

here is an old article about 2D starfield with fpc using sdl2: https://betterprogramming.pub/kotlin-native-vs-c-vs-freepascal-vs-python-a-comparison-part-2-1be9007ecf41

greetings

[Gigatron]

hello,

here is an old article about 2D starfield with fpc using sdl2: https://betterprogramming.pub/kotlin-native-vs-c-vs-freepascal-vs-python-a-comparison-part-2-1be9007ecf41

greetings

Hi,
thank you for this interesting article; I've learned pascal in one week with light-speed , and personally like this language.
I am sure i can make now Amiga Intro-Demo

lua
https://tic80.com/play?cart=3781
https://tic80.com/play?cart=3771
javascript
http://gigatron3k.free.fr/pdx_psx1/pdx.html

[TRon]

I didn't know you could code intros with lazarus

Of course it can. Though we can discuss wether it is usefull or not 

I wonder if instead of Lazarus you perhaps meant Pascal. In which case, there were quite a few years that there was a competition between c/asm programmers and turbo pascal programmers. Many old-school demo's (but also intro's) were programmed using TP.

It should also be possible to use a 3th party engine such as castle or SDL with Lazarus.

Here is  an example of Amiga Paranoimia cracktro quickly converted to lazarus pascal;

You guys are too fast for me  I was in the midst of cleaning up the code from your other demo effects.

So, instead of polluting the main form unit we can do this:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGRAVirtualScreen, BGRABitmap, BGRACanvas2D;
10.  
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGRAVirtualScreen1: TBGRAVirtualScreen;
18.     Timer1: TTimer;
19.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
20.     procedure FormCreate(Sender: TObject);
21.     procedure FormDestroy(Sender: TObject);
22.     procedure Timer1Timer(Sender: TObject);
23.   private
24.     lastTime     : TDateTime;
25.     timeGrainAcc : double;
26.     ScreenCenter : TPoint;
27.     FocalLength  : Double;
28.     FFieldDepth  : integer;
29.     procedure UpdateIn(ms: integer);
30.   public
31.     procedure Render(ctx: TBGRACanvas2D; grainElapse: integer);
32.   end;
33.  
34. const
35.   timeGrain = 15/1000/60/60/24;
36.  
37. var
38.   Form1: TForm1;
39.  
40. implementation
41.  
42. uses
43.   demo_effects;
44.  
45.  
46. {$R *.lfm}
47.  
48. var
49.   Logo      : TStaticLogo;
50.   StarField : T2DStarfield;
51.   Wavy1     : TWavyText;
52.   Wavy2     : TWavyText;
53.  
54.  
55. { TForm1 }
56.  
57. procedure TForm1.FormCreate(Sender: TObject);
58. begin
59.   // On the form:
60.   // - drop a TTimer
61.   // - drop a BGRAVirtualScreen
62.   // ToDo: create at runtime
63.  
64.   BGRAVirtualScreen1.Align := alClient;
65.   BGRAVirtualScreen1.Color := $d0d0ff;
66.   ClientWidth  := 800;
67.   ClientHeight := 600;
68.   ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);
69.  
70.   lastTime     := Now;
71.   Randomize;
72.   FocalLength  := 100.0;
73.   FFieldDepth  := 1000;
74.  
75.   // Create demo effect classes
76.   Logo      := TStaticLogo.Create(BGRAVirtualScreen1);
77.   StarField := T2DStarfield.Create(Bounds(0, 0, 800, 600));
78.   Wavy1     := TWavyText.Create;
79.   Wavy2     := TWavyText.Create;
80.  
81.   // Initialize demo effects
82.   Logo.Initialize;
83.   StarField.Initialize;
84.   Wavy1.Initialize('PRESENTS'                 , Point(280, 200),  30);
85.   Wavy2.Initialize('LAZARUS 2D STARFIELD DEMO', Point( 80, 400), -30);
86. end;
87.  
88.  
89. procedure TForm1.FormDestroy(Sender: TObject);
90. begin
91.   // Destroy demo effect classes
92.   Logo.Free;
93.   StarField.Free;
94.   Wavy1.Free;
95.   Wavy2.Free;
96. end;
97.  
98.  
99. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
100. var
101.   ctx: TBGRACanvas2D;
102.   grainElapse: integer;
103.   newTime: TDateTime;
104. begin
105.   newTime := Now;
106.   timeGrainAcc += (newTime - lastTime)/timeGrain;
107.   lastTime := newTime;
108.   if timeGrainAcc < 1  then timeGrainAcc := 1;
109.   if timeGrainAcc > 50 then timeGrainAcc := 50;
110.   grainElapse := trunc(timeGrainAcc);
111.   timeGrainAcc -= grainElapse;
112.  
113.   ctx := Bitmap.Canvas2D;
114.   ctx.save;
115.   Render(ctx, grainElapse);
116.   ctx.restore;
117. end;
118.  
119.  
120. procedure TForm1.Timer1Timer(Sender: TObject);
121. begin
122.   Timer1.Enabled := false;
123.   BGRAVirtualScreen1.DiscardBitmap;
124. end;
125.  
126.  
127. procedure TForm1.UpdateIn(ms: integer);
128. begin
129.   Timer1.Interval := ms;
130.   Timer1.Enabled := false;
131.   Timer1.Enabled := true;
132. end;
133.  
134.  
135. procedure TForm1.Render(ctx: TBGRACanvas2D; grainElapse: integer);
136. begin
137.   ctx.fillRect (0, 0, ctx.Width, ctx.Height);
138.   ctx.fillStyle('rgb(150,150,150)');
139.  
140.   StarField.Render(ctx);
141.  
142.   Wavy1.Update;
143.   Wavy2.Update;
144.   Wavy1.Render(ctx);
145.   Wavy2.Render(ctx);
146.  
147.   StarField.Update;
148.  
149.   UpdateIn(5);
150. end;
151.  
152. end.
153.  

And most probably it is perhaps even better to create a demo-engine class (but I leave that to whomever has that need).

And push the effects themselves into a separate unit (actually you could should to use a single unit per demo-effect for easier ex/inclusion).

Code: Pascal  [Select][+][-]

1. unit demo_effects;
2.  
3. interface
4.  
5. uses
6.   types,
7.   BGRAVirtualScreen, BGRABitmapTypes, BGRACanvas2D;
8.  
9. type
10.   TArea = TRect;
11.  
12.   { TStaticLogo }
13.  
14.   TStaticLogo = class
15.    private
16.     FOwner    : TBGRAVirtualScreen;
17.     FLogoText : string;
18.    public
19.     constructor Create(aOwner: TBGRAVirtualScreen);
20.    public
21.     procedure Initialize;
22.     procedure Update;
23.     procedure Render;
24.   end;
25.  
26.  
27.   { T2d_Starfield }
28.  
29.   T2DStarField = class
30.    private
31.    type
32.      T2DStar = record
33.      X, Y, Z: Double;
34.      Speed:   Double;
35.    end;
36.    private
37.     FArea         : TArea;
38.     FStars        : array of T2DStar;
39.     FSpeedColours : array of TBGRAPixel;
40.     FStarCount    : integer;
41.     FMaxSpeed     : integer;
42.     FFieldDepth   : integer;
43.    public
44.     constructor Create(aArea:TArea);
45.    public
46.     procedure Initialize;
47.     procedure Update;
48.     procedure Render(aCanvas: TBGRACanvas2D);
49.   end;
50.  
51.  
52.   { TWavyText }
53.  
54.   TWavyText = class
55.    private
56.     FAmplitude  : integer;
57.     FStartFrame : integer;
58.     FStopFrame  : integer;
59.     FText       : string;
60.     FCount      : integer;
61.     FSinCount   : integer;
62.     FCol        : TBGRAPixel;
63.     FPoint      : TPoint;
64.   public
65.     constructor Create;
66.    public
67.     procedure Initialize(aText: string; aPoint: TPoint; aAmplitude: integer);
68.     procedure Update;
69.     procedure Render(aCanvas: TBGRACanvas2D);
70.   end;
71.  
72.  
73.  
74.  
75. implementation
76.  
77.  
78. uses
79.   Graphics, ExtCtrls,
80.   BGRAGraphics,
81.   BGRABitmap,
82.   BGRAGradientScanner;
83.  
84.  
85.             {                     }
86.             {     TStaticLogo     }
87.             {                     }
88.  
89. constructor TStaticLogo.Create(aOwner: TBGRAVirtualScreen);
90. begin
91.   inherited Create;
92.   FOwner := aOwner;
93.   FLogoText := 'GIGATRON';
94. end;
95.  
96. procedure TStaticLogo.Update;
97. begin
98.   // intentionally left empty
99. end;
100.  
101. procedure TStaticLogo.Render;
102. begin
103.   // intentionally left empty
104. end;
105.  
106. procedure TStaticLogo.Initialize;
107. const
108.   ShadeSize = 1;
109. var
110.   bmp       : TBGRABitmap;
111.   grad      : TBGRAGradientScanner;
112.   Image1    : TImage;
113.   TextSize  : TSize;
114.   TextCoord : TPoint;
115. begin
116.   bmp  := TBGRABitmap.Create;
117.   grad := TBGRAGradientScanner.Create(BGRA(255,55,0),BGRA(0,0,25),gtLinear,PointF(0,0),PointF(0,35),True,True);
118.  
119.   bmp.FontHeight    := 100;
120.   bmp.FontAntialias := true;
121.   bmp.FontStyle     := [fsBold];
122.   // get text dimensions
123.   TextSize := bmp.TextSize(FLogoText);
124.   // set size of bitmap
125.   bmp.SetSize(TextSize.Width + ShadeSize, TextSize.Height + ShadeSize);
126.   // clear bitmap
127.   bmp.FillRect(0,0, bmp.Width, bmp.Height, BGRA(0,0,0));
128.   // set text coordinates
129.   TextCoord.X:= 0; TextCoord.Y:= 0;
130.   // draw shade
131.   bmp.TextOut(TextCoord.X, TextCoord.Y, FLogoText, ColorToBGRA(ColorToRGB(clYellow)));
132.   // draw gradient text
133.   bmp.TextOut(TextCoord.X + ShadeSize, TextCoord.Y + ShadeSize, FLogoText, grad);
134.   grad.free;
135.  
136.   // create and set image
137.   Image1 := TImage.Create(FOwner);
138.   Image1.Parent := FOwner;
139.   Image1.AutoSize := true;
140.   Image1.Picture.Assign(bmp);
141.   Image1.Picture.Bitmap.TransparentColor := clBlack;
142.   Image1.Transparent := true;
143.  
144.   Image1.Top  := 10;
145.   // still not entirely properly centered
146.   Image1.Left := (FOwner.ClientWidth - Image1.Width) shr 1;
147.   bmp.free;
148. end;
149.  
150.  
151.             {                      }
152.             {     T2DStarField     }
153.             {                      }
154.  
155.  
156. constructor T2DStarField.Create(aArea:TArea);
157. begin
158.   FStarCount := 300;
159.   FMaxSpeed  := 8;
160.   FFieldDepth := 1000;
161.   FArea := aArea;
162. end;
163.  
164. procedure T2DStarField.Render(aCanvas: TBGRACanvas2D);
165. var
166.   index        : integer;
167.   StarPosition : TPoint;
168.   sttype       : integer = 7;
169.   col          : TBGRAPixel;
170. begin
171.   for index := Low(FStars) to High(FStars) do
172.   begin
173.     //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);
174.     //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);
175.  
176.     StarPosition.X := Round(FStars[index].X );
177.     StarPosition.Y := Round(FStars[index].Y);
178.     sttype := Round(FStars[index].Speed);
179.  
180.     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur
181.  
182.     col := FSpeedColours[sttype];
183.     aCanvas.fillStyle (col);
184.     aCanvas.fillRect(StarPosition.X, StarPosition.Y,2,2);
185.   end;
186. end;
187.  
188. procedure T2DStarField.Initialize;
189. var
190.   index: Integer;
191. begin
192.   // init stars
193.   SetLength(FStars, FStarCount); // Nombre d'étoiles
194.   for index := Low(FStars) to High(FStars) do
195.   begin
196.     FStars[index].X := Random(FArea.Width);
197.     FStars[index].Y := Random(FArea.Height);
198.     FStars[index].Z := Random(FFieldDepth);
199.     FStars[index].Speed := Random * Pred(FMaxSpeed) + 1; // Vitesse aléatoire
200.   end;
201.  
202.   // init speedcolours
203.   SetLength(FSpeedColours, Succ(FMaxSpeed)); // Nombre d'étoiles
204.  
205.   for index := Low(FSpeedColours) to High(FSpeedColours) do
206.     case index of
207.       0: FSpeedColours[index]:= BGRAGraphics.RGBToColor(0,0,0);
208.       1: FSpeedColours[index]:= BGRAGraphics.RGBToColor(50,50,50);
209.       2: FSpeedColours[index]:= BGRAGraphics.RGBToColor(75,75,75);
210.       3: FSpeedColours[index]:= BGRAGraphics.RGBToColor(100,100,100);
211.       4: FSpeedColours[index]:= BGRAGraphics.RGBToColor(125,125,125);
212.       5: FSpeedColours[index]:= BGRAGraphics.RGBToColor(150,150,150);
213.       6: FSpeedColours[index]:= BGRAGraphics.RGBToColor(175,175,175);
214.       7: FSpeedColours[index]:= BGRAGraphics.RGBToColor(200,200,200);
215.       8: FSpeedColours[index]:= BGRAGraphics.RGBToColor(254,254,254);
216.     end;
217. end;
218.  
219. procedure T2DStarField.Update;
220. var
221.   index: integer;
222. begin
223.   for index := low(FStars) to High(FStars) do
224.   begin
225.     // 3D
226.     // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse
227.     // 2D
228.        FStars[index].X := FStars[index].X - FStars[index].Speed ;
229.     // 3D
230.     //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
231.     //begin
232.     //  Stars[i].X := Random(ClientWidth);
233.     //  Stars[i].Y := Random(ClientHeight);
234.     //  Stars[i].Z := FFieldDepth;
235.     //  Stars[i].Speed := Random * 7 + 1;
236.     //
237.     //end;
238.     // 2D
239.  
240.     if FStars[index].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
241.     begin
242. //      FStars[index].X := ClientWidth;
243. //      FStars[index].Y := Random(ClientHeight);
244. //      FStars[index].X := 800;
245. //      FStars[index].Y := Random(600);
246.       FStars[index].X := FArea.Width;
247.       FStars[index].Y := Random(FArea.Height);
248.  
249. //      FStars[index].Speed := Random * 7 + 1;
250. //      FStars[index].Speed := Random * Pred(FMaxSpeed) + 1;
251. //      FStars[index].Speed := Succ(Random * Pred(FMaxSpeed));
252.       FStars[index].Speed := Random * Pred(FMaxSpeed) + 1;
253.     end;
254.   end;
255. end;
256.  
257.  
258.             {                   }
259.             {     TWavyText     }
260.             {                   }
261.  
262.  
263. constructor TWavyText.Create;
264. begin
265.   inherited create;
266.  
267.   FStartFrame:= 150;
268.   FStopFrame:= 600;
269.   FSinCount := 0;
270.   FCount    := 0;
271.   FText     := '';
272.   FCol      :=  BGRA(150,150,150);
273. end;
274.  
275. procedure TWavyText.Initialize(aText: string; aPoint: TPoint; aAmplitude: integer);
276. begin
277.   FText      := atext;
278.   FPoint := aPoint;
279.   FAmplitude := aAmplitude;
280. end;
281.  
282. procedure TWavyText.Update;
283. begin
284.   FCount := FCount+1;
285.   if (FCount>FStartFrame) then
286.   begin
287.     FCol := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));
288.     if (FCount>FStopFrame) then FCount:=0;
289.   end;
290.  
291.   inc(FSinCount);
292. end;
293.  
294. procedure TWavyText.Render(aCanvas: TBGRACanvas2D);
295. begin
296.   aCanvas.fillStyle(FCol);
297.   aCanvas.fontEmHeight := 40;
298.   aCanvas.fontStyle:= [fsBold];
299.   aCanvas.fillText(FText,FPoint.X+FAmplitude*sin(FSinCount/10), FPoint.Y);
300.  
301.   (*
302.    ctx.fillStyle (col);
303.    ctx.fontEmHeight := 40;
304.    ctx.fontStyle:= [fsBold];
305.    ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);
306.    ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);
307.   *)
308. end;
309.  
310. end.
311.  

That way you can easily modify/extend an exisitng effect or add a new one as desired. I like my effects to work on a certain area of the (virtual) screen so that the visible area can be minimized (a common practise to gain speed back in the days).

Thank you circular for the wavy y-axis. It requires a little work to speed that up with precalculations (which should speed up things considerably as it is rather slow now).

[KodeZwerg]

Nice works! I liking this oldschool stuff
From point of view as "creating a demo" you full succeeded, what I did in past was away from all that fancy LCL, doing all native by Windows Api to get the max out into the smallest possible. From point of filesize, pure assembler exe-packed produce the smallest files while FPC has per default a pretty big RTL that wants to link in.
With a prepared/modified FPC/exepacked, such demo would be 7-9kb (while ASM is around 4kb, unoptimized) (excluding sound data)
A not-prepared FPC/not-packed would be around 90kb.
What I try to say, get common with your target OS and its api to try code native how the OS would like to get it, great job!
May the guru meditation be kind with you 

[hukka]

Here is  an example of Amiga Paranoimia cracktro quickly converted to lazarus pascal;

Nice! The splash screen in my tracker (using FPC+SDL2) was also inspired by the cracktro:

[TRon]

What I try to say, get common with your target OS and its api to try code native how the OS would like to get it, great job!

For demo-coding usually the hardware as well :-)

How else to do cool (cheap) things like FLD and bitplane scrolling f.e.

May the guru meditation be kind with you 

Oh, you familiar with him ? He usually ain't very nice to me

[KodeZwerg]

Here is my contribution for a Starfield simulation that uses right now no 3rd party acceleration.
It supports several layers of stars that fly at different speeds depending on Z.
It can easily render 10000 stars or more.
My colorization method is very poor designed but easy replacable
To rebuild, throw an TImage on form, make it alClient.
Throw a TTimer on form with a 50ms interval.
Copy/Paste now all content in your code editor.
Connect TForm with OnCreate and OnResize.
Connect TTimer with OnTimer.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.   TStar = packed record
12.     X,
13.     Y,
14.     Z: Integer;
15.   end;
16.   TStars = array of TStar;
17.  
18. const
19.   CMaxStars = UInt32(5000);
20.  
21. type
22.   { TForm1 }
23.  
24.   TForm1 = class(TForm)
25.     Image1: TImage;
26.     Timer1: TTimer;
27.     procedure FormCreate(Sender: TObject);
28.     procedure FormResize(Sender: TObject);
29.     procedure Timer1Timer(Sender: TObject);
30.   strict private
31.     FStars: TStars;
32.     FLayers: Integer;
33.   private
34.     procedure InitStars;
35.   public
36.   end;
37.  
38. var
39.   Form1: TForm1;
40.  
41. implementation
42.  
43. {$R *.lfm}
44.  
45. { TForm1 }
46.  
47. procedure TForm1.FormCreate(Sender: TObject);
48. begin
49.   Randomize;
50.   InitStars;
51. end;
52.  
53. procedure TForm1.FormResize(Sender: TObject);
54. begin
55.   InitStars;
56. end;
57.  
58. procedure TForm1.Timer1Timer(Sender: TObject);
59. var
60.   LBmp: TBitmap;
61.   i: Integer;
62.   StarColor: TColor;
63. begin
64.   LBmp := TBitmap.Create;
65.   try
66.     LBmp.Width := Self.Image1.Width;
67.     LBmp.Height := Self.Image1.Height;
68.     LBmp.PixelFormat := pf32bit;
69.     LBmp.Canvas.Brush.Color := clBlack;
70.     LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));
71.  
72.     for i := Low(FStars) to High(FStars) do
73.       begin
74.         StarColor := RGBToColor(
75.            Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers)),
76.            Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers)),
77.            Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers))
78.          );
79.         LBmp.Canvas.Brush.Color := StarColor;
80.         LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, FStars[i].X + 1, FStars[i].Y + 1));
81.         FStars[i].X := FStars[i].X - Succ(FStars[i].Z);
82.         if FStars[i].X <= 0 then
83.           begin
84.             FStars[i].X := LBmp.Width;
85.             FStars[i].Y := Random(LBmp.Height);
86.             FStars[i].Z := Random(FLayers);
87.           end;
88.       end;
89.     Image1.Picture.Bitmap.Assign(LBmp);
90.   finally
91.     LBmp.Free;
92.   end;
93. end;
94.  
95. procedure TForm1.InitStars;
96. var
97.   i: Integer;
98. begin
99.   FLayers := Random(10) + 5;
100.   SetLength(FStars, CMaxStars);
101.   for i := Low(FStars) to High(FStars) do
102.     begin
103.       FStars[i].X := Random(Self.Image1.Width);
104.       FStars[i].Y := Random(Self.Image1.Height);
105.       FStars[i].Z := Random(FLayers);
106.     end;
107.   Timer1.Enabled := True;
108. end;
109.  
110. end.

[KodeZwerg]

Based on my prior post heres a small demo that shows a starfield class.

Code: Pascal  [Select][+][-]

1. unit kz.StarField;
2.  
3. (*
4.   Starfield (ball) simulation class by KodeZwerg in 2024
5.   Uses slow LCL, not Hardware accelerated, single thread
6.   Royalty free (c) by KodeZwerg
7.  
8.   it supports...
9.   - double buffered, no flicker
10.   - random layers to control the speed per star
11.     as more layers you allow to be used, as faster the top stars fly
12.   - integrated a grey scaled colormap generation for fast fixed colors or complete random generated
13.   - partly individual scroll direction (left, right, top, bottom)
14.     Todo: replace direction mode with an angle
15.   - random sized stars for values higher than 1
16.   - background color is adjustable
17.   - random positioned stars
18.   Todo:
19.     add transparency switch so the background become invisible
20.     maby add Z-Order drawing, currently whats drawn is drawn
21.  
22.   Usage:
23.   1. Create an instance of the class by telling target dimension
24.   2. Set your preffered options, defaults should be ok
25.   3. Use a timer to generate/update a Bitmap for your usage by calling "Next"
26.   additional
27.   4. Use a resize event to update width/height of class
28.   optional
29.   5. draw text or other image data on that image before displaying it
30. *)
31.  
32. {$mode ObjFPC}{$H+}
33.  
34. interface
35.  
36. uses
37.   Classes, SysUtils, Graphics;
38.  
39. type
40.  
41.   { TkzStarField }
42.  
43.   TStarDirection = (sdLeft, sdRight, sdTop, sdBottom);
44.   TkzStarField = class(TObject)
45.     strict private
46.       type
47.         TOneStar = packed record
48.           X,
49.           Y,
50.           Z,
51.           Size: Integer;
52.           Color: TColor;
53.         end;
54.         TAllStars = array of TOneStar;
55.         TColors = array of TColor;
56.     strict private
57.       FHeight: Integer;
58.       FStars: TAllStars;
59.       FColors: TColors;
60.       FLayers: Integer;
61.       FBitmap: TBitmap;
62.       FMaxStars: Integer;
63.       FWidth: Integer;
64.       FHeigth: Integer;
65.       FRandomColors: Boolean;
66.       FDirection: TStarDirection;
67.       FBackground: TColor;
68.     strict private
69.       FMaxSize: Integer;
70.       procedure SetBackground(const AValue: TColor);
71.       procedure SetDirection(const AValue: TStarDirection);
72.       procedure SetHeight(const AValue: Integer);
73.       procedure SetLayers(const AValue: Integer);
74.       procedure SetMaxSize(const AValue: Integer);
75.       procedure SetRandomColors(const AValue: Boolean);
76.       procedure SetStars(const AValue: Integer);
77.       procedure SetWidth(const AValue: Integer);
78.     public
79.       constructor Create(const AWidth, AHeigth: Integer);
80.       destructor Destroy; override;
81.       function Reinitialize: Boolean;
82.       function Next: Boolean;
83.     published
84.       property Bitmap: TBitmap read FBitmap;
85.       property Layers: Integer read FLayers write SetLayers default 10;
86.       property MaxStars: Integer read FMaxStars write SetStars default 100;
87.       property MaxSize: Integer read FMaxSize write SetMaxSize default 1;
88.       property Width: Integer read FWidth write SetWidth default 800;
89.       property Height: Integer read FHeight write SetHeight default 600;
90.       property RandomColors: Boolean read FRandomColors write SetRandomColors default True;
91.       property Direction: TStarDirection read FDirection write SetDirection default sdRight;
92.       property Background: TColor read FBackground write SetBackground default clBlack;
93.   end;
94.  
95. implementation
96.  
97. { TkzStarField }
98.  
99. constructor TkzStarField.Create(const AWidth, AHeigth: Integer);
100. begin
101.   inherited Create;
102.   Randomize;
103.   FBitmap := TBitmap.Create;
104.   FBitmap.PixelFormat := pf32bit;
105.   FWidth := AWidth;
106.   FHeight := AHeigth;
107.   FLayers := 10;
108.   FMaxStars := 100;
109.   FMaxSize := 1;
110.   FRandomColors := True;
111.   FDirection := sdRight;
112.   FBackground := clBlack;
113.   Reinitialize;
114. end;
115.  
116. destructor TkzStarField.Destroy;
117. begin
118.   FBitmap.Free;
119.   inherited Destroy;
120. end;
121.  
122. function TkzStarField.Reinitialize: Boolean;
123. var
124.   i: Integer;
125. begin
126.   Result := False;
127.   SetLength(FStars, FMaxStars);
128.   SetLength(FColors, FLayers);
129.   FBitmap.Width := FWidth;
130.   FBitmap.Height := FHeigth;
131.   for i := Low(FColors) to High(FColors) do
132.     begin
133.       FColors[i] := RGBToColor(
134.            Round(255 + (16 - 255) * (Succ(i) / FLayers)),
135.            Round(255 + (16 - 255) * (Succ(i) / FLayers)),
136.            Round(255 + (16 - 255) * (Succ(i) / FLayers))
137.          );
138.     end;
139.   for i := Low(FStars) to High(FStars) do
140.     begin
141.       FStars[i].X := Succ(Random(FWidth));
142.       FStars[i].Y := Succ(Random(FHeight));
143.       FStars[i].Z := Random(FLayers);
144.       FStars[i].Size := Succ(Random(FMaxSize));
145.       if FRandomColors then
146.         FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
147.       else
148.         FStars[i].Color := FColors[Random(Length(FColors))];
149.     end;
150.   Result := True;
151. end;
152.  
153. function TkzStarField.Next: Boolean;
154. var
155.   LBmp: TBitmap;
156.   i: Integer;
157. begin
158.   Result := False;
159.   LBmp := TBitmap.Create;
160.   try
161.     LBmp.PixelFormat := pf32bit;
162.     LBmp.Width := FWidth;
163.     LBmp.Height := FHeight;
164.     LBmp.Canvas.Brush.Color := FBackground;
165.     LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));
166.     for i := Low(FStars) to High(FStars) do
167.       begin
168.         LBmp.Canvas.Brush.Color := FStars[i].Color;
169.         // draw a rectangle (dot) or a circle
170.         if FStars[i].Size <= 1 then
171.           LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X), Succ(FStars[i].Y)))
172.         else
173.           LBmp.Canvas.Ellipse(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X + FStars[i].Size), Succ(FStars[i].Y + FStars[i].Size)));
174.         // move a star
175.         if FDirection = sdLeft then
176.           begin
177.             FStars[i].X := FStars[i].X - Succ(FStars[i].Z);
178.             if FStars[i].X < 0 - (FStars[i].Size + FStars[i].Size) then
179.               begin
180.                 FStars[i].X := LBmp.Width + (FStars[i].Size + FStars[i].Size);
181.                 FStars[i].Y := Succ(Random(LBmp.Height));
182.                 FStars[i].Z := Random(FLayers);
183.                 FStars[i].Size := Succ(Random(FMaxSize));
184.                 if FRandomColors then
185.                   FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
186.                 else
187.                   FStars[i].Color := FColors[Random(Length(FColors))];
188.               end;
189.           end;
190.         if FDirection = sdRight then
191.           begin
192.             FStars[i].X := FStars[i].X + Succ(FStars[i].Z);
193.             if FStars[i].X > LBmp.Width + (FStars[i].Size + FStars[i].Size) then
194.               begin
195.                 FStars[i].X := 0 - (FStars[i].Size + FStars[i].Size);
196.                 FStars[i].Y := Succ(Random(LBmp.Height));
197.                 FStars[i].Z := Random(FLayers);
198.                 FStars[i].Size := Succ(Random(FMaxSize));
199.                 if FRandomColors then
200.                   FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
201.                 else
202.                   FStars[i].Color := FColors[Random(Length(FColors))];
203.               end;
204.           end;
205.         if FDirection = sdTop then
206.           begin
207.             FStars[i].Y := FStars[i].Y - Succ(FStars[i].Z);
208.             if FStars[i].Y < (0 - (FStars[i].Size + FStars[i].Size)) then
209.               begin
210.                 FStars[i].X := Succ(Random(LBmp.Width));
211.                 FStars[i].Y := LBmp.Height + (FStars[i].Size + FStars[i].Size);
212.                 FStars[i].Z := Random(FLayers);
213.                 FStars[i].Size := Succ(Random(FMaxSize));
214.                 if FRandomColors then
215.                   FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
216.                 else
217.                   FStars[i].Color := FColors[Random(Length(FColors))];
218.               end;
219.           end;
220.         if FDirection = sdBottom then
221.           begin
222.             FStars[i].Y := FStars[i].Y + Succ(FStars[i].Z);
223.             if FStars[i].Y >= LBmp.Height + (FStars[i].Size + FStars[i].Size) then
224.               begin
225.                 FStars[i].X := Succ(Random(LBmp.Width));
226.                 FStars[i].Y := 0 - (FStars[i].Size + FStars[i].Size);
227.                 FStars[i].Z := Random(FLayers);
228.                 FStars[i].Size := Succ(Random(FMaxSize));
229.                 if FRandomColors then
230.                   FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
231.                 else
232.                   FStars[i].Color := FColors[Random(Length(FColors))];
233.               end;
234.           end;
235.       end;
236.     FBitmap.Assign(LBmp);
237.   finally
238.     LBmp.Free;
239.   end;
240.   Result := True;
241. end;
242.  
243. procedure TkzStarField.SetLayers(const AValue: Integer);
244. begin
245.   if FLayers = AValue then
246.     Exit;
247.   FLayers := AValue;
248.   Reinitialize;
249. end;
250.  
251. procedure TkzStarField.SetMaxSize(const AValue: Integer);
252. begin
253.   if ((AValue < 1) or (FMaxSize = AValue)) then
254.     Exit;
255.   FMaxSize := AValue;
256.   Reinitialize;
257. end;
258.  
259. procedure TkzStarField.SetRandomColors(const AValue: Boolean);
260. begin
261.   if FRandomColors = AValue then
262.     Exit;
263.   FRandomColors := AValue;
264. //  Reinitialize;
265. end;
266.  
267. procedure TkzStarField.SetStars(const AValue: Integer);
268. begin
269.   if ((AValue < FLayers) or (FMaxStars = AValue)) then
270.     Exit;
271.   FMaxStars := AValue;
272.   Reinitialize;
273. end;
274.  
275. procedure TkzStarField.SetWidth(const AValue: Integer);
276. begin
277.   if ((AValue < 1) or (FWidth = AValue)) then
278.     Exit;
279.   FWidth := AValue;
280.   Reinitialize;
281. end;
282.  
283. procedure TkzStarField.SetHeight(const AValue: Integer);
284. begin
285.   if ((AValue < 1) or (FHeight = AValue)) then
286.     Exit;
287.   FHeight := AValue;
288.   Reinitialize;
289. end;
290.  
291. procedure TkzStarField.SetDirection(const AValue: TStarDirection);
292. begin
293.   if FDirection = AValue then
294.     Exit;
295.   FDirection := AValue;
296. //  Reinitialize;
297. end;
298.  
299. procedure TkzStarField.SetBackground(const AValue: TColor);
300. begin
301.   if FBackground = AValue then
302.     Exit;
303.   FBackground := AValue;
304. //  Reinitialize;
305. end;
306.  
307. end.

[Gigatron]

Hi every nice people ;

I thank everyone for their contribution for making starfield in realtime and smooth display. Conclusion we can say that with Lazarus Pascal we can do everything
I will post as soon as I have coded an intro like on the Amiga, intros and demos are always useful, at least for the brain and the eyes;

thanks again ;

And for the final word ; smooth and running full speed 60 fps with 1600 (8 layers stars) + amiga copperbars ,with my config : 8 cores 16 thread 64Gb gtx1080
is :

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGLVirtualScreen, BGRAOpenGL,BGRABitmap;
10.  
11. const
12.   StarCount = 1600;
13.   MaxSpeed  = 8;
14.  
15. type
16.   TStar = record        //
17.     X, Y, Z: Double;
18.     Speed:   Double;
19.   end;
20.  
21.   { TForm1 }
22.  
23.   TForm1 = class(TForm)
24.     BGLVirtualScreen1: TBGLVirtualScreen;
25.     Timer1: TTimer;
26.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
27.     procedure FormCreate(Sender: TObject);
28.     procedure Timer1Timer(Sender: TObject);
29.     procedure  Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
30.  
31.   private
32.     Stars : array of TStar;
33.     procedure InitializeStarfield;
34.     procedure UpdateStarfield;
35.  
36.   public
37.  
38.   end;
39.  
40. var
41.   Form1: TForm1;
42.   ct : integer;
43.  
44. implementation
45.  
46. {$R *.lfm}
47.  
48. uses BGRABitmapTypes;
49.  
50. { TForm1 }
51.  
52. procedure TForm1.FormCreate(Sender: TObject);
53. begin
54.   Randomize;
55.   InitializeStarfield;
56. end;
57.  
58. procedure TForm1.InitializeStarfield;
59. var
60.   i: Integer;
61. begin
62.   SetLength(Stars, StarCount); // Nombre d'étoiles
63.   for i := 0 to High(Stars) do
64.   begin
65.     Stars[i].X := Random(ClientWidth);
66.     Stars[i].Y := (60+Random(ClientHeight-120));
67.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
68.   end;
69. end;
70.  
71. procedure TForm1.UpdateStarfield;
72. var
73.   i : integer;
74. begin
75.   for i := 0 to High(Stars) do
76.   begin
77.  
78.        Stars[i].X := Stars[i].X - Stars[i].Speed ;
79.  
80.     if Stars[i].X < 0 then // Réinitialiser la position si l'étoile sort de l'écran
81.     begin
82.       Stars[i].X := ClientWidth;
83.       Stars[i].Y := (60+Random(ClientHeight-120));
84.       Stars[i].Speed := Random * 7 + 1;
85.  
86.     end;
87.   end;
88. end;
89.  
90. procedure Tform1.Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
91.  
92. begin
93.   BGLContext.Canvas.FillRectLinearColor(x1,y1,x1+ClientWidth,y1+16,   RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(255,100,0),RGBToColor(255,100,0),centered);
94.   BGLContext.Canvas.FillRectLinearColor(x1,y1+32,x1+ClientWidth,y1+16,RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(255,100,0),RGBToColor(255,100,0),centered);
95.  end;
96.  
97.  
98.  
99.  
100. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
101. var
102.   i : integer;
103.   StarPosition: TPoint;
104.   sttype : Int16 ;
105.   col: TColor;
106. begin
107.  
108.   for i := 0 to High(Stars) do
109.   begin
110.  
111.     StarPosition.X := Round(Stars[i].X );
112.     StarPosition.Y := Round(Stars[i].Y);
113.     sttype := Round(Stars[i].Speed);
114.  
115.     col := RGBToColor(50,50,50);
116.     // bitplanes colors
117.     case  (sttype)  of
118.       1: col := RGBToColor(50,50,50);
119.       2: col := RGBToColor(75,75,75);
120.       3: col := RGBToColor(100,100,100);
121.       4: col := RGBToColor(125,125,125);
122.       5: col := RGBToColor(150,150,150);
123.       6: col := RGBToColor(175,175,175);
124.       7: col := RGBToColor(200,200,200);
125.       8: col := RGBToColor(254,254,254);
126.     end;
127.       BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);
128.   end;
129.  
130.      for i := 0 to 8 do
131.       begin
132.            Copperbar(BGLContext,0,280+i*4+120*sin(ct/10+(i/4)), true);
133.       end;
134.  
135.      UpdateStarfield;
136. end;
137.  
138. procedure TForm1.Timer1Timer(Sender: TObject);
139. begin
140.     ct := ct + 1 ;
141.     BGLVirtualScreen1.Repaint;
142. end;
143.  
144. end.
145.