2D Starfield with BGRA component lazarus / 39-Graphics ---------------------------------------------------------------------- Gigatron · 2024-03-30 19:50 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1;  {$mode objfpc}{$H+} interface uses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,  ExtCtrls, ComCtrls,  BGRAVirtualScreen, BGRACustomDrawn,  BGRABitmap, BGRABitmapTypes, BGRACanvas2D, BGRAGraphics; const  timeGrain = 15/1000/60/60/24; type  TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    Image1: TImage;    VirtualScreen: TBGRAVirtualScreen;    Timer1: TTimer;     procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    procedure VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   private    { private declarations }     lastTime: TDateTime;    timeGrainAcc: double;    count : integer;    sin_count : integer;   // col : TColor;     Stars: array of TStar;    ScreenCenter: TPoint;    FocalLength: Double;    FFieldDepth: integer;    procedure InitializeStarfield;    procedure UpdateStarfield;     procedure UpdateIn(ms: integer);   public    { public declarations }     procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);    end; var  Form1: TForm1;  implementation   {$R *.lfm}   { TForm1 }  procedure TForm1.FormCreate(Sender: TObject); begin  count :=0;  lastTime := Now;  VirtualScreen.Color := $d0d0ff;  Randomize;  ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);  FocalLength := 100.0;  FFieldDepth := 1000;  //col := 16382457; // default couleur  InitializeStarfield;    end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, 300); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);    Stars[i].Y := Random(ClientHeight);    Stars[i].Z := Random(FFieldDepth);    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire   end;end; procedure TForm1.UpdateStarfield;var  i: Integer; begin   for i := 0 to High(Stars) do  begin    // 3D    // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse    // 2D       Stars[i].X := Stars[i].X - Stars[i].Speed ;    // 3D    //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    //begin    //  Stars[i].X := Random(ClientWidth);    //  Stars[i].Y := Random(ClientHeight);    //  Stars[i].Z := FFieldDepth;    //  Stars[i].Speed := Random * 7 + 1;  //    //end;    // 2D     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := ClientWidth;      Stars[i].Y := Random(ClientHeight);      Stars[i].Speed := Random * 7 + 1;     end;  end;  end; procedure TForm1.Timer1Timer(Sender: TObject);begin  Timer1.Enabled := false;  VirtualScreen.DiscardBitmap;end;   procedure TForm1.VirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);var ctx: TBGRACanvas2D;  grainElapse: integer;  newTime: TDateTime;begin  newTime := Now;  timeGrainAcc += (newTime - lastTime)/timeGrain;  lastTime := newTime;  if timeGrainAcc < 1 then timeGrainAcc := 1;  if timeGrainAcc > 50 then timeGrainAcc := 50;  grainElapse := trunc(timeGrainAcc);  timeGrainAcc -= grainElapse;  ctx := Bitmap.Canvas2D;  ctx.save;  Star_field(ctx, grainElapse);   ctx.restore;end; procedure TForm1.UpdateIn(ms: integer); begin  Timer1.Interval := ms;  Timer1.Enabled := false;  Timer1.Enabled := true;   end; procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);var  i: Integer;  StarPosition: TPoint;  StarSize: Integer;  sttype : integer = 7;  col: TBGRAPixel;  begin   //ctx.fillStyle ('#000');   ctx.fillRect (0, 0, ctx.Width, ctx.Height);     ctx.fillStyle ('rgb(150,150,150)');     //ctx.antialiasing:= true;    for i := 0 to High(Stars) do   begin   //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);    //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);    /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur      case  (sttype)  of    1: col := BGRAGraphics.RGBToColor(50,50,50);    2: col := BGRAGraphics.RGBToColor(75,75,75);    3: col := BGRAGraphics.RGBToColor(100,100,100);    4: col := BGRAGraphics.RGBToColor(125,125,125);    5: col := BGRAGraphics.RGBToColor(150,150,150);    6: col := BGRAGraphics.RGBToColor(175,175,175);    7: col := BGRAGraphics.RGBToColor(200,200,200);    8: col := BGRAGraphics.RGBToColor(254,254,254);     end;    ctx.fillStyle (col);    ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);    //  end;   count := count +1;   if (count>150) then   begin   col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));   if(count>600) then count:=0;    end;    inc(sin_count);    ctx.fillStyle (col);   ctx.fontEmHeight := 40;   ctx.fontStyle:= [fsBold];   ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);   ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);    UpdateStarfield;   UpdateIn(5);end;   //Endend. ---------------------------------------------------------------------- TRon · 2024-03-31 07:55 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  BGRAVirtualScreen, BGRABitmap, BCTypes,  BGRACanvas2D; const  StarCount = 2500;  MaxSpeed  = 8; type  TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Image1: TImage;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    lastTime     : TDateTime;  timeGrainAcc : double;    count        : integer;    sin_count    : integer;    Stars        : array of TStar;    ScreenCenter : TPoint;  FocalLength  : Double;    FFieldDepth  : integer;    procedure InitializeStarfield;    procedure UpdateStarfield;    procedure UpdateIn(ms: integer);    procedure CreateLogo;    procedure CreateColours;  public    procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);  end; const  timeGrain = 15/1000/60/60/24; var  Form1: TForm1; implementation uses  BGRAGradientScanner,  BGRAGraphics,  BGRABitmapTypes; {$R *.lfm} var  StarColours  : array[1..maxSpeed] of TBGRAPixel;   { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  // On the form:  // - drop a TTimer  // - drop a BGRAVirtualScreen  // On the BGRAVirtualScreen:  // - Drop a Image   // init components  BGRAVirtualScreen1.Align := alClient;  CreateLogo;  Image1.Left := 100;  Image1.Top := 10;   CreateColours;  count :=0;  lastTime := Now;  BGRAVirtualScreen1.Color := $d0d0ff;  Randomize;  ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);  FocalLength := 100.0;  FFieldDepth := 1000;  //col := 16382457; // default couleur  InitializeStarfield;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  ctx: TBGRACanvas2D;  grainElapse: integer;  newTime: TDateTime;begin  newTime := Now;  timeGrainAcc += (newTime - lastTime)/timeGrain;  lastTime := newTime;  if timeGrainAcc < 1 then timeGrainAcc := 1;  if timeGrainAcc > 50 then timeGrainAcc := 50;  grainElapse := trunc(timeGrainAcc);  timeGrainAcc -= grainElapse;  ctx := Bitmap.Canvas2D;  ctx.save;  Star_field(ctx, grainElapse);   ctx.restore;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  Timer1.Enabled := false;  BGRAVirtualScreen1.DiscardBitmap;end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin  Stars[i].X := Random(ClientWidth);    Stars[i].Y := Random(ClientHeight);    Stars[i].Z := Random(FFieldDepth);    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin    // 3D    // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse    // 2D       Stars[i].X := Stars[i].X - Stars[i].Speed ;    // 3D    //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    //begin    //  Stars[i].X := Random(ClientWidth);    //  Stars[i].Y := Random(ClientHeight);    //  Stars[i].Z := FFieldDepth;    //  Stars[i].Speed := Random * 7 + 1;    //    //end;    // 2D     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := ClientWidth;    Stars[i].Y := Random(ClientHeight);      Stars[i].Speed := Random * 7 + 1;     end;  end;end; procedure TForm1.UpdateIn(ms: integer);begin  Timer1.Interval := ms;  Timer1.Enabled := false;  Timer1.Enabled := true;end; procedure TForm1.CreateLogo;var  bmp: TBGRABitmap;  grad: TBGRAGradientScanner;begin  bmp := TBGRABitmap.Create(550, 100); // eyeballing size  grad := TBGRAGradientScanner.Create(BGRA(255,55,0),BG RA(0,0,25),gtLinear,PointF(0,0),PointF(0,35),True,True);  bmp.FontHeight := 100;  bmp.FontAntialias := true;  bmp.FontStyle := [fsBold];  bmp.TextOut(1,1,'GIGATRON', ColorToBGRA(ColorToRGB(clYellow)));  // draw border  bmp.TextOut(2,2,'GIGATRON',grad);       // draw gradient text  grad.free;   Image1.AutoSize:= true;  Image1.Picture.Assign(bmp);  Image1.Picture.Bitmap.TransparentColor := clBlack;  Image1.Transparent := true;   // TODO: position of the image. But the position needs to change on a resize of the form anyhows.  bmp.free;end; procedure TForm1.CreateColours;var  index : integer;begin  for index := Low(StarColours) to High(StarColours) do    case index of      1: StarColours[index]:= BGRAGraphics.RGBToColor(50,50,50);      2: StarColours[index]:= BGRAGraphics.RGBToColor(75,75,75);      3: StarColours[index]:= BGRAGraphics.RGBToColor(100,100,100);      4: StarColours[index]:= BGRAGraphics.RGBToColor(125,125,125);      5: StarColours[index]:= BGRAGraphics.RGBToColor(150,150,150);      6: StarColours[index]:= BGRAGraphics.RGBToColor(175,175,175);      7: StarColours[index]:= BGRAGraphics.RGBToColor(200,200,200);      8: StarColours[index]:= BGRAGraphics.RGBToColor(254,254,254);    end;end; procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);var  i: Integer;  StarPosition: TPoint;  StarSize: Integer;  sttype : integer = 7;  col: TBGRAPixel;begin  //ctx.fillStyle ('#000');  ctx.fillRect (0, 0, ctx.Width, ctx.Height);  ctx.fillStyle('rgb(150,150,150)');   //ctx.antialiasing:= true;   for i := 0 to High(Stars) do  begin    //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);    //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur     col := StarColours[sttype]; {    case  (sttype)  of      1: col := BGRAGraphics.RGBToColor(50,50,50);      2: col := BGRAGraphics.RGBToColor(75,75,75);      3: col := BGRAGraphics.RGBToColor(100,100,100);      4: col := BGRAGraphics.RGBToColor(125,125,125);      5: col := BGRAGraphics.RGBToColor(150,150,150);      6: col := BGRAGraphics.RGBToColor(175,175,175);      7: col := BGRAGraphics.RGBToColor(200,200,200);      8: col := BGRAGraphics.RGBToColor(254,254,254);    end;}    ctx.fillStyle (col);    ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);    //  end;  count := count +1;  if (count>150) then  begin    col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));    if(count>600) then count:=0;  end;   inc(sin_count);   ctx.fillStyle (col);  ctx.fontEmHeight := 40;  ctx.fontStyle:= [fsBold];  ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);  ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);   UpdateStarfield;  UpdateIn(5);end; end.  2500 stars without issues on this tiny machine here ---------------------------------------------------------------------- circular · 2024-03-31 09:49 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  AsyncProcess, BGRAVirtualScreen, BGRABitmap, BCTypes, BGRACanvas2D; const  StarCount = 2500;  MaxSpeed  = 8; type  TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Image1: TImage;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    lastTime     : TDateTime;  timeGrainAcc : double;    count        : integer;    sin_count    : integer;    Stars        : array of TStar;    ScreenCenter : TPoint;  FocalLength  : Double;    FFieldDepth  : integer;    procedure InitializeStarfield;    procedure UpdateStarfield;    procedure UpdateIn(ms: integer);    procedure CreateLogo;    procedure CreateColours;  public    procedure Star_field(ctx: TBGRACanvas2D; grainElapse: integer);  end; const  timeGrain = 15/1000/60/60/24; var  Form1: TForm1; implementation uses  BGRAGradientScanner,  BGRAGraphics,  BGRABitmapTypes,  BGRAUTF8; {$R *.lfm} var  StarColours  : array[1..maxSpeed] of TBGRAPixel;   { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  // On the form:  // - drop a TTimer  // - drop a BGRAVirtualScreen  // On the BGRAVirtualScreen:  // - Drop a Image   // init components  BGRAVirtualScreen1.Align := alClient;  CreateLogo;  Image1.Left := 100;  Image1.Top := 10;  ClientWidth := 800;  ClientHeight := 600;   CreateColours;  count :=0;  lastTime := Now;  BGRAVirtualScreen1.Color := $d0d0ff;  Randomize;  ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);  FocalLength := 100.0;  FFieldDepth := 1000;  //col := 16382457; // default couleur  InitializeStarfield;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  ctx: TBGRACanvas2D;  grainElapse: integer;  newTime: TDateTime;begin  newTime := Now;  timeGrainAcc += (newTime - lastTime)/timeGrain;  lastTime := newTime;  if timeGrainAcc < 1 then timeGrainAcc := 1;  if timeGrainAcc > 50 then timeGrainAcc := 50;  grainElapse := trunc(timeGrainAcc);  timeGrainAcc -= grainElapse;  ctx := Bitmap.Canvas2D;  ctx.save;  Star_field(ctx, grainElapse);   ctx.restore;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  Timer1.Enabled := false;  BGRAVirtualScreen1.DiscardBitmap;end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin  Stars[i].X := Random(ClientWidth);    Stars[i].Y := Random(ClientHeight);    Stars[i].Z := Random(FFieldDepth);    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin    // 3D    // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse    // 2D       Stars[i].X := Stars[i].X - Stars[i].Speed ;    // 3D    //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    //begin    //  Stars[i].X := Random(ClientWidth);    //  Stars[i].Y := Random(ClientHeight);    //  Stars[i].Z := FFieldDepth;    //  Stars[i].Speed := Random * 7 + 1;    //    //end;    // 2D     if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := ClientWidth;    Stars[i].Y := Random(ClientHeight);      Stars[i].Speed := Random * 7 + 1;     end;  end;end; procedure TForm1.UpdateIn(ms: integer);begin  Timer1.Interval := ms;  Timer1.Enabled := false;  Timer1.Enabled := true;end; procedure TForm1.CreateLogo;var  bmp: TBGRABitmap;  grad: TBGRAGradientScanner;begin  bmp := TBGRABitmap.Create(550, 100); // eyeballing size  grad := TBGRAGradientScanner.Create(BGRA(255,55,0),BG RA(0,0,25),gtLinear,PointF(0,0),PointF(0,35),True,True);  bmp.FontHeight := 100;  bmp.FontAntialias := true;  bmp.FontStyle := [fsBold];  bmp.TextOut(1,1,'GIGATRON', ColorToBGRA(ColorToRGB(clYellow)));  // draw border  bmp.TextOut(2,2,'GIGATRON',grad);       // draw gradient text  grad.free;   Image1.AutoSize:= true;  Image1.Picture.Assign(bmp);  Image1.Picture.Bitmap.TransparentColor := clBlack;  Image1.Transparent := true;   // TODO: position of the image. But the position needs to change on a resize of the form anyhows.  bmp.free;end; procedure TForm1.CreateColours;var  index : integer;begin  for index := Low(StarColours) to High(StarColours) do    case index of      1: StarColours[index]:= BGRAGraphics.RGBToColor(50,50,50);      2: StarColours[index]:= BGRAGraphics.RGBToColor(75,75,75);      3: StarColours[index]:= BGRAGraphics.RGBToColor(100,100,100);      4: StarColours[index]:= BGRAGraphics.RGBToColor(125,125,125);      5: StarColours[index]:= BGRAGraphics.RGBToColor(150,150,150);      6: StarColours[index]:= BGRAGraphics.RGBToColor(175,175,175);      7: StarColours[index]:= BGRAGraphics.RGBToColor(200,200,200);      8: StarColours[index]:= BGRAGraphics.RGBToColor(254,254,254);    end;end; procedure WavyText(ctx: TBGRACanvas2D; AText: string; X,Y,  AWavePosDeg, AWaveStepDeg, AWaveSize: single);var cursor : TGlyphCursorUtf8;  glyph: TGlyphUtf8;  glyphText: string;begin  cursor := TGlyphCursorUtf8.New(AText, fbmAuto);  while not cursor.EndOfString do  begin    glyph := cursor.GetNextGlyph;    if glyph.MirroredGlyphUtf8 <> '' then      glyphText := glyph.MirroredGlyphUtf8    else      glyphText := glyph.GlyphUtf8;    ctx.fillText(glyphText, x,y + AWaveSize*Sin(AWavePosDeg*Pi/180));    x += ctx.measureText(glyphText).width;    AWavePosDeg += AWaveStepDeg;  end;end; procedure TForm1.Star_field(ctx: TBGRACanvas2D; grainElapse: integer);var  i: Integer;  StarPosition: TPoint;  StarSize: Integer;  sttype : integer = 7;  col: TBGRAPixel;begin  //ctx.fillStyle ('#000');  ctx.fillRect (0, 0, ctx.Width, ctx.Height);  ctx.fillStyle('rgb(150,150,150)');   //ctx.antialiasing:= true;   for i := 0 to High(Stars) do  begin    //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);    //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur     col := StarColours[sttype]; {    case  (sttype)  of      1: col := BGRAGraphics.RGBToColor(50,50,50);      2: col := BGRAGraphics.RGBToColor(75,75,75);      3: col := BGRAGraphics.RGBToColor(100,100,100);      4: col := BGRAGraphics.RGBToColor(125,125,125);      5: col := BGRAGraphics.RGBToColor(150,150,150);      6: col := BGRAGraphics.RGBToColor(175,175,175);      7: col := BGRAGraphics.RGBToColor(200,200,200);      8: col := BGRAGraphics.RGBToColor(254,254,254);    end;}    ctx.fillStyle (col);    ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);    //  end;  count := count +1;  if (count>150) then  begin    col := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));    if(count>600) then count:=0;  end;   inc(sin_count);   ctx.fillStyle (col);  ctx.fontEmHeight := 40;  ctx.fontStyle:= [fsBold];   WavyText(ctx,'PRESENTS',280+30*sin(sin_count/10),200,    180*sin(sin_count/13), 40, 20);  WavyText(ctx,'LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400,    180*sin(sin_count/17), 20, 40);   UpdateStarfield;  UpdateIn(5);end; end. ---------------------------------------------------------------------- Gigatron · 2024-03-31 17:30 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 · 2024-04-03 23:56 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, MPlayerCtrl,  BGRABitmap, BGRACanvas2D, BGRABitmapTypes, BGRATextFX,mmsystem; const  StarCount = 300;  MaxSpeed  = 6; type    TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;     { TForm1 }   TForm1 = class(TForm)  Timer1: TTimer;     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);   private       const dat : Array [0..110] of Int16 = (-400,-60,0,-340,-60,0,-340,0,0,-400,0,0,-400,60,0,       -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,       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,       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,       60,0,220,60,0,252,-60,0,280,60,0);   private    Stars      : array of TStar;    ScreenCenter : TPoint;    FocalLength  : Double;    FFieldDepth  : integer;    procedure   CreateColours;    procedure InitializeStarfield;    procedure UpdateStarfield;   public    MyFile: AnsiString;    WavStream : TMemoryStream;    procedure Update_Demo;    procedure Init();    end; var  Form1: TForm1;  ctx: TBGRACanvas2D;  count : integer;  bmp : TBGRABitmap;    cx : integer = 400;  cy : integer = 256;  cz : integer = 140;  cs : integer = 0;  xr : double = 0;  yr : double = 0;  zr : integer = 0;  StarColours  : array[1..maxSpeed] of TBGRAPixel;   implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin    MyFile := Application.Location + 'paranoimia.wav';    WavStream := TMemoryStream.Create;    WavStream.LoadFromFile(MyFile);    PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);     Init();end; procedure TForm1.FormDestroy(Sender: TObject); begin       WavStream.Free;end;  procedure TForm1.Init();begin   Randomize;  ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);  FocalLength := 100.0;  FFieldDepth := 1000;  CreateColours;  InitializeStarfield;end;procedure TForm1.CreateColours;var  index : integer;begin  for index := Low(StarColours) to High(StarColours) do    case index of      1: StarColours[index]:= BGRA(50,50,50);      2: StarColours[index]:= BGRA(75,75,75);      3: StarColours[index]:= BGRA(100,100,100);      4: StarColours[index]:= BGRA(125,125,125);      5: StarColours[index]:= BGRA(150,150,150);      6: StarColours[index]:= BGRA(175,175,175);      7: StarColours[index]:= BGRA(200,200,200);    8: StarColours[index]:= BGRA(254,254,254);    end;end;procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin  Stars[i].X := Random(ClientWidth);    Stars[i].Y := Random(ClientHeight);    Stars[i].Z := 0.1+Random(FFieldDepth);  // div / 0 !! if not !    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end;procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin    // 3D      Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse     if Stars[i].Z < 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := Random(ClientWidth);      Stars[i].Y := Random(ClientHeight);      Stars[i].Z := 0.1+Random(FFieldDepth);      Stars[i].Speed := Random * 7 + 1;     end;  end;end;  procedure TForm1.Update_Demo();var    i, j : integer ;    x, y, z, xa, ya : double;    xc, xs, yc, ys, zc, zs : double ;    px,py :  array [0..110]  of integer;     couleur: TBGRAPixel;    // st    st : integer;    sttype : integer = 7;    col: TBGRAPixel;    StarPosition: TPoint;  begin  bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, clBtnFace);  ctx := bmp.Canvas2D;   i:=0;  j:=0;  x:=0;  y:=0;  z:=0;  xc :=0;  xs :=0;  yc :=0;  ys :=0;  zc :=0;  zs :=0;   xc := cos(xr);  xs := sin(xr);  yc := cos(yr);  ys := sin(yr);  zc := cos(zr);  zs := sin(zr);    ctx.fillRect(0,0,ClientWidth, ClientHeight);   ctx.fillStyle (BGRA(0, 0, 220, 255));                ctx.fillRect(0,25,ClientWidth,30);              ctx.fillRect(0,460,ClientWidth,30);  bmp.FontName:='paranoimia';  bmp.TextOut(820-count,466,'PARANOIMIA   PRESENTS     !!!     SHINOBI      WHAT     A     PRIMITIVE     PROTECTION  !!!!!!   NOTE   DO   NOT   CHANGE   ANYTHING   ON   TRACK 0                 ',BGRA(255,255,255));  bmp.TextOut(820-count,30, 'PARANOIMIA     PRESENTS     !!!     SHINOBI      WHAT     A     PRIMITIVE     PROTECTION  !!!!!!   NOTE   DO   NOT   CHANGE   ANYTHING   ON   TRACK   0                 ',BGRA(255,255,255));    // starfield   for st := 0 to High(Stars) do  begin    StarPosition.X := Round((Stars[st].X - ScreenCenter.X) * (FocalLength / Stars[st].Z) + ScreenCenter.X);    StarPosition.Y := Round((Stars[st].Y - ScreenCenter.Y) * (FocalLength / Stars[st].Z) + ScreenCenter.Y);     sttype := Round(Stars[st].Speed);    col := StarColours[sttype];    ctx.fillStyle (col);    ctx.fillRect(StarPosition.X, StarPosition.Y,2,2);    // end stars !!  end;      for i := 0 to High(dat) do    begin        x := dat[j];        y := dat[j+1];      z := dat[j+2];        j := j +3;         ya := (y * xc) + (z * xs);      z := (z * xc) - (y * xs);        y := ya;        xa := (x * yc) + (z * ys);        z := (z * yc) - (x * ys);        x := xa;         xa := (x * zc) - (y * zs);        y := (y * zc) + (x * zs);        x := xa;         z := 256 / (869 + z);         x := round(x * z) shl(8);      y := round(y * z) shl(8);         z := z + cz;        px[i] := round((x / z) + cx) ;//&0xffff;        py[i] := round((y / z) + cy) ; //&0xffff;         end;          xr := xr - 0.04;         yr := yr + 0.03;    couleur := BGRA(255, 255, 255, 255);  // P   logo vertex draw !  bmp.DrawLineAntialias(px[0],py[0],px[1],py[1], couleur,2);  bmp.DrawLineAntialias(px[1],py[1],px[2],py[2], couleur,2);  bmp.DrawLineAntialias(px[2],py[2],px[3],py[3], couleur,2);  bmp.DrawLineAntialias(px[3],py[3],px[4],py[4], couleur,2);  bmp.DrawLineAntialias(px[4],py[4],px[0],py[0], couleur,2);  //A  bmp.DrawLineAntialias(px[5],py[5],px[6],py[6],couleur,2);  bmp.DrawLineAntialias(px[6],py[6],px[7],py[7],couleur,2);  //R  bmp.DrawLineAntialias(px[8],py[8],px[9],py[9],couleur,2);  bmp.DrawLineAntialias(px[9],py[9],px[10],py[10],couleur,2);  bmp.DrawLineAntialias(px[10],py[10],px[11],py[11],couleur,2);  bmp.DrawLineAntialias(px[11],py[11],px[12],py[12],couleur,2);  bmp.DrawLineAntialias(px[12],py[12],px[8],py[8],couleur,2);  bmp.DrawLineAntialias(px[11],py[11],px[13],py[13],couleur,2);  //A  bmp.DrawLineAntialias(px[14],py[14],px[15],py[15],couleur,2);  bmp.DrawLineAntialias(px[15],py[15],px[16],py[16],couleur,2);  //N  bmp.DrawLineAntialias(px[17],py[17],px[18],py[18],couleur,2);  bmp.DrawLineAntialias(px[17],py[17],px[20],py[20],couleur,2);  bmp.DrawLineAntialias(px[19],py[19],px[20],py[20],couleur,2);  //O  bmp.DrawLineAntialias(px[21],py[21],px[22],py[22],couleur,2);  bmp.DrawLineAntialias(px[22],py[22],px[23],py[23],couleur,2);  bmp.DrawLineAntialias(px[23],py[23],px[24],py[24],couleur,2);  bmp.DrawLineAntialias(px[24],py[24],px[21],py[21],couleur,2);  //I  bmp.DrawLineAntialias(px[25],py[25],px[26],py[26],couleur,2);  //M  bmp.DrawLineAntialias(px[28],py[28],px[27],py[27],couleur,2);  bmp.DrawLineAntialias(px[27],py[27],px[29],py[29],couleur,2);  bmp.DrawLineAntialias(px[29],py[29],px[30],py[30],couleur,2);  bmp.DrawLineAntialias(px[30],py[30],px[31],py[31],couleur,2);  //I  bmp.DrawLineAntialias(px[32],py[32],px[33],py[33],couleur,2);  //A  bmp.DrawLineAntialias(px[34],py[34],px[35],py[35],couleur,2);  bmp.DrawLineAntialias(px[35],py[35],px[36],py[36],couleur,2);  //     bmp.Draw(Canvas,0,0);  bmp.Free; end;  procedure TForm1.Timer1Timer(Sender: TObject);begin       count := count + 4;     if (count>3000) then count :=0;       Update_Demo;       UpdateStarfield;end;   end. ---------------------------------------------------------------------- circular · 2024-04-04 08:01 Cool ---------------------------------------------------------------------- DrakkTheSeafarer · 2024-04-04 11:47 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 · 2024-04-04 15:56 Quote from: DrakkTheSeafarer on April 04, 2024, 01:47:24 pmhello, 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 · 2024-04-04 18:26 Quote from: Gigatron on April 04, 2024, 01:56:57 amI 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. QuoteHere 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen, BGRABitmap, BGRACanvas2D;  type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    lastTime     : TDateTime;    timeGrainAcc : double;    ScreenCenter : TPoint;    FocalLength  : Double;    FFieldDepth  : integer;    procedure UpdateIn(ms: integer);  public  procedure Render(ctx: TBGRACanvas2D; grainElapse: integer);  end; const  timeGrain = 15/1000/60/60/24; var  Form1: TForm1; implementation uses  demo_effects;  {$R *.lfm} var  Logo      : TStaticLogo;  StarField : T2DStarfield;  Wavy1     : TWavyText;  Wavy2     : TWavyText;  { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  // On the form:  // - drop a TTimer  // - drop a BGRAVirtualScreen  // ToDo: create at runtime   BGRAVirtualScreen1.Align := alClient;  BGRAVirtualScreen1.Color := $d0d0ff;  ClientWidth  := 800;  ClientHeight := 600;  ScreenCenter := Point(ClientWidth div 2, ClientHeight div 2);   lastTime     := Now;  Randomize;  FocalLength  := 100.0;  FFieldDepth  := 1000;   // Create demo effect classes  Logo      := TStaticLogo.Create(BGRAVirtualScreen1);  StarField := T2DStarfield.Create(Bounds(0, 0, 800, 600));  Wavy1     := TWavyText.Create;  Wavy2     := TWavyText.Create;   // Initialize demo effects  Logo.Initialize;  StarField.Initialize;  Wavy1.Initialize('PRESENTS'                 , Point(280, 200),  30);  Wavy2.Initialize('LAZARUS 2D STARFIELD DEMO', Point( 80, 400), -30);end;  procedure TForm1.FormDestroy(Sender: TObject);begin  // Destroy demo effect classes  Logo.Free;  StarField.Free;  Wavy1.Free;  Wavy2.Free;end;  procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  ctx: TBGRACanvas2D;  grainElapse: integer;  newTime: TDateTime;begin  newTime := Now;  timeGrainAcc += (newTime - lastTime)/timeGrain;  lastTime := newTime;  if timeGrainAcc < 1  then timeGrainAcc := 1;  if timeGrainAcc > 50 then timeGrainAcc := 50;  grainElapse := trunc(timeGrainAcc);  timeGrainAcc -= grainElapse;   ctx := Bitmap.Canvas2D;  ctx.save;  Render(ctx, grainElapse);  ctx.restore;end;  procedure TForm1.Timer1Timer(Sender: TObject);begin  Timer1.Enabled := false;  BGRAVirtualScreen1.DiscardBitmap;end;  procedure TForm1.UpdateIn(ms: integer);begin  Timer1.Interval := ms;  Timer1.Enabled := false;  Timer1.Enabled := true;end;  procedure TForm1.Render(ctx: TBGRACanvas2D; grainElapse: integer);begin  ctx.fillRect (0, 0, ctx.Width, ctx.Height);  ctx.fillStyle('rgb(150,150,150)');   StarField.Render(ctx);   Wavy1.Update;  Wavy2.Update;  Wavy1.Render(ctx);  Wavy2.Render(ctx);   StarField.Update;   UpdateIn(5);end; end.  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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit demo_effects; interface uses  types,  BGRAVirtualScreen, BGRABitmapTypes, BGRACanvas2D; type  TArea = TRect;   { TStaticLogo }   TStaticLogo = class   private    FOwner    : TBGRAVirtualScreen;  FLogoText : string;   public    constructor Create(aOwner: TBGRAVirtualScreen);   public    procedure Initialize;    procedure Update;    procedure Render;  end;    { T2d_Starfield }   T2DStarField = class   private   type     T2DStar = record     X, Y, Z: Double;     Speed:   Double;   end;   private    FArea         : TArea;    FStars        : array of T2DStar;    FSpeedColours : array of TBGRAPixel;    FStarCount    : integer;    FMaxSpeed     : integer;    FFieldDepth   : integer;   public    constructor Create(aArea:TArea);   public    procedure Initialize;    procedure Update;    procedure Render(aCanvas: TBGRACanvas2D);  end;    { TWavyText }   TWavyText = class   private    FAmplitude  : integer;    FStartFrame : integer;  FStopFrame  : integer;    FText       : string;    FCount      : integer;    FSinCount   : integer;    FCol        : TBGRAPixel;    FPoint      : TPoint;  public    constructor Create;   public    procedure Initialize(aText: string; aPoint: TPoint; aAmplitude: integer);    procedure Update;    procedure Render(aCanvas: TBGRACanvas2D);  end;    implementation  uses  Graphics, ExtCtrls,  BGRAGraphics,  BGRABitmap,  BGRAGradientScanner;              {                   }            {     TStaticLogo     }            {                   } constructor TStaticLogo.Create(aOwner: TBGRAVirtualScreen);begin  inherited Create;  FOwner := aOwner;  FLogoText := 'GIGATRON';end; procedure TStaticLogo.Update;begin  // intentionally left emptyend; procedure TStaticLogo.Render;begin  // intentionally left emptyend; procedure TStaticLogo.Initialize;const  ShadeSize = 1;var  bmp       : TBGRABitmap;  grad      : TBGRAGradientScanner;  Image1    : TImage;  TextSize  : TSize;  TextCoord : TPoint;begin  bmp  := TBGRABitmap.Create;  grad := TBGRAGr adientScanner.Create(BGRA(255,55,0),BGRA(0,0,25),gtLinear,PointF(0,0), PointF(0,35),True,True);   bmp.FontHeight    := 100;  bmp.FontAntialias := true;  bmp.FontStyle     := [fsBold];  // get text dimensions  TextSize := bmp.TextSize(FLogoText);  // set size of bitmap  bmp.SetSize(TextSize.Width + ShadeSize, TextSize.Height + ShadeSize);  // clear bitmap  bmp.FillRect(0,0, bmp.Width, bmp.Height, BGRA(0,0,0));  // set text coordinates  TextCoord.X:= 0; TextCoord.Y:= 0;  // draw shade  bmp.TextOut(TextCoord.X, TextCoord.Y, FLogoText, ColorToBGRA(ColorToRGB(clYellow)));  // draw gradient text  bmp.TextOut(TextCoord.X + ShadeSize, TextCoord.Y + ShadeSize, FLogoText, grad);  grad.free;   // create and set image  Image1 := TImage.Create(FOwner);  Image1.Parent := FOwner;  Image1.AutoSize := true;  Image1.Picture.Assign(bmp);  Image1.Picture.Bitmap.TransparentColor := clBlack;  Image1.Transparent := true;   Image1.Top  := 10;  // still not entirely properly centered  Image1.Left := (FOwner.ClientWidth - Image1.Width) shr 1;  bmp.free;end;              {                      }            {     T2DStarField     }            {                      }  constructor T2DStarField.Create(aArea:TArea);begin  FStarCount := 300;  FMaxSpeed  := 8;  FFieldDepth := 1000;  FArea := aArea;end; procedure T2DStarField.Render(aCanvas: TBGRACanvas2D);var  index        : integer;  StarPosition : TPoint;  sttype       : integer = 7;  col        : TBGRAPixel;begin  for index := Low(FStars) to High(FStars) do  begin    //StarPosition.X := Round((Stars[i].X - ScreenCenter.X) * (FocalLength / Stars[i].Z) + ScreenCenter.X);    //StarPosition.Y := Round((Stars[i].Y - ScreenCenter.Y) * (FocalLength / Stars[i].Z) + ScreenCenter.Y);     StarPosition.X := Round(FStars[index].X );    StarPosition.Y := Round(FStars[index].Y);    sttype := Round(FStars[index].Speed);     /// StarSize := Round(1.0 / (Stars[i].Z / 100.0)); // Taille de l'étoile basée sur la profondeur     col := FSpeedColours[sttype];    aCanvas.fillStyle (col);    aCanvas.fillRect(StarPosition.X, StarPosition.Y,2,2);  end;end; procedure T2DStarField.Initialize;var  index: Integer;begin  // init stars  SetLength(FStars, FStarCount); // Nombre d'étoiles  for index := Low(FStars) to High(FStars) do  begin    FStars[index].X := Random(FArea.Width);    FStars[index].Y := Random(FArea.Height);    FStars[index].Z := Random(FFieldDepth);    FStars[index].Speed := Random * Pred(FMaxSpeed) + 1; // Vitesse aléatoire  end;   // init speedcolours  SetLength(FSpeedColours, Succ(FMaxSpeed)); // Nombre d'étoiles   for index := Low(FSpeedColours) to High(FSpeedColours) do    case index of      0: FSpeedColours[index]:= BGRAGraphics.RGBToColor(0,0,0);      1: FSpeedColours[index]:= BGRAGraphics.RGBToColor(50,50,50);      2: FSpeedColours[index]:= BGRAGraphics.RGBToColor(75,75,75);      3: FSpeedColours[index]:= BGRAGraphics.RGBToColor(100,100,100);      4: FSpeedColours[index]:= BGRAGraphics.RGBToColor(125,125,125);      5: FSpeedColours[index]:= BGRAGraphics.RGBToColor(150,150,150);      6: FSpeedColours[index]:= BGRAGraphics.RGBToColor(175,175,175);      7: FSpeedColours[index]:= BGRAGraphics.RGBToColor(200,200,200);      8: FSpeedColours[index]:= BGRAGraphics.RGBToColor(254,254,254);    end;end; procedure T2DStarField.Update;var  index: integer;begin  for index := low(FStars) to High(FStars) do  begin    // 3D    // Stars[i].Z := Stars[i].Z - Stars[i].Speed ; // Déplacement selon la vitesse    // 2D       FStars[index].X := FStars[index].X - FStars[index].Speed ;  // 3D    //if Stars[i].Z <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    //begin    //  Stars[i].X := Random(ClientWidth);    //  Stars[i].Y := Random(ClientHeight);    //  Stars[i].Z := FFieldDepth;    //  Stars[i].Speed := Random * 7 + 1;  //    //end;    // 2D     if FStars[index].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin//      FStars[index].X := ClientWidth;//      FStars[index].Y := Random(ClientHeight);//      FStars[index].X := 800;//      FStars[index].Y := Random(600);      FStars[index].X := FArea.Width;      FStars[index].Y := Random(FArea.Height); //      FStars[index].Speed := Random * 7 + 1;//      FStars[index].Speed := Random * Pred(FMaxSpeed) + 1;//      FStars[index].Speed := Succ(Random * Pred(FMaxSpeed));      FStars[index].Speed := Random * Pred(FMaxSpeed) + 1;    end;  end;end;              {                 }            {     TWavyText     }            {                   }  constructor TWavyText.Create;begin  inherited create;   FStartFrame:= 150;  FStopFrame:= 600;  FSinCount := 0;  FCount    := 0;  FText     := '';  FCol      :=  BGRA(150,150,150);end; procedure TWavyText.Initialize(aText: string; aPoint: TPoint; aAmplitude: integer);begin  FText      := atext;  FPoint := aPoint;  FAmplitude := aAmplitude;end; procedure TWavyText.Update;begin  FCount := FCount+1;  if (FCount>FStartFrame) then  begin    FCol := BGRAGraphics.RGBToColor(Round(Random * 255),Round(Random * 255),Round(Random * 255));    if (FCount>FStopFrame) then FCount:=0;  end;   inc(FSinCount);end; procedure TWavyText.Render(aCanvas: TBGRACanvas2D);begin  aCanvas.fillStyle(FCol);  aCanvas.fontEmHeight := 40;  aCanvas.fontStyle:= [fsBold];  aCanvas.fillText(FText,FPoint.X+FAmplitude*sin(FSinCount/10), FPoint.Y);   (*   ctx.fillStyle (col);   ctx.fontEmHeight := 40;   ctx.fontStyle:= [fsBold];   ctx.fillText('PRESENTS',280+30*sin(sin_count/10),200);   ctx.fillText('LAZARUS 2D STARFIELD DEMO',80-30*sin(sin_count/10),400);  *)end; end.  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 · 2024-04-04 19:17 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 · 2024-04-04 19:36 Quote from: Gigatron on April 04, 2024, 01:56:57 amHere 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 · 2024-04-04 21:21 Quote from: KodeZwerg on April 04, 2024, 09:17:53 pmWhat 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. QuoteMay the guru meditation be kind with you  Oh, you familiar with him ? He usually ain't very nice to me ---------------------------------------------------------------------- KodeZwerg · 2024-04-05 01:38 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls; type  TStar = packed record    X,    Y,    Z: Integer;  end;  TStars = array of TStar; const  CMaxStars = UInt32(5000); type  { TForm1 }   TForm1 = class(TForm)    Image1: TImage;    Timer1: TTimer;    procedure FormCreate(Sender: TObject);    procedure FormResize(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  strict private    FStars: TStars;    FLayers: Integer;  private    procedure InitStars;  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  InitStars;end; procedure TForm1.FormResize(Sender: TObject);begin  InitStars;end; procedure TForm1.Timer1Timer(Sender: TObject);var  LBmp: TBitmap;  i: Integer;  StarColor: TColor;begin  LBmp := TBitmap.Create;  try    LBmp.Width := Self.Image1.Width;    LBmp.Height := Self.Image1.Height;    LBmp.PixelFormat := pf32bit;    LBmp.Canvas.Brush.Color := clBlack;    LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));     for i := Low(FStars) to High(FStars) do      begin        StarColor := RGBToColor(           Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers)),           Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers)),           Round(255 + (16 - 255) * (Succ(FStars[i].Z) / FLayers))         );        LBmp.Canvas.Brush.Color := StarColor;        LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, FStars[i].X + 1, FStars[i].Y + 1));        FStars[i].X := FStars[i].X - Succ(FStars[i].Z);        if FStars[i].X <= 0 then          begin          FStars[i].X := LBmp.Width;            FStars[i].Y := Random(LBmp.Height);            FStars[i].Z := Random(FLayers);        end;      end;    Image1.Picture.Bitmap.Assign(LBmp);  finally    LBmp.Free;  end;end; procedure TForm1.InitStars;var  i: Integer;begin  FLayers := Random(10) + 5;  SetLength(FStars, CMaxStars);  for i := Low(FStars) to High(FStars) do    begin      FStars[i].X := Random(Self.Image1.Width);      FStars[i].Y := Random(Self.Image1.Height);      FStars[i].Z := Random(FLayers);    end;  Timer1.Enabled := True;end; end. ---------------------------------------------------------------------- KodeZwerg · 2024-04-05 12:53 Based on my prior post heres a small demo that shows a starfield class. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit kz.StarField; (*  Starfield (ball) simulation class by KodeZwerg in 2024  Uses slow LCL, not Hardware accelerated, single thread  Royalty free (c) by KodeZwerg   it supports...  - double buffered, no flicker  - random layers to control the speed per star    as more layers you allow to be used, as faster the top stars fly  - integrated a grey scaled colormap generation for fast fixed colors or complete random generated  - partly individual scroll direction (left, right, top, bottom)    Todo: replace direction mode with an angle  - random sized stars for values higher than 1  - background color is adjustable  - random positioned stars  Todo:    add transparency switch so the background become invisible    maby add Z-Order drawing, currently whats drawn is drawn   Usage:  1. Create an instance of the class by telling target dimension  2. Set your preffered options, defaults should be ok  3. Use a timer to generate/update a Bitmap for your usage by calling "Next"  additional  4. Use a resize event to update width/height of class  optional  5. draw text or other image data on that image before displaying it*) {$mode ObjFPC}{$H+} interface uses  Classes, SysUtils, Graphics; type   { TkzStarField }   TStarDirection = (sdLeft, sdRight, sdTop, sdBottom);  TkzStarField = class(TObject)  strict private      type        TOneStar = packed record          X,          Y,          Z,          Size: Integer;          Color: TColor;        end;        TAllStars = array of TOneStar;        TColors = array of TColor;    strict private      FHeight: Integer;    FStars: TAllStars;      FColors: TColors;      FLayers: Integer;    FBitmap: TBitmap;      FMaxStars: Integer;      FWidth: Integer;    FHeigth: Integer;      FRandomColors: Boolean;      FDirection: TStarDirection;      FBackground: TColor;    strict private      FMaxSize: Integer;      procedure SetBackground(const AValue: TColor);      procedure SetDirection(const AValue: TStarDirection);    procedure SetHeight(const AValue: Integer);      procedure SetLayers(const AValue: Integer);      procedure SetMaxSize(const AValue: Integer);      procedure SetRandomColors(const AValue: Boolean);      procedure SetStars(const AValue: Integer);      procedure SetWidth(const AValue: Integer);    public      constructor Create(const AWidth, AHeigth: Integer);      destructor Destroy; override;      function Reinitialize: Boolean;      function Next: Boolean;    published      property Bitmap: TBitmap read FBitmap;    property Layers: Integer read FLayers write SetLayers default 10;    property MaxStars: Integer read FMaxStars write SetStars default 100;      property MaxSize: Integer read FMaxSize write SetMaxSize default 1;      property Width: Integer read FWidth write SetWidth default 800;      property Height: Integer read FHeight write SetHeight default 600;      property RandomColors: Boolean read FRandomColors write SetRandomColors default True;      property Direction: TStarDirection read FDirection write SetDirection default sdRight;    property Background: TColor read FBackground write SetBackground default clBlack;  end; implementation { TkzStarField } constructor TkzStarField.Create(const AWidth, AHeigth: Integer);begin  inherited Create;  Randomize;  FBitmap := TBitmap.Create;  FBitmap.PixelFormat := pf32bit;  FWidth := AWidth;  FHeight := AHeigth;  FLayers := 10;  FMaxStars := 100;  FMaxSize := 1;  FRandomColors := True;  FDirection := sdRight;  FBackground := clBlack;  Reinitialize;end; destructor TkzStarField.Destroy;begin  FBitmap.Free;  inherited Destroy;end; function TkzStarField.Reinitialize: Boolean;var  i: Integer;begin  Result := False;  SetLength(FStars, FMaxStars);  SetLength(FColors, FLayers);  FBitmap.Width := FWidth;  FBitmap.Height := FHeigth;  for i := Low(FColors) to High(FColors) do    begin      FColors[i] := RGBToColor(           Round(255 + (16 - 255) * (Succ(i) / FLayers)),           Round(255 + (16 - 255) * (Succ(i) / FLayers)),           Round(255 + (16 - 255) * (Succ(i) / FLayers))         );    end;  for i := Low(FStars) to High(FStars) do    begin      FStars[i].X := Succ(Random(FWidth));      FStars[i].Y := Succ(Random(FHeight));      FStars[i].Z := Random(FLayers);      FStars[i].Size := Succ(Random(FMaxSize));      if FRandomColors then      FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))      else        FStars[i].Color := FColors[Random(Length(FColors))];    end;  Result := True;end; function TkzStarField.Next: Boolean;var  LBmp: TBitmap;  i: Integer;begin  Result := False;  LBmp := TBitmap.Create;  try    LBmp.PixelFormat := pf32bit;    LBmp.Width := FWidth;    LBmp.Height := FHeight;    LBmp.Canvas.Brush.Color := FBackground;    LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));    for i := Low(FStars) to High(FStars) do      begin        LBmp.Canvas.Brush.Color := FStars[i].Color;        // draw a rectangle (dot) or a circle        if FStars[i].Size <= 1 then          LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X), Succ(FStars[i].Y)))        else          LBmp.Canvas.Ellipse(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X + FStars[i].Size), Succ(FStars[i].Y + FStars[i].Size)));        // move a star        if FDirection = sdLeft then          begin            FStars[i].X := FStars[i].X - Succ(FStars[i].Z);            if FStars[i].X < 0 - (FStars[i].Size + FStars[i].Size) then              begin                FStars[i].X := LBmp.Width + (FStars[i].Size + FStars[i].Size);                FStars[i].Y := Succ(Random(LBmp.Height));                FStars[i].Z := Random(FLayers);                FStars[i].Size := Succ(Random(FMaxSize));                if FRandomColors then                FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))                else                FStars[i].Color := FColors[Random(Length(FColors))];            end;          end;        if FDirection = sdRight then          begin            FStars[i].X := FStars[i].X + Succ(FStars[i].Z);          if FStars[i].X > LBmp.Width + (FStars[i].Size + FStars[i].Size) then              begin                FStars[i].X := 0 - (FStars[i].Size + FStars[i].Size);                FStars[i].Y := Succ(Random(LBmp.Height));                FStars[i].Z := Random(FLayers);                FStars[i].Size := Succ(Random(FMaxSize));                if FRandomColors then                FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))                else                FStars[i].Color := FColors[Random(Length(FColors))];            end;          end;        if FDirection = sdTop then          begin          FStars[i].Y := FStars[i].Y - Succ(FStars[i].Z);            if FStars[i].Y < (0 - (FStars[i].Size + FStars[i].Size)) then            begin                FStars[i].X := Succ(Random(LBmp.Width));              FStars[i].Y := LBmp.Height + (FStars[i].Size + FStars[i].Size);                FStars[i].Z := Random(FLayers);              FStars[i].Size := Succ(Random(FMaxSize));                if FRandomColors then                  FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))                else                  FStars[i].Color := FColors[Random(Length(FColors))];              end;          end;        if FDirection = sdBottom then          begin            FStars[i].Y := FStars[i].Y + Succ(FStars[i].Z);          if FStars[i].Y >= LBmp.Height + (FStars[i].Size + FStars[i].Size) then              begin                FStars[i].X := Succ(Random(LBmp.Width));                FStars[i].Y := 0 - (FStars[i].Size + FStars[i].Size);                FStars[i].Z := Random(FLayers);                FStars[i].Size := Succ(Random(FMaxSize));                if FRandomColors then                FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))                else                FStars[i].Color := FColors[Random(Length(FColors))];            end;          end;      end;    FBitmap.Assign(LBmp);  finally    LBmp.Free;  end;  Result := True;end; procedure TkzStarField.SetLayers(const AValue: Integer);begin  if FLayers = AValue then    Exit;  FLayers := AValue;  Reinitialize;end; procedure TkzStarField.SetMaxSize(const AValue: Integer);begin  if ((AValue < 1) or (FMaxSize = AValue)) then    Exit;  FMaxSize := AValue;  Reinitialize;end; procedure TkzStarField.SetRandomColors(const AValue: Boolean);begin  if FRandomColors = AValue then    Exit;  FRandomColors := AValue;//  Reinitialize;end; procedure TkzStarField.SetStars(const AValue: Integer);begin  if ((AValue < FLayers) or (FMaxStars = AValue)) then    Exit;  FMaxStars := AValue;  Reinitialize;end; procedure TkzStarField.SetWidth(const AValue: Integer);begin  if ((AValue < 1) or (FWidth = AValue)) then    Exit;  FWidth := AValue;  Reinitialize;end; procedure TkzStarField.SetHeight(const AValue: Integer);begin  if ((AValue < 1) or (FHeight = AValue)) then    Exit;  FHeight := AValue;  Reinitialize;end; procedure TkzStarField.SetDirection(const AValue: TStarDirection);begin  if FDirection = AValue then    Exit;  FDirection := AValue;//  Reinitialize;end; procedure TkzStarField.SetBackground(const AValue: TColor);begin  if FBackground = AValue then    Exit;  FBackground := AValue;//  Reinitialize;end; end. ---------------------------------------------------------------------- Gigatron · 2024-04-05 16:56 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL,BGRABitmap; const  StarCount = 1600;  MaxSpeed  = 8; type  TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    procedure  Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);   private    Stars : array of TStar;    procedure InitializeStarfield;    procedure UpdateStarfield;   public   end; var  Form1: TForm1;  ct : integer; implementation {$R *.lfm} uses BGRABitmapTypes; { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  InitializeStarfield;end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);  Stars[i].Y := (60+Random(ClientHeight-120));    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin        Stars[i].X := Stars[i].X - Stars[i].Speed ;     if Stars[i].X < 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := ClientWidth;      Stars[i].Y := (60+Random(ClientHeight-120));      Stars[i].Speed := Random * 7 + 1;     end;  end;end; procedure Tform1.Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean); begin  BGLContext.Canvas.FillRectLinearColor(x1,y1,x1+ClientWidth,y1+16,   RG BToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(255,100,0),RGBToColor(255 ,100,0),centered);  BGLContext.Canvas.FillRectLinearColor(x1,y1+32,x1+ ClientWidth,y1+16,RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(255,1 00,0),RGBToColor(255,100,0),centered); end;    procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  StarPosition: TPoint;  sttype : Int16 ;  col: TColor;begin   for i := 0 to High(Stars) do  begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     col := RGBToColor(50,50,50);    // bitplanes colors    case  (sttype)  of    1: col := RGBToColor(50,50,50);      2: col := RGBToColor(75,75,75);      3: col := RGBToColor(100,100,100);      4: col := RGBToColor(125,125,125);      5: col := RGBToColor(150,150,150);      6: col := RGBToColor(175,175,175);      7: col := RGBToColor(200,200,200);      8: col := RGBToColor(254,254,254);    end;      BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);  end;      for i := 0 to 8 do      begin           Copperbar(BGLContext,0,280+i*4+120*sin(ct/10+(i/4)), true);      end;      UpdateStarfield;end; procedure TForm1.Timer1Timer(Sender: TObject);begin    ct := ct + 1 ;    BGLVirtualScreen1.Repaint;end; end. ---------------------------------------------------------------------- hukka · 2024-04-05 23:11 While we're talking demoscene, here's a screenshot of the first example I made to demonstrate a framework I've been working on for people who just want a 2D framebuffer and native playback of some retro music formats without having to include tons of DLLs. ---------------------------------------------------------------------- Gigatron · 2024-04-05 23:20 Cool... your Propulse Tracker is nice by the way; It will be good if i can include s3m;it;xm;or .mod format to my intro instead of wav song. thank you ---------------------------------------------------------------------- hukka · 2024-04-06 03:31 Quote from: Gigatron on April 06, 2024, 01:20:52 amIt will be good if i can include s3m;it;xm;or .mod format to my intro instead of wav song. Currently I have native playback of .mod (pretty much perfect -based on 8bitbubsy's disassembly of the original format), .sid (good for some tunes, not for the more technical ones) and Future Composer (a more obscure Amiga format). I will probably tackle IT at some point as 8bitbubsy has done work towards that recently. ---------------------------------------------------------------------- circular · 2024-04-06 05:37 Great idea to use OpenGL Gigatron. Here I've added some text as well in the OpenGL version. ---------------------------------------------------------------------- circular · 2024-04-06 05:39 Quote from: hukka on April 06, 2024, 01:11:36 amWhile we're talking demoscene, here's a screenshot of the first example I made to demonstrate a framework I've been working on for people who just want a 2D framebuffer and native playback of some retro music formats without having to include tons of DLLs. Very nice hand-made fonts! ---------------------------------------------------------------------- TRon · 2024-04-06 06:12 Quote from: hukka on April 06, 2024, 05:31:53 amQuote from: Gigatron on April 06, 2024, 01:20:52 amIt will be good if i can include s3m;it;xm;or .mod format to my intro instead of wav song. Currently I have native playback of .mod (pretty much perfect -based on 8bitbubsy's disassembly of the original format), .sid (good for some tunes, not for the more technical ones) and Future Composer (a more obscure Amiga format). I will probably tackle IT at some point as 8bitbubsy has done work towards that recently. Tralala from nickysn might perhaps be a good start ? ---------------------------------------------------------------------- KodeZwerg · 2024-04-06 12:16 Updated/replaced direction with an angle setting. It does not work perfect, the angle calculation is based on the current Z value to determine a possible direction, as higher that number is, as more possible it is that my calculation has resulted a good direction. Due to that it can or better it will happen than on odd angles (even angles are 0, 90, 180, 270) the slower stars moving into a different direction than the faster one are flying to. For myself I am fine with it, it gives a little more movement on the screen. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit kz.StarField; (*  Starfield (ball) simulation class by KodeZwerg in 2024  Uses slow LCL, not Hardware accelerated, single thread  Royalty free (c) by KodeZwerg   it supports...  - double buffered, no flicker  - random layers to control the speed per star    as more layers you allow to be used, as faster the top stars fly  - integrated a grey scaled colormap generation for fast fixed colors or complete random generated  - full individual scroll direction by angle (0° - 360°)    angle info:    0° = Left to right    90° = Top to Bottom    180° = Right to left    270° = Bottom to top  - random sized stars for values higher than 1  - background color is adjustable  - random positioned stars  Todo:    add transparency switch so the background become invisible    maby add Z-Order drawing, currently whats drawn is drawn   Usage:  1. Create an instance of the class by telling target dimension  2. Set your preffered options, defaults should be ok  3. Use a timer to generate/update a Bitmap for your usage by calling "Next"  additional  4. Use a resize event to update width/height of class  optional  5. draw text or other image data on that image before displaying it*) {$mode ObjFPC}{$H+} interface uses  Classes, SysUtils, Graphics; type   { TkzStarField }   TkzStarField = class(TObject)    strict private      type        TOneStar = packed record          X,        Y,          Z,          Size: Integer;          Color: TColor;          directionX,          directionY: Double;        end;        TAllStars = array of TOneStar;        TColors = array of TColor;    strict private      FHeight: Integer;      FStars: TAllStars;      FColors: TColors;      FLayers: Integer;      FBitmap: TBitmap;      FMaxStars: Integer;      FMaxSize: Integer;      FAngle: Integer;    FWidth: Integer;      FHeigth: Integer;      FRandomColors: Boolean;    FBackground: TColor;    strict private      procedure SetAngle(AValue: Integer);      procedure SetBackground(const AValue: TColor);      procedure SetHeight(const AValue: Integer);      procedure SetLayers(const AValue: Integer);      procedure SetMaxSize(const AValue: Integer);      procedure SetRandomColors(const AValue: Boolean);      procedure SetStars(const AValue: Integer);      procedure SetWidth(const AValue: Integer);    public      constructor Create(const AWidth, AHeigth: Integer);      destructor Destroy; override;      function Reinitialize: Boolean;    function Next: Boolean;    published      property Bitmap: TBitmap read FBitmap;      property Layers: Integer read FLayers write SetLayers default 10;      property MaxStars: Integer read FMaxStars write SetStars default 100;      property MaxSize: Integer read FMaxSize write SetMaxSize default 1;      property Width: Integer read FWidth write SetWidth default 800;      property Height: Integer read FHeight write SetHeight default 600;      property RandomColors: Boolean read FRandomColors write SetRandomColors default True;      property Angle: Integer read FAngle write SetAngle default 0;      property Background: TColor read FBackground write SetBackground default clBlack;  end; implementation { TkzStarField } constructor TkzStarField.Create(const AWidth, AHeigth: Integer);begin  inherited Create;  Randomize;  FBitmap := TBitmap.Create;  FBitmap.PixelFormat := pf32bit;  FWidth := AWidth;  FHeight := AHeigth;  FLayers := 10;  FMaxStars := 100;  FMaxSize := 1;  FAngle := 0;  FRandomColors := True;  FBackground := clBlack;  Reinitialize;end; destructor TkzStarField.Destroy;begin  FBitmap.Free;  inherited Destroy;end; function TkzStarField.Reinitialize: Boolean;var  i: Integer;  radians: Double;begin  Result := False;  SetLength(FStars, FMaxStars);  SetLength(FColors, FLayers);  FBitmap.Width := FWidth;  FBitmap.Height := FHeigth;  for i := Low(FColors) to High(FColors) do    begin      FColors[i] := RGBToColor(           Round(255 + (16 - 255) * (Succ(i) / FLayers)),           Round(255 + (16 - 255) * (Succ(i) / FLayers)),           Round(255 + (16 - 255) * (Succ(i) / FLayers))         );    end;  radians := FAngle * PI / 180;  for i := Low(FStars) to High(FStars) do    begin      FStars[i].X := Succ(Random(FWidth));      FStars[i].Y := Succ(Random(FHeight));      FStars[i].Z := Random(FLayers);      FStars[i].directionX := cos(radians);      FStars[i].directionY := sin(radians);      FStars[i].Size := Succ(Random(FMaxSize));      if FRandomColors then      FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))      else        FStars[i].Color := FColors[Random(Length(FColors))];    end;  Result := True;end; function TkzStarField.Next: Boolean;var  LBmp: TBitmap;  i: Integer;begin  Result := False;  LBmp := TBitmap.Create;  try    LBmp.PixelFormat := pf32bit;    LBmp.Width := FWidth;    LBmp.Height := FHeight;    LBmp.Canvas.Brush.Color := FBackground;    LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));    for i := Low(FStars) to High(FStars) do      begin        LBmp.Canvas.Brush.Color := FStars[i].Color;        // draw a rectangle (dot) or a circle        if FStars[i].Size <= 1 then          LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X), Succ(FStars[i].Y)))        else          LBmp.Canvas.Ellipse(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X + FStars[i].Size), Succ(FStars[i].Y + FStars[i].Size)));         // move a star        FStars[i].X += Round(FStars[i].directionX * Succ(FStars[i].Z));        FStars[i].Y += Round(FStars[i].directionY * Succ(FStars[i].Z));         // check if a star needs to be replaced      if FStars[i].X < 0 - (FStars[i].Size + FStars[i].Size) then        begin            FStars[i].X := LBmp.Width + (FStars[i].Size + FStars[i].Size);            FStars[i].Size := Succ(Random(FMaxSize));            FStars[i].Z := Random(FLayers);            if FRandomColors then              FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))            else              FStars[i].Color := FColors[Random(Length(FColors))];          end;      if FStars[i].X > LBmp.Width + (FStars[i].Size + FStars[i].Size) then          begin            FStars[i].X := 0 - (FStars[i].Size + FStars[i].Size);            FStars[i].Size := Succ(Random(FMaxSize));            FStars[i].Z := Random(FLayers);            if FRandomColors then              FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))            else              FStars[i].Color := FColors[Random(Length(FColors))];          end;      if FStars[i].Y < 0 - (FStars[i].Size + FStars[i].Size) then        begin            FStars[i].Y := LBmp.Height + (FStars[i].Size + FStars[i].Size);            FStars[i].Size := Succ(Random(FMaxSize));            FStars[i].Z := Random(FLayers);            if FRandomColors then              FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))            else              FStars[i].Color := FColors[Random(Length(FColors))];          end;      if FStars[i].Y > LBmp.Height + (FStars[i].Size + FStars[i].Size) then          begin            FStars[i].Y := 0 - (FStars[i].Size + FStars[i].Size);            FStars[i].Size := Succ(Random(FMaxSize));            FStars[i].Z := Random(FLayers);            if FRandomColors then              FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))            else              FStars[i].Color := FColors[Random(Length(FColors))];          end;    end;    FBitmap.Assign(LBmp);  finally    LBmp.Free;  end;  Result := True;end; procedure TkzStarField.SetLayers(const AValue: Integer);begin  if ((FLayers = AValue) or (FLayers < 1)) then    Exit;  FLayers := AValue;  Reinitialize;end; procedure TkzStarField.SetMaxSize(const AValue: Integer);begin  if ((AValue < 1) or (FMaxSize = AValue)) then    Exit;  FMaxSize := AValue;  Reinitialize;end; procedure TkzStarField.SetRandomColors(const AValue: Boolean);begin  if FRandomColors = AValue then    Exit;  FRandomColors := AValue;//  Reinitialize;end; procedure TkzStarField.SetStars(const AValue: Integer);begin  if ((AValue < FLayers) or (FMaxStars = AValue)) then    Exit;  FMaxStars := AValue;  Reinitialize;end; procedure TkzStarField.SetWidth(const AValue: Integer);begin  if ((AValue < 1) or (FWidth = AValue)) then    Exit;  FWidth := AValue;  Reinitialize;end; procedure TkzStarField.SetHeight(const AValue: Integer);begin  if ((AValue < 1) or (FHeight = AValue)) then    Exit;  FHeight := AValue;  Reinitialize;end; procedure TkzStarField.SetAngle(AValue: Integer);begin  if ((FAngle < 0) or (FAngle > 360) or (FAngle = AValue)) then    Exit;  FAngle := AValue;  Reinitialize;end; procedure TkzStarField.SetBackground(const AValue: TColor);begin  if FBackground = AValue then    Exit;  FBackground := AValue;//  Reinitialize;end; end.I guess from point of features for a starfield or balls, its finished, now I could port to hardware accelerated ---------------------------------------------------------------------- hukka · 2024-04-07 02:37 Quote from: TRon on April 06, 2024, 08:12:57 amTralala from nickysn might perhaps be a good start ? Good call! I already had that project bookmarked but haven't yet had a proper look into it. ---------------------------------------------------------------------- Gigatron · 2024-04-07 05:01 Quote from: circular on April 06, 2024, 07:37:09 amGreat idea to use OpenGL Gigatron. Here I've added some text as well in the OpenGL version. Greeeaat ... Thank you alot this demo is running at full speed for me ; I can say the people here are awesome guys and i am happy for this. ---------------------------------------------------------------------- Gigatron · 2024-04-09 20:08 Hi, I'am trying to code a nice intro based on Amiga Style; progress status; https://www.youtube.com/watch?v=fP4gw4KdvXg Second part; https://www.youtube.com/watch?v=6_PNk7WoM0c Will update this soon ; (cycling colors was added as new stuff) : Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAGraphicControl, BCExpandPanels, BGRAOpenGL, BGRABitmap,  BGRABitmapTypes; const  StarCount = 1200;  MaxSpeed  = 8; type  TStar = record        //    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScr: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScrLoadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScrUnloadTextures(Sender: TObject;      BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);   private    GLFont, GLBigFont: IBGLFont;    Stars  : array of TStar;    a_logo : IBGLTexture;    rr,gg,bb  : Byte;     private  const cop : Array [0..6] of String = ('#ff0000','#ffff00','#ffffff','# 0000ff','#00ffff','#00ff00','#ff00ff');     const rasterz : Array [0..64] of String = ('#004848','#006C6C','#009090','#00B4B4','#00D8D8' ,'#00FFFF','#00D8D8','#00B4B4','#009090','#006C6C','#004848','#000048' ,    '#00006C','#000090','#0000B4','#0000D8','#0000FF','#0000D8','#000 0B4','#000090','#00006C','#000048','#480048','#6C006C','#900090',    ' #B400B4','#D800D8','#FF00FF','#D800D8','#B400B4','#900090','#6C006C',' #480048','#480000','#6C0000','#900000','#B40000','#D80000',    '#FF000 0','#D80000','#B40000','#900000','#6C0000','#480000','#484800','#6C6C0 0','#909000','#B4B400','#D8D800','#FFFF00','#D8D800',    '#B4B400','#9 09000','#6C6C00','#484800','#004800','#006C00','#009000','#00B400','#0 0D800','#00FF00','#00D800','#00B400','#009000',    '#006C00');      procedure InitializeStarfield;    procedure UpdateStarfield;    procedure WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;AText: string; X, Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);    procedure Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);   public   end; var  Form1: TForm1;  ct : integer;   hexColor: string;  red, green, blue: Byte;  pause : integer;  j: integer;  cop_num : integer = 0; // copper bar index color  vbl_timer :integer = 0;  implementation {$R *.lfm} uses BGRAUTF8,BGRATextFX,BGRAGradients,BGRAFontGL; { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  InitializeStarfield;     j:=0;    pause := 0; end; procedure TForm1.FormShow(Sender: TObject);begin        a_logo := BGLTexture('gtr.png');end;   procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);    Stars[i].Y := (60+Random(ClientHeight-120));  Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin        Stars[i].X := Stars[i].X - Stars[i].Speed ;     if Stars[i].X < 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := ClientWidth;      Stars[i].Y := (60+Random(ClientHeight-120));      Stars[i].Speed := Random * 7 + 1;     end;  end;end; procedure HexToRGB(hex: string; var r, g, b: Byte);begin  r := StrToInt('$' + Copy(hex, 2, 2));  g := StrToInt('$' + Copy(hex, 4, 2));  b := StrToInt('$' + Copy(hex, 6, 2));end;   procedure Tform1.Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);begin  hexColor := cop[cop_num];  HexToRGB(hexColor, rr,gg,bb);   BGLContext.Canvas.FillRectLinearColor(x1,y1,x1+ClientWidth,y1+16,   RG BToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,bb),RGBToColor(rr,g g,bb),centered);  BGLContext.Canvas.FillRectLinearColor(x1,y1+32,x1+Cl ientWidth,y1+16,RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,b b),RGBToColor(rr,gg,bb),centered);end; // from Circularprocedure Tform1.WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;  AText: string; X,Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);var glyphCursor : TGlyphCursorUtf8;  glyph: TGlyphUtf8;  glyphText: string;begin  X -= AFont.TextWidth(AText)/2;  glyphCursor := TGlyphCursorUtf8.New(AText, fbmAuto);  while not glyphCursor.EndOfString do  begin    glyph := glyphCursor.GetNextGlyph;    if glyph.MirroredGlyphUtf8 <> '' then    glyphText := glyph.MirroredGlyphUtf8    else      glyphText := glyph.GlyphUtf8;    AFont.TextOut(x,y + AWaveSize*Sin(AWavePosDeg*Pi/180), glyphText, AColor);    x += AFont.TextWidth(glyphText);    AWavePosDeg += AWaveStepDeg;  end;end; procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  StarPosition: TPoint;  sttype : Int16 ;  col: TColor;  cl : string; begin   // stars  for i := 0 to High(Stars) do  begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     col := RGBToColor(50,50,50);    // bitplanes colors    case  (sttype)  of      1: col := RGBToColor(50,50,50);      2: col := RGBToColor(75,75,75);      3: col := RGBToColor(100,100,100);      4: col := RGBToColor(125,125,125);    5: col := RGBToColor(150,150,150);      6: col := RGBToColor(175,175,175);      7: col := RGBToColor(200,200,200);      8: col := RGBToColor(254,254,254);     end;      BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);  end;  // copper bars  for i := 0 to 8 do  begin       Copperbar(BGLContext,0,240+i*2+80*sin(ct/20+(i/2)), true);  end;   col := RGBToColor(Random(256), Random(256), Random(256));  WavyText(BG LContext,GLFont,col,'PRESENTS',150+BGLContext.Width/4+30*sin(ct/10),10 0,    180*sin(ct/13), 0, 0);   WavyText(BGLContext,GLBigFont,BGRAWhite,'LAZARUS DEMO ',10+BGLContext.Width/2,410,0, 0, 0);   // raster bars cycle colors with pause like A-Team intro  for i := 0 to 10 do  begin       hexColor := rasterz[i+j];       HexToRGB(hexColor, red, green, blue);       BGLContext.Canvas.FillRect(0,i*8,640,i*8- 8,RGBToColor(red,green,blue));   end;   inc(pause);    if (pause>=10) then   begin       inc(j);      pause := 0;       if(j>=63-8) then j:=0;     end;  // draw logo and update Sf  BGLCanvas.StretchPutImage(0,0,a_logo.Width,a_logo.Height+2, a_logo);  UpdateStarfield;   // general demo_timer , increase copper colortable to 7  inc(vbl_timer);  if(vbl_timer>200) then  begin     vbl_timer := 0;     cop_num := cop_num +1;     if(cop_num>6) then cop_num :=0;   end; end; procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject;  BGLContext: TBGLContext);begin  GLFont := nil;  GLBigFont := nil;  a_logo := nil;end; procedure TForm1.BGLVirtualScrLoadTextures(Sender: TObject;  BGLContext: TBGLContext);var bigRender: TBGRATextEffectFontRenderer;  shader: TPhongShading;  bigFont: TBGLRenderedFont; begin  GLFont := BGLFont('Arial', 40, [fsBold]);   shader := TPhongShading.Create;  bigRender := TBGRATextEffectFontRenderer.Create(shader, true);  bigFont  := TBGLRenderedFont.Create(bigRender, true);  bigFont.Name := 'Arial';  bigFont.EmHeight := 72;  bigFont.Color := CSSSkyBlue;  GLBigFont := bigFont; end; procedure TForm1.Timer1Timer(Sender: TObject);begin  ct := ct + 1 ;  BGLVirtualScr.Repaint;end; end.