New 2D StarField
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-02-28 15:39

Hi,
To test my new Ryzen 7 labtop here is a nice 8 playfield Amiga Style
2D starfield with speed and
H/V scrolling mode .

I will update this code to make a little Intro with module player.
For now here is the code Using BGRA component like always.
Maybe Usefull for you

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, BGRABitmapTypes; const Version = '0.2'; type  
TStarfieldMode = (smVertical, smHorizontal);   TStar = record    X, Y:
Single;      // Pos x,y    Speed: Single;     // speed    Color:
TBGRAPixel; // Color    Plane: Integer;    // Planes  end;   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen: TBGRAVirtualScreen;  
Button1SpeedDown: TButton;    ButtonSpeedUp: TButton;   
ButtonHorizontal: TButton;    ButtonVertical: TButton;   
PanelConrols: TPanel;    Timer1: TTimer;     procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure ButtonVerticalClick(Sender: TObject);    procedure
ButtonHorizontalClick(Sender: TObject);    procedure
ButtonSpeedUpClick(Sender: TObject);    procedure
ButtonSpeedDownClick(Sender: TObject);   private     FStars: array of
TStar;    ScrollMode: TStarfieldMode;    SpeedMultiplier: Single;   
procedure InitStars;    procedure UpdateStars;   public   end; var 
Form1: TForm1; implementation {$R *.lfm}  { TForm1 } procedure
TForm1.InitStars;const  // 8 plans  STAR_COUNT: array[0..7] of Integer
= (300, 250, 200, 150, 100, 75, 50, 25); //1150 stars  STAR_SPEED:
array[0..7] of Double = (0.3, 0.5, 0.8, 1.2, 1.8, 2.5, 3.5, 5);var  i,
j, MaxStars, CStar: Integer;begin   MaxStars := 0;  for i := 0 to 7
do    Inc(MaxStars, STAR_COUNT[i]);   SetLength(FStars, MaxStars);  
CStar := 0;  for i := 0 to 7 do  begin    for j := 0 to
STAR_COUNT[i]-1 do    begin      FStars[CStar].X :=
Random(BGRAVirtualScreen.Width);      FStars[CStar].Y :=
Random(BGRAVirtualScreen.Height);      FStars[CStar].Speed :=
STAR_SPEED[i];      FStars[CStar].Color := BGRA(255, 255, 255, 255);
 //  pas important      FStars[CStar].Plane := i;      Inc(CStar);   
end;  end;end; procedure TForm1.UpdateStars;var  i: Integer;  WW, HH:
Integer;begin  WW := BGRAVirtualScreen.Width;  HH :=
BGRAVirtualScreen.Height;   for i := 0 to Length(FStars) - 1 do 
begin    case ScrollMode of       smVertical:        begin         
FStars[i].Y := FStars[i].Y + FStars[i].Speed * SpeedMultiplier;      
  if SpeedMultiplier > 0 then          begin            if FStars[i].Y
> HH then            begin              FStars[i].Y := 0;            
FStars[i].X := Random(WW);            end;          end          else 
        begin            if FStars[i].Y < 0 then            begin    
        FStars[i].Y := HH;              FStars[i].X := Random(WW);   
       end;          end;        end;       smHorizontal:       
begin          FStars[i].X := FStars[i].X + FStars[i].Speed *
SpeedMultiplier;          if SpeedMultiplier > 0 then          begin 
         if FStars[i].X > WW then            begin             
FStars[i].X := 0;              FStars[i].Y := Random(HH);           
end;          end          else          begin             if
FStars[i].X < 0 then            begin              FStars[i].X := WW; 
            FStars[i].Y := Random(HH);            end;          end; 
     end;    end;  end;   BGRAVirtualScreen.RedrawBitmap;  //
refreshend; procedure TForm1.BGRAVirtualScreenRedraw(Sender: TObject;
Bitmap: TBGRABitmap);var  i: Integer;  col: TBGRAPixel;  brightness:
Byte;begin   for i := 0 to Length(FStars) - 1 do  begin     brightness
:= 40 + Round(215 * (FStars[i].Speed - 0.3) / 4.7);    col :=
BGRA(brightness, brightness, brightness);    Bitmap.FillRect(     
Round(FStars[i].X),      Round(FStars[i].Y),      Round(FStars[i].X) +
2,      Round(FStars[i].Y) + 2,      col    );  end;end; procedure
TForm1.FormCreate(Sender: TObject);begin   ScrollMode := smHorizontal;
 // init mode H/V  SpeedMultiplier := 0.5;      // speed   Caption :=
'BGRA 8-PlayField StarField - GIGATRON 2025';  BGRAVirtualScreen.Color
:= clBlack;   Randomize;  InitStars; end; procedure
TForm1.FormDestroy(Sender: TObject);begin     SetLength(FStars,
0);end; procedure TForm1.Timer1Timer(Sender: TObject);begin   
 UpdateStars;end; procedure TForm1.ButtonVerticalClick(Sender:
TObject);begin    ScrollMode := smVertical;end; procedure
TForm1.ButtonHorizontalClick(Sender: TObject);begin    ScrollMode :=
smHorizontal;end; procedure TForm1.ButtonSpeedUpClick(Sender:
TObject);begin  if SpeedMultiplier < 5 then SpeedMultiplier :=
SpeedMultiplier + 0.5;end; procedure
TForm1.ButtonSpeedDownClick(Sender: TObject);begin  if SpeedMultiplier
> -5 then SpeedMultiplier := SpeedMultiplier - 0.5;end;  end.

----------------------------------------------------------------------
Gigatron · 2025-03-01 15:38

Perfect

Now let's transform this 2D Starfiled to 3D Starfield with Left/Right
Rotation, the result is really good !!

You think that the code is long, but in the past the demos on Amiga
were more than 20,000 lines of code so 260 lines of code
understandable by humans is nothing. Plus everything was in 68000
assembler!!

Regards

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, BGRABitmapTypes, Math; const  Version = '0.3'; type 
TStarfieldMode = (smForward, smBackward);   TStar = record    X, Y, Z:
Single;     // x,y,z    Speed: Double;       // Speed    Color:
TBGRAPixel;   // Color  end;   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen: TBGRAVirtualScreen;    ButtonResetR: TButton;   
ButtonRotateLeft: TButton;    ButtonRotateRight: TButton;   
ButtonBackward: TButton;    ButtonForward: TButton;   
Button1SpeedDown: TButton;    ButtonSpeedUp: TButton;    PanelConrols:
TPanel;    PanelControls: TPanel;    Timer1: TTimer;     procedure
ButtonResetRClick(Sender: TObject);    procedure
ButtonRotateRightClick(Sender: TObject);    procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure ButtonForwardClick(Sender: TObject);     procedure
ButtonBackwardClick(Sender: TObject);    procedure
ButtonRotateLeftClick(Sender: TObject);    procedure
ButtonSpeedUpClick(Sender: TObject);    procedure
ButtonSpeedDownClick(Sender: TObject);   private    FStars: array of
TStar;    ScrollMode: TStarfieldMode;    SpeedMultiplier: Single;   
RotationSpeed: Single;    CenterX, CenterY: Integer;    MaxZ, MinZ,
FocusZ: Single;     procedure InitStars;    procedure UpdateStars;   
procedure RotatePoint(var X, Y: Single; Angle: Single);    function
Project3Dto2D(X, Y, Z: Double; out ScX, ScY: Integer; out Size:
Integer): Boolean;   public   end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.InitStars;const  STAR_COUNT = 1000;  //  MAX_Z_DISTANCE =
2000.0;var  i: Integer;begin  SetLength(FStars, STAR_COUNT);   MinZ :=
1.0;  MaxZ := MAX_Z_DISTANCE;  FocusZ := 200.0; // 200   for i := 0 to
STAR_COUNT - 1 do  begin    // Random position in 3D space   
FStars[i].X := Random(2000) - 1000;  //  -1000 to 1000    FStars[i].Y
:= Random(2000) - 1000;  //  -1000 to 1000    FStars[i].Z := MinZ +
Random * (MaxZ - MinZ); // Range from MinZ to MaxZ    FStars[i].Speed
:= 1.0 + Random(4);    FStars[i].Color := BGRA(255, 255, 255, 255); 
end;end; procedure TForm1.RotatePoint(var X, Y: Single; Angle:
Single);var  NewX, NewY: Single;  Cosine, Sine: Single;begin  Cosine
:= Cos(Angle);  Sine := Sin(Angle);   NewX := X * Cosine - Y * Sine; 
NewY := X * Sine + Y * Cosine;   X := NewX;  Y := NewY;end; function
TForm1.Project3Dto2D(X, Y, Z: Double; out ScX, ScY: Integer; out Size:
Integer): Boolean;var  Scale: Single;begin  Result := False;   if Z <=
0 then Exit;  // ! if Div  0   Scale := FocusZ / Z;  ScX := CenterX +
Round(X * Scale);  ScY := CenterY + Round(Y * Scale);  Size := Max(1,
Round(4 * (1 - Z / MaxZ)));  Result := (ScX >= 0) and (ScX <
BGRAVirtualScreen.Width) and            (ScY >= 0) and (ScY <
BGRAVirtualScreen.Height);end; procedure TForm1.UpdateStars;var  i:
Integer;  SpeedFactor: Double;begin  SpeedFactor := SpeedMultiplier;  
for i := 0 to Length(FStars) - 1 do  begin     if RotationSpeed <> 0
then      RotatePoint(FStars[i].X, FStars[i].Y, RotationSpeed);    
case ScrollMode of      smForward:        begin          FStars[i].Z
:= FStars[i].Z - FStars[i].Speed * SpeedFactor;          // reset z
position          if FStars[i].Z < MinZ then          begin          
FStars[i].X := Random(2000) - 1000;            FStars[i].Y :=
Random(2000) - 1000;            FStars[i].Z := MaxZ;          end;   
   end;       smBackward:        begin          FStars[i].Z :=
FStars[i].Z + FStars[i].Speed * SpeedFactor;          if FStars[i].Z >
MaxZ then          begin            FStars[i].X := Random(2000) -
1000;            FStars[i].Y := Random(2000) - 1000;           
FStars[i].Z := MinZ;          end;        end;    end;  end;  
BGRAVirtualScreen.RedrawBitmap;  // refreshend; procedure
TForm1.BGRAVirtualScreenRedraw(Sender: TObject; Bitmap:
TBGRABitmap);var  i: Integer;  ScreenX, ScreenY, StSize: Integer; 
Brightness: Integer;  col: TBGRAPixel;  Is_Visible: Boolean;begin  //
Bitmap.Fill(BGRA(0, 0, 0, 255));   for i := 0 to Length(FStars) - 1
do  begin    // 3D position to 2D    Is_Visible :=
Project3Dto2D(FStars[i].X, FStars[i].Y, FStars[i].Z, ScreenX, ScreenY,
StSize);     if Is_Visible then    begin      Brightness := Max(40,
Round(255 * (1 - (FStars[i].Z / (MaxZ/1.5)))));      col :=
BGRA(Brightness, Brightness, Brightness);      if StSize <= 1 then   
   Bitmap.SetPixel(ScreenX, ScreenY, col)      else       
Bitmap.FillRect(          ScreenX - StSize div 2,          ScreenY -
StSize div 2,          ScreenX + StSize div 2 + 1,          ScreenY +
StSize div 2 + 1, col);    end;  end;end; procedure
TForm1.FormCreate(Sender: TObject);begin  // init defautl params 
ScrollMode := smForward;   // forward  SpeedMultiplier := 1.0;    //
speed  RotationSpeed := 0;        // Rotation = 0   CenterX :=
BGRAVirtualScreen.Width div 2;  CenterY := BGRAVirtualScreen.Height
div 2;  Caption := 'BGRA 3D StarField - GIGATRON 2025 V' + Version; 
BGRAVirtualScreen.Color := clBlack;   Randomize; 
InitStars;end; procedure TForm1.FormDestroy(Sender: TObject);begin 
SetLength(FStars, 0);end; procedure TForm1.Timer1Timer(Sender:
TObject);begin  UpdateStars;end; procedure
TForm1.ButtonForwardClick(Sender: TObject);begin  ScrollMode :=
smForward;end;procedure TForm1.ButtonBackwardClick(Sender:
TObject);begin    ScrollMode := smBackward;end; procedure
TForm1.ButtonSpeedUpClick(Sender: TObject);begin  if SpeedMultiplier <
5.0 then    SpeedMultiplier := SpeedMultiplier + 0.5;end; procedure
TForm1.ButtonSpeedDownClick(Sender: TObject);begin  if SpeedMultiplier
> -5.0 then    SpeedMultiplier := SpeedMultiplier - 0.5;end; procedure
TForm1.ButtonRotateLeftClick(Sender: TObject);begin     RotationSpeed
:= -0.01;end; procedure TForm1.ButtonResetRClick(Sender:
TObject);begin      RotationSpeed := 0.0;end; procedure
TForm1.ButtonRotateRightClick(Sender: TObject);begin     RotationSpeed
:= 0.01;end; end.
*Edit : The speed never be under 0 !

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 procedure
TForm1.ButtonSpeedDownClick(Sender: TObject);begin  if SpeedMultiplier
>0.0 then    SpeedMultiplier := SpeedMultiplier - 0.5;end;

----------------------------------------------------------------------
Gigatron · 2025-03-02 00:05

Hi,

And now we can use Blitter Object BOB to make 4 planes Bob Scrolling
with 2d Starfield;

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, BGRABitmapTypes; const Version = '0.1'; type  
TStarfieldMode = (smVertical, smHorizontal);   TStar = record    X, Y:
Single;      // Pos x,y    Speed: Single;     // speed    Color:
TBGRAPixel; // Color    Plane: Integer;    // Planes  end;   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen: TBGRAVirtualScreen;  
Button1SpeedDown: TButton;    ButtonSpeedUp: TButton;   
ButtonHorizontal: TButton;    ButtonVertical: TButton;   
PanelConrols: TPanel;    Timer1: TTimer;     procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure ButtonVerticalClick(Sender: TObject);    procedure
ButtonHorizontalClick(Sender: TObject);    procedure
ButtonSpeedUpClick(Sender: TObject);    procedure
ButtonSpeedDownClick(Sender: TObject);   private     FStars: array of
TStar;    ScrollMode: TStarfieldMode;    SpeedMultiplier: Single;   
procedure InitStars;    procedure UpdateStars;   public   end; var 
Form1: TForm1;  bob1  : TBGRABitmap;  bob1Scale: array[0..3] of
TBGRABitmap; implementation {$R *.lfm}  { TForm1 } procedure
TForm1.InitStars;const  // 8 plans  STAR_COUNT: array[0..3] of Integer
= (20,18, 15, 10); // bobs plane distribution Back to Front 0/1/2/3 
STAR_SPEED: array[0..3] of Double = ( 1.0, 2.0, 3.0, 4.0);var  i, j,
MaxStars, CStar: Integer;begin   MaxStars := 0;  for i := 0 to 3 do  
Inc(MaxStars, STAR_COUNT[i]);   SetLength(FStars, MaxStars);   CStar
:= 0;  for i := 0 to 3 do  begin    for j := 0 to STAR_COUNT[i]-1 do 
 begin      FStars[CStar].X := Random(BGRAVirtualScreen.Width);     
FStars[CStar].Y := Random(BGRAVirtualScreen.Height);     
FStars[CStar].Speed := STAR_SPEED[i];      FStars[CStar].Color :=
BGRA(255, 255, 255, 255);  //  pas important      FStars[CStar].Plane
:= i;      Inc(CStar);    end;  end;end; procedure
TForm1.UpdateStars;var  i: Integer;  WW, HH: Integer;begin  WW :=
BGRAVirtualScreen.Width;  HH := BGRAVirtualScreen.Height;   for i := 0
to Length(FStars) - 1 do  begin    case ScrollMode of      
smVertical:        begin          FStars[i].Y := FStars[i].Y +
FStars[i].Speed * SpeedMultiplier;          if SpeedMultiplier > 0
then          begin            if FStars[i].Y > HH+64 then           
begin              FStars[i].Y := -64;              FStars[i].X :=
Random(WW);            end;          end          else          begin 
          if FStars[i].Y < -64 then            begin             
FStars[i].Y := HH+64;              FStars[i].X := Random(WW);        
  end;          end;        end;       smHorizontal:        begin    
    FStars[i].X := FStars[i].X + FStars[i].Speed * SpeedMultiplier;  
      if SpeedMultiplier > 0 then          begin            if
FStars[i].X > WW+64 then            begin              FStars[i].X :=
-64;              FStars[i].Y := Random(HH);            end;         
end          else          begin             if FStars[i].X < -64
then            begin              FStars[i].X := WW+64;             
FStars[i].Y := Random(HH);            end;          end;        end; 
 end;  end;   BGRAVirtualScreen.RedrawBitmap;  //
refreshend; procedure TForm1.BGRAVirtualScreenRedraw(Sender: TObject;
Bitmap: TBGRABitmap);var  i, Pidx: Integer;   // bob plane
indexbegin   for i := 0 to Length(FStars) - 1 do  begin    Pidx :=
FStars[i].Plane;    Bitmap.PutImage(Trunc(FStars[i].X),
Trunc(FStars[i].Y), bob1Scale[Pidx], dmLinearBlend); 
end; end; procedure TForm1.FormCreate(Sender: TObject);begin   bob1 :=
TBGRABitmap.Create('06.png');  bob1Scale[0] :=
bob1.Resample(Round(bob1.Width * 0.4), Round(bob1.Height * 0.4),
rmFineResample);  bob1Scale[1] := bob1.Resample(Round(bob1.Width *
0.6), Round(bob1.Height * 0.6), rmFineResample);  bob1Scale[2] :=
bob1.Resample(Round(bob1.Width * 0.8), Round(bob1.Height * 0.8),
rmFineResample);  bob1Scale[3] := bob1.Resample(Round(bob1.Width ),
Round(bob1.Height ), rmFineResample);   ScrollMode := smHorizontal;
 // init mode H/V  SpeedMultiplier := 2.0;      // speed   Caption :=
'BGRA 4-PlayField Shape Scrolling - GIGATRON 2025 V'+version; 
BGRAVirtualScreen.Color := clBlack;   Randomize;  InitStars; end;//
Free Stars and Bob Tableprocedure TForm1.FormDestroy(Sender:
TObject);var  i: Integer;begin  for i := 0 to 3 do     // 4 bob scale
table !    bob1Scale[i].Free;   bob1.Free;  SetLength(FStars,
0);end; procedure TForm1.Timer1Timer(Sender: TObject);begin   
 UpdateStars;end; procedure TForm1.ButtonVerticalClick(Sender:
TObject);begin    ScrollMode := smVertical;end; procedure
TForm1.ButtonHorizontalClick(Sender: TObject);begin    ScrollMode :=
smHorizontal;end; procedure TForm1.ButtonSpeedUpClick(Sender:
TObject);begin  if SpeedMultiplier < 10 then SpeedMultiplier :=
SpeedMultiplier + 1.0;end; procedure
TForm1.ButtonSpeedDownClick(Sender: TObject);begin  if SpeedMultiplier
> -10 then SpeedMultiplier := SpeedMultiplier - 1.0;end;  end.

----------------------------------------------------------------------
Gigatron · 2025-03-03 17:51

Hi

Here is the final release of this Amiga Style intro ! Source is
commented for your understand !

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,
BGRABitmapTypes,libxmp,mmsystem,windows; const  Version = '0.15'; 
SampleRate = 44100;  Channels = 2;  BitsPerSample = 16;  BufferSize =
8192; // buffer size=8192 is now Ok  !!!  BufferCount = 2; type  
TStarfieldMode = (smVertical, smHorizontal);   TStar = record    X, Y:
Single;      // Pos x,y    Speed: Single;     // speed    Color:
TBGRAPixel; // Color    Plane: Integer;    // Planes  end;   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen: TBGRAVirtualScreen;  
Timer1: TTimer;     procedure FormCreate(Sender: TObject);   
procedure FormDestroy(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);  
private      ctx: xmp_context;     buffers: array[0..BufferCount-1] of
array[0..BufferSize-1] of Byte;     waveHeaders:
array[0..BufferCount-1] of TWaveHdr;     currentBuffer: Integer;    
FStars: array of TStar;    ScrollMode: TStarfieldMode;   
SpeedMultiplier: Single;    procedure InitStars;    procedure
UpdateStars;   public   end; var  Form1: TForm1;  waveOut: HWAVEOUT; 
waveHeader: TWaveHdr;   s_data : array [0..255] of integer = ( //
sinus data from the champs sidewinder cracktro           80,80,81,83,8
6,90,94,99,104,110,116,123,130,137,145,152,159,167,173,180,186,192,197
,           202,206,209,212,214,215,216,216,216,214,213,210,208,205,20
1,197,193,189,185,181,177,           173,169,166,162,160,157,155,153,1
52,151,151,151,151,152,153,155,156,158,160,162,164,           166,168,
170,171,172,173,174,174,174,173,172,170,168,166,163,160,156,152,148,14
3,139,           134,129,125,120,116,112,108,105,102,100,98,97,97,97,9
8,100,102,106,109,114,119,125,131,           137,144,151,159,166,174,1
82,189,196,203,209,215,221,226,230,233,236,238,239,239,238,237,      
   235,232,228,224,219,214,208,202,195,188,181,174,167,160,154,147,141
,135,130,125,121,118,           115,112,111,110,109,109,110,112,113,11
6,118,121,124,128,131,135,139,142,146,149,152,155,           157,159,1
61,162,163,163,163,163,162,161,160,158,156,154,152,150,148,146,144,142
,141,139,           139,138,138,139,139,141,143,145,148,151,155,159,16
3,168,173,178,183,188,194,199,204,208,           212,216,220,222,225,2
26,227,227,227,225,223,221,217,213,208,203,197,190,183,176,169,161,  
       153,145,138,130,123,116,110,104,99,94,90,87,84,83,82);   bob1
 : TBGRABitmap;  bob1Scale: array[0..3] of TBGRABitmap; // scaled bobs
table 4   logo_g, logo_t, logo_r :  TBGRABitmap;  sin_ctg, sin_ctt,
sin_ctr : integer;   sc_txt :Array of PChar;  sc_xpos :
Single; implementation{$R *.lfm} procedure FillBuffer(bufferIndex:
Integer);begin   xmp_play_buffer(Form1.ctx,
@Form1.buffers[bufferIndex][0], BufferSize, 0);end;function
WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1,
dwParam2: DWORD_PTR): DWORD; stdcall;begin   if uMsg = WOM_DONE then 
begin    FillBuffer(Form1.currentBuffer);    waveOutWrite(hwo,
@Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));   
Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount; 
end;  Result := 0;end; procedure InitAudio;var  wFormat:
TWaveFormatEx;  i: Integer;begin   SetThreadPriority(GetCurrentThread,
THREAD_PRIORITY_LOWEST);   with wFormat do  begin    wFormatTag :=
WAVE_FORMAT_PCM;    nChannels := Channels;    nSamplesPerSec :=
SampleRate;    wBitsPerSample := BitsPerSample;    nBlockAlign :=
(wBitsPerSample * nChannels) div 8;    nAvgBytesPerSec :=
nSamplesPerSec * nBlockAlign;    cbSize := 0;  end;   if
waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback),
0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then    raise
Exception.Create('Erreur ouverture periph audio');   // buffers  for i
:= 0 to BufferCount - 1 do  begin    ZeroMemory(@Form1.waveHeaders[i],
SizeOf(TWaveHdr));    with Form1.waveHeaders[i] do    begin     
lpData := @Form1.buffers[i][0];      dwBufferLength := BufferSize;   
end;    waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i],
SizeOf(TWaveHdr));    FillBuffer(i);    waveOutWrite(waveOut,
@Form1.waveHeaders[i], SizeOf(TWaveHdr));  end;   Form1.currentBuffer
:= 0;end; procedure CloseAudio;begin  waveOutUnprepareHeader(waveOut,
@waveHeader, SizeOf(TWaveHdr));  waveOutClose(waveOut);end;  { TForm1
} procedure TForm1.InitStars;const  // 4 plans  STAR_COUNT:
array[0..3] of Integer = (20,18, 15, 10); // bobs plane distribution
Back to Front 0/1/2/3  STAR_SPEED: array[0..3] of Single = ( 2.0, 3.0,
4.0, 5.0);var  i, j, MaxStars, CStar: Integer;begin   MaxStars := 0; 
for i := 0 to 3 do    Inc(MaxStars, STAR_COUNT[i]);  
SetLength(FStars, MaxStars);   CStar := 0;  for i := 0 to 3 do  begin 
  for j := 0 to STAR_COUNT[i]-1 do    begin      FStars[CStar].X :=
Random(BGRAVirtualScreen.Width);      FStars[CStar].Y :=
50+Random(BGRAVirtualScreen.Height-150);      FStars[CStar].Speed :=
STAR_SPEED[i];      FStars[CStar].Color := BGRA(255, 255, 255, 255);
 //  pas important      FStars[CStar].Plane := i;      Inc(CStar);   
end;  end;end; procedure TForm1.UpdateStars;var  i: Integer;  WW, HH:
Integer;begin  WW := BGRAVirtualScreen.Width;  HH :=
BGRAVirtualScreen.Height;   for i := 0 to Length(FStars) - 1 do 
begin    case ScrollMode of       smVertical:        begin         
FStars[i].Y := FStars[i].Y + FStars[i].Speed * SpeedMultiplier;      
  if SpeedMultiplier > 0 then          begin            if FStars[i].Y
> HH+64 then            begin              FStars[i].Y := -64;       
     FStars[i].X := Random(WW);            end;          end         
else          begin            if FStars[i].Y < -64 then           
begin              FStars[i].Y := HH+64;              FStars[i].X :=
Random(WW);            end;          end;        end;      
smHorizontal:        begin          FStars[i].X := FStars[i].X +
FStars[i].Speed * SpeedMultiplier;          if SpeedMultiplier > 0
then          begin            if FStars[i].X > WW+64 then           
begin              FStars[i].X := -64;              FStars[i].Y :=
50+Random(HH-150);            end;          end          else        
begin             if FStars[i].X < -64 then            begin         
   FStars[i].X := WW+64;              FStars[i].Y :=
50+Random(HH-150);            end;          end;        end;    end; 
end;   BGRAVirtualScreen.RedrawBitmap;  // refreshend; procedure
TForm1.BGRAVirtualScreenRedraw(Sender: TObject; Bitmap:
TBGRABitmap);var  i, Pidx : Integer;   // bob plane indexbegin  //
bobs  for i := 0 to Length(FStars) - 1 do  begin    Pidx :=
FStars[i].Plane;    Bitmap.PutImage(Trunc(FStars[i].X),
Trunc(FStars[i].Y), bob1Scale[Pidx], dmLinearBlend);  end;   // Gtr
sprites 
Bitmap.PutImage(-160+s_data[sin_ctr]*3,140,logo_g,dmLinearBlend); 
Bitmap.PutImage(-160+s_data[sin_ctt]*3,140,logo_t,dmLinearBlend); 
Bitmap.PutImage(-160+s_data[sin_ctg]*3,140,logo_r,dmLinearBlend);  
inc(sin_ctg,1);  sin_ctg := sin_ctg mod 256;  inc(sin_ctt,1);  sin_ctt
:= sin_ctt mod 256;  inc(sin_ctr,1);  sin_ctr := sin_ctr mod 256;   //
rectangles 
Bitmap.Rectangle(0,0,BGRAVirtualScreen.Width,80,Bgra(30,140,150),80); 
Bitmap.Rectangle(0,440,BGRAVirtualScreen.Width,440+80,Bgra(30,140,150)
,80);   // Scroll Text  bitmap.FontName:='Courier New'; 
bitmap.FontStyle := [fsBold];  bitmap.FontHeight := 40; 
bitmap.FontAntialias := false;   for  i := 0 to  Length(sc_txt[0])-1
do    begin       bitmap.TextOut(i*26+sc_xpos,460+Cos(sc_xpos*0.10)*4,
sc_txt[0][i],BGRA(250,250,250));        if sc_xpos <
-Length(sc_txt[0]) * 26  then sc_xpos := 850;        sc_xpos :=
sc_xpos -0.02;    end; end; procedure TForm1.FormCreate(Sender:
TObject);begin    // music xmp    ctx := xmp_create_context;   
InitAudio;    if xmp_load_module(ctx, 'defjam.mod') <> 0 then    // by
Fusion    begin      ShowMessage('Load module error.');      Exit;   
end;    xmp_start_player(ctx, SampleRate, 0) ;   bob1 :=
TBGRABitmap.Create('07.png');   bob1Scale[0] :=
bob1.Resample(Round(bob1.Width * 0.6), Round(bob1.Height * 0.6),
rmFineResample);  bob1Scale[1] := bob1.Resample(Round(bob1.Width *
0.8), Round(bob1.Height * 0.8), rmFineResample);  bob1Scale[2] :=
bob1.Resample(Round(bob1.Width * 1.2), Round(bob1.Height * 1.2),
rmFineResample);  bob1Scale[3] := bob1.Resample(Round(bob1.Width *
1.6), Round(bob1.Height * 1.6), rmFineResample);   ScrollMode :=
smHorizontal;  // init mode H/V  SpeedMultiplier := 3.0;      //
speed   Caption := 'BGRA BOB DEMO GIGATRON 2025 ';   logo_g :=
TBGRABitmap.Create('g.png');  logo_t := TBGRABitmap.Create('t.png'); 
logo_r := TBGRABitmap.Create('r.png');  sin_ctg := 0; // counter start
pos 0 at sin data  sin_ctt := 18;// '' start pos 18 at sin data 
sin_ctr := 36;// '' start pos 36 at sin data   SetLength(sc_txt, 1); 
sc_txt[0] := '........ GIGATRON PRESENTS LAZARUS 8.0 AND FPC SERVAL
6.0 CRACKED ON 03.06.2034 DYNAMIC COMPILATION '+               'CODE
PATCHED BY GIGATRON SFX : ESTRAYK GFX : WWW GREETINGS TO ALL MEMBERS
OF LAZARUS FORUM MAY THE'+               ' FORCES BE WITH YOU SEE YOU
ON NEXT PRODUCTION ........ ';  sc_xpos := 850;  // text start outside
the screen at pos 850   Randomize;  InitStars; end;// Free Stars and
Bob Table and close audioprocedure TForm1.FormDestroy(Sender:
TObject);var  i: Integer;begin  for i := 0 to 3 do     // 4 bob scale
table !    bob1Scale[i].Free;   bob1.Free;  SetLength(FStars, 0); 
CloseAudio;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  
 UpdateStars;end; end.

----------------------------------------------------------------------
korba812 · 2025-03-03 21:41

Eh, that reminded me of the "Starry Night" screensaver from Norton
Commander

----------------------------------------------------------------------
Gigatron · 2025-03-04 00:57

Quote from: korba812 on March 03, 2025, 10:41:29 pmEh, that reminded
me of the "Starry Night" screensaver from Norton Commander

Sure , here is another example  port from js source , create a cycle
of canvas to perform nice fx called
unlimited bob demo from Dragon Amiga. We are using Classic Paintbox !
https://youtu.be/F_z4bYO6OL8?si=I00Ogg3ES6h9lS9i&t=497

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; interface uses  Classes, SysUtils, Forms, Controls, Graphics,
Dialogs, ExtCtrls, Spin,  Buttons, StdCtrls; type  { TForm1 }  TForm1
= class(TForm)    Button1: TButton;    FloatSpinEdit1:
TFloatSpinEdit;    FloatSpinEdit2: TFloatSpinEdit;    FloatSpinEdit3:
TFloatSpinEdit;    FloatSpinEdit4: TFloatSpinEdit;    Timer1: TTimer; 
  PaintBox1: TPaintBox;    procedure Button1Click(Sender: TObject);  
procedure FormCreate(Sender: TObject);    procedure
FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender:
TObject);    procedure PaintBox1Paint(Sender: TObject);  private   
FBall: TBitmap;    FCinema: array[0..7] of TBitmap;    FCtrCinema:
Integer;    X1, X2, Y1, Y2: Single;    FSprites: Integer;    procedure
Balls(DestCanvas: TCanvas);  end; var  Form1:
TForm1; implementation {$R *.lfm} procedure
TForm1.Button1Click(Sender: TObject);var  i: integer;begin   for i :=
0 to 7 do  begin    FCinema[i].Canvas.Brush.Color := clBlack;   
FCinema[i].Canvas.FillRect(0, 0, 800, 600);  end;end; procedure
TForm1.FormCreate(Sender: TObject);var  i: Integer;begin   for i := 0
to 7 do  begin    FCinema[i] := TBitmap.Create;    FCinema[i].Width :=
800;    FCinema[i].Height := 600;    FCinema[i].Transparent := True; 
 FCinema[i].TransparentColor := clBlue;   
FCinema[i].Canvas.Brush.Color := clBlack;   
FCinema[i].Canvas.FillRect(0, 0, 800, 600);  end;   // Bob Load  FBall
:= TBitmap.Create;  FBall.LoadFromFile('bobs/00.bmp');   FCtrCinema :=
0;   FSprites := 0;  // Init float val  X1 := 0;   X2 := 0;    Y1 :=
0;  Y2 := 0; end; procedure TForm1.FormDestroy(Sender: TObject);var 
i: Integer;begin  FBall.Free;   for i := 0 to 7 do   
FCinema[i].Free;end; procedure TForm1.Timer1Timer(Sender:
TObject);begin  PaintBox1.Invalidate;end; procedure
TForm1.PaintBox1Paint(Sender: TObject);var  i: Integer;begin   for i
:= 0 to 7 do    Balls(FCinema[i].Canvas);  //**************** 
FCtrCinema := (FCtrCinema + 1) and 7;  PaintBox1.Canvas.Draw(0, 0,
FCinema[FCtrCinema]);end; procedure TForm1.Balls(DestCanvas:
TCanvas);var  x, y: Integer;begin  x := Round(320 + 280 * Cos(X1))
;//+ 135 * Sin(X2));  y := Round(240 + 240  * Sin(Y1)) ;// + 85 *
Cos(Y2));  DestCanvas.Draw(x, y, FBall);  X1 := X1 +
FloatSpinEdit1.Value; // X2 := X2 + FloatSpinEdit2.Value;  Y1 := Y1 +
FloatSpinEdit3.Value; // Y2 := Y2 + FloatSpinEdit4.Value;  
Inc(FSprites);end; end.

----------------------------------------------------------------------
Gigatron · 2025-03-04 22:56

Ok,

This unlimited bob is now finished , you can improve it to include
your own formula, i used
simple formula on www and they can be wrong !!
All needed is attached to zip file;

Have fun;

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; interface uses  Classes, SysUtils, Forms, Controls, Graphics,
Dialogs, ExtCtrls, Spin,  Buttons, StdCtrls; type   TMotionType =
(mtSimple, mtLissajous, mtSpiral, mtFlower,                 
mtButterfly, mtRose, mtSpirograph, mtHarmonic,                 
mtDoublePendule, mtTourbillon, mtSuperposition,                 
mtSpiraleLog, mtFractale, mtKaleidoscope );    { TForm1 }  TForm1 =
class(TForm)    Button1: TButton;    ComboBox1: TComboBox;   
ComboBox2: TComboBox;    FloatSpinEdit1, FloatSpinEdit2,
FloatSpinEdit3, FloatSpinEdit4 : TFloatSpinEdit;    Label1: TLabel;  
Label2: TLabel;    Label3: TLabel;    Label4: TLabel;    Panel1:
TPanel;    Timer1: TTimer;    PaintBox1: TPaintBox;     procedure
Button1Click(Sender: TObject);    procedure ComboBox1Change(Sender:
TObject);    procedure ComboBox2Change(Sender: TObject);    procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
PaintBox1Paint(Sender: TObject);  private     FBall: TBitmap;   
FCinema: array[0..7] of TBitmap;    FCtrCinema: Integer;    X1, X2,
Y1, Y2: Single;    FSprites: Integer;    procedure Balls(DestCanvas:
TCanvas);    Procedure ClearBalls;    end; var  Form1: TForm1; 
FMotionType: TMotionType;  BallColor  : integer; // index of combobox
! implementation {$R *.lfm} procedure TForm1.FormCreate(Sender:
TObject);var  i: Integer;begin   for i := 0 to 7 do  begin   
FCinema[i] := TBitmap.Create;    FCinema[i].Width := 800;   
FCinema[i].Height := 600;    FCinema[i].Transparent := True;   
FCinema[i].TransparentColor := clBlue;   
FCinema[i].Canvas.Brush.Color := clBlack;   
FCinema[i].Canvas.FillRect(0, 0, 800, 600);  end;   // Bob Load  FBall
:= TBitmap.Create;  FBall.LoadFromFile('bobs/00.bmp');  FCtrCinema :=
0;   FSprites := 0;  // Init float val  X1 := 0;   X2 := 0;    Y1 :=
0;  Y2 := 0;   ComboBox1.Items.Add('Simple'); 
ComboBox1.Items.Add('Lissajous');  ComboBox1.Items.Add('Spirale'); 
ComboBox1.Items.Add('Fleur');  ComboBox1.Items.Add('Papillon'); 
ComboBox1.Items.Add('Rose');  ComboBox1.Items.Add('Spirographe'); 
ComboBox1.Items.Add('Harmonique Composé'); 
ComboBox1.Items.Add('Double Pendule'); 
ComboBox1.Items.Add('Tourbillon Hypnotique'); 
ComboBox1.Items.Add('Superposition d''Harmoniques'); 
ComboBox1.Items.Add('Spirale Logarithmique'); 
ComboBox1.Items.Add('Fractale Simple'); 
ComboBox1.Items.Add('Kaléidoscope');   ComboBox1.ItemIndex := 0; //
red Ball first  FMotionType := TMotionType(ComboBox1.ItemIndex);  
ComboBox1.ItemIndex := 0;  ComboBox2.Items.Add('Red'); 
ComboBox2.Items.Add('Green');  ComboBox2.Items.Add('Blue'); 
ComboBox2.Items.Add('Grey');  ComboBox2.Items.Add('Magenta'); 
ComboBox2.Items.Add('Yellow');  ComboBox2.Items.Add('Orange'); 
ComboBox2.Items.Add('Dark Grey');  ComboBox2.Items.Add('8
Bits');  end; procedure TForm1.FormDestroy(Sender: TObject);var  i:
Integer;begin  FBall.Free;   for i := 0 to 7 do   
FCinema[i].Free;end; procedure TForm1.Timer1Timer(Sender:
TObject);begin  PaintBox1.Invalidate;end; procedure
TForm1.PaintBox1Paint(Sender: TObject);var  i: Integer;begin   for i
:= 0 to 7 do    Balls(FCinema[i].Canvas);  //**************** 
FCtrCinema := (FCtrCinema + 1) and 7;  PaintBox1.Canvas.Draw(0, 0,
FCinema[FCtrCinema]);end; procedure TForm1.Balls(DestCanvas:
TCanvas);var  x, y: Integer;  radius, angle, bigRadius, distance:
Single;begin  case FMotionType of    mtSimple:    begin      x :=
Round(320 + 280 * Cos(X1));      y := Round(240 + 240 * Sin(Y1));   
end;     mtLissajous:    begin      x := Round(320 + 280 * Sin(X1) *
Cos(X2));      y := Round(240 + 240 * Sin(Y1) * Cos(Y2));    end;    
mtSpiral:    begin      x := Round(320 + X1 * Cos(X1) *
FloatSpinEdit2.Value + X2 * Sin(X2));      y := Round(240 + Y1 *
Sin(Y1) * FloatSpinEdit4.Value + Y2 * Cos(Y2));    end;     mtFlower: 
  begin      x := Round(320 + 280 * Cos(X1) * Sin(X2 *
FloatSpinEdit2.Value));      y := Round(240 + 240 * Sin(Y1) * Cos(Y2 *
FloatSpinEdit4.Value));    end;     mtButterfly:    begin      x :=
Round(320 + 280 * Sin(X1) * Cos(Y1) * Sin(X2));      y := Round(240 +
240 * Sin(X1) * Sin(Y1) * Cos(Y2));    end;     mtRose:    begin     
radius := 280 * Cos(FloatSpinEdit2.Value * X1) *
Sin(FloatSpinEdit4.Value * X2);      x := Round(320 + radius *
Cos(X1));      y := Round(240 + radius * Sin(Y1));    end;    
mtSpirograph:    begin      bigRadius := 145 + 30 * Sin(X2);     
radius := FloatSpinEdit2.Value * 10 + 5 * Cos(Y2);      distance :=
FloatSpinEdit4.Value * 10;      x := Round(320 + (bigRadius-radius) *
Cos(X1) + distance * Cos(((bigRadius-radius)/radius) * X1));      y :=
Round(240 + (bigRadius-radius) * Sin(Y1) - distance * Sin(((bigRadius-
radius)/radius) * Y1));    end;     mtHarmonic:    begin      x :=
Round(320 + 280 * Sin(X1) + 100 * Sin(X2 * FloatSpinEdit2.Value));   
 y := Round(240 + 200 * Cos(Y1) + 80 * Cos(Y2 *
FloatSpinEdit4.Value));    end;     mtDoublePendule:    begin      x
:= Round(320 + 150 * Sin(X1) + 130 * Sin(X1 + X2));      y :=
Round(240 + 150 * Cos(Y1) + 130 * Cos(Y1 + Y2));    end;    
mtTourbillon:    begin      radius := 200 * (Sin(X1) * Sin(X2) +
Cos(Y1) * Cos(Y2));      angle := X1 * 3 + Y1 * 2;      x := Round(320
+ radius * Cos(angle));      y := Round(240 + radius * Sin(angle));  
end;     mtSuperposition:    begin      x := Round(320 + 280 * Sin(X1)
* Cos(X2 * 2) + 50 * Sin(X1 * 3 + X2 * 2));      y := Round(240 + 240
* Sin(Y1) * Cos(Y2 * 3) + 40 * Sin(Y1 * 2 + Y2 * 5));    end;    
mtSpiraleLog:    begin      radius := 0.2 * Exp(0.1 * X1) * (1 + 0.3 *
Sin(X2 * 10));      angle := Y1 + 0.2 * Sin(Y2 * 2);      x :=
Round(320 + radius * Cos(angle));      y := Round(240 + radius *
Sin(angle));    end;     mtFractale:    begin      x := Round(320 +
300 * Sin(X1) * Sin(X1 * X2 * 0.01));      y := Round(240 + 300 *
Cos(Y1) * Cos(Y1 * Y2 * 0.01));    end;     mtKaleidoscope:    begin 
   angle := X1 + Sin(X2);      radius := 200 * Sin(Y1 * 3) * Cos(Y2 *
2);      x := Round(320 + radius * Cos(angle));      y := Round(240 +
radius * Sin(angle));    end;   end;     DestCanvas.Draw(x, y,
FBall);     X1 := X1 + FloatSpinEdit1.Value;    X2 := X2 +
FloatSpinEdit2.Value;    Y1 := Y1 + FloatSpinEdit3.Value;    Y2 := Y2
+ FloatSpinEdit4.Value;    Inc(FSprites); end; procedure
TForm1.Button1Click(Sender: TObject);begin ClearBalls;end; procedure
TForm1.ComboBox1Change(Sender: TObject);begin    ClearBalls;   
FMotionType := TMotionType(ComboBox1.ItemIndex);end; procedure
TForm1.ComboBox2Change(Sender: TObject); begin    ClearBalls;   
BallColor := ComboBox2.ItemIndex;     BallColor :=
ComboBox2.ItemIndex;    FBall.LoadFromFile(Format('bobs/%.2d.bmp',
[BallColor]));end; procedure TForm1.ClearBalls;var  i : integer;begin 
     for i := 0 to 7 do      begin       FCinema[i].Canvas.Brush.Color
:= clBlack;       FCinema[i].Canvas.FillRect(0, 0, 800, 600);     
end;end; end.

----------------------------------------------------------------------
Gigatron · 2025-03-08 21:05

Hi

Another nice fx using BGRA Component called 3d Tunnel under 130 lines
of code ;

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,  ExtCtrls, StdCtrls,  Spin, BGRAVirtualScreen,
BGRABitmap, BGRABitmapTypes, Math; type  { TForm1 }  TForm1 =
class(TForm)    Button1: TButton;    Button2: TButton;    Button3:
TButton;    SpinEdit1: TSpinEdit;    VirtualScreen:
TBGRAVirtualScreen;    Timer: TTimer;    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure Button1Click(Sender: TObject);    procedure
Button2Click(Sender: TObject);    procedure Button3Click(Sender:
TObject);    procedure FormCreate(Sender: TObject);    procedure
SpinEdit1Change(Sender: TObject);    procedure TimerTimer(Sender:
TObject);  private    Speed, RotSpeed: Single;    Segments: Integer; 
 PathTime, RotAngle: Single;    function GetCl(Value, Agl, Rd:
Single): TBGRAPixel;  public  end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin  Speed := 5.0;  Segments :=
12;  RotSpeed := 0.0;  PathTime := 0.0001;  RotAngle :=
0;end; function TForm1.GetCl(Value, Agl, Rd: Single):
TBGRAPixel;begin  if Value > 0.5 then Result := BGRA(230,210,0)  else
 Result := BGRA(0, 0, 160);end; procedure TForm1.TimerTimer(Sender:
TObject);begin  PathTime := PathTime + (Speed * 0.01);  RotAngle :=
RotAngle - RotSpeed;  if RotAngle > 2 * Pi then RotAngle := RotAngle -
(2 * Pi);  VirtualScreen.RedrawBitmap;end; procedure
TForm1.BGRAVirtualScreenRedraw(Sender: TObject; Bitmap:
TBGRABitmap);var  x, y: Integer;  CenterX, CenterY, MinRadius :
Single;  UVX, UVY, RotX, RotY, Dot, TunnelDist, ZFactor, Angle,
Tunnel: Single;  Clr: TBGRAPixel;begin  Bitmap.Fill(clBlack);  CenterX
:= VirtualScreen.Width / 2 ;  CenterY := VirtualScreen.Height / 2 ; 
MinRadius := 0.015;   for y := 0 to VirtualScreen.Height - 1 do    for
x := 0 to VirtualScreen.Width - 1 do    begin      UVX := (x -
CenterX) / VirtualScreen.Height;      UVY := (y - CenterY) /
VirtualScreen.Height;      RotX := UVX * Cos(RotAngle) - UVY *
Sin(RotAngle);      RotY := UVX * Sin(RotAngle) + UVY *
Cos(RotAngle);      Dot := RotX * RotX + RotY * RotY;      if Dot <
MinRadius then Continue;      ZFactor := 1.0 ;      TunnelDist := 4.0
/ (Sqrt(Dot) * ZFactor);      Angle := ArcTan2(RotY, RotX);     
Tunnel := TunnelDist + PathTime ;      Tunnel := Tunnel + Round(Angle
* 180.0 / Pi / (360 / Segments));      Clr := GetCl(Tunnel * 0.5 mod
1, Angle, TunnelDist);      Bitmap.SetPixel(x, y, Clr);   
end;end; procedure TForm1.Button1Click(Sender: TObject);begin     
 RotSpeed := -0.01;end; procedure TForm1.Button2Click(Sender:
TObject);begin  RotSpeed := 0.01;end; procedure
TForm1.Button3Click(Sender: TObject);begin      RotSpeed :=
0.0;end; procedure TForm1.SpinEdit1Change(Sender: TObject);begin   
 Speed := SpinEdit1.value div 10;end; end.

----------------------------------------------------------------------
Gigatron · 2025-03-12 02:27

Hi

Today, I read for 3 hours of the doc and sources of various components
(more BGRA) .

To reduce the code for the beginner in their project, I decided to
make a 2dStarfield component.

Start a new application project with Form
Go to the Package tab and open the.lpk file (included in .zip);
Compile and Install
After that, if all went well, you have a new palette of 2DStarfield
components;
Insert T2DStarfield into your project This component works in the mod
editor and based on TPaintbox.

The color of the stars is white, but consider this my first attempt at
making the component.
Try it and send me feedback please, my operating system is win10
x64bit.

After compiling this project without debugger and uPX compression i ve
got 802 kb of exec file.. good !!

Regards

----------------------------------------------------------------------
Gigatron · 2025-03-12 13:46

Hi
Here is a new version of  this component;

You can now reduce intensity of colors ; val between(0 to  1.0)
For eg : if you want Blue stars set R=0 G=0 B=1
For Green :                                 R=0 G=1 B=0
For Yellow :                                 R=1 G=1 B=0

Regards

----------------------------------------------------------------------
Gigatron · 2025-03-14 23:16

Hi

Playing with .lpk to produce FX *with* minimal code ? That's possible;

3 component running in editor exemple ; I will upload them when
finished sure ;

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, uCopperBar,  uScrollText,
u2DStarfield; type   { TForm1 }   TForm1 = class(TForm)    CopperBar1:
TCopperBar;    ScrollText1: TScrollText;    T2DStarfield1:
T2DStarfield;  private   public   end; var  Form1:
TForm1; implementation {$R *.lfm} end.

----------------------------------------------------------------------
Gigatron · 2025-03-18 22:19

Nice again;

I you want to make effects with shader i ve simplified the code for
your understand;

This project use the Awesome BGRA GL package from @circular !

We have 2 memo to store vertex and fragment shader. Don't touch vertex
shader;
Project is attached in .zip format , shader used is different ;

Good Luck !

go to Glslsandbox;

https://glslsandbox.com/   www contains some pixel shaders.

Copy shader and past to fragMemo Lines [Tstrings] and then Click Run
Shader;


for example take the first shader on top left;

https://glslsandbox.com/e#370395.0

Fragment is now like : 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 #ifdef GL_ESprecision mediump float;#endif// dashxdr was here
20120228// whoops the rainbow colors weren't correct...// ugh, can't
stand the previous version... too dizzy uniform float time;uniform
vec2 mouse;uniform vec2 resolution;  //float rainbow(float x)//{//   
 x=fract(0.16666 * abs(x));//      if(x>.5) x = 1.0-x;//      return
smoothstep(.166666, .333333, 0.7);//} void main( void ) {         vec2
position = ( 2.0*gl_FragCoord.xy - resolution) / resolution.xx;float
ti=time*0.;        vec3 color = vec3(0.0);         float r =
length(position);        float a = atan(position.y, position.x);     
  float b = a*3.0/3.14159;        color = vec3(0.0, 0.0, 1.0);       
float t = .5*(1.0 + cos(a + 40.0 * r * (1.0 + sin(a*24.0)*.1) - ti) *
(5.0 / (r+5.0)));        //t = (t<0.5) ? 0.0 : 1.0;       
gl_FragColor.rgba = vec4(color*t, 1.0); }
And so on ; don't use Backbuffered or Sampler2d shaders for now;

----------------------------------------------------------------------
Gigatron · 2025-03-19 11:32

Hi

Here is the final version of the fx shader example, you can now edit
the shader code On Memotext.
Load your own  texture image with pascal code , Uniform SamplerD2 is
used in this case ;

The code is now very very simple to include pixel shader on your
projects.

I didn't implement the error capture exception, so don't make a
mistake when editing the shader code otherwise the program crashes if
the shader code has an error !

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,  BGRAOpenGL,
BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen, GL; type  { TForm1
}   TForm1 = class(TForm)    Button2: TButton;    Memo1: TMemo;   
ShaderScreen1: TBGLVirtualScreen;    FragMemo: TMemo;    Timer1:
TTimer;    VertexMemo: TMemo;    procedure Button2Click(Sender:
TObject);    procedure ShaderScreen1LoadTextures(Sender: TObject;
BGLContext: TBGLContext);    procedure ShaderScreen1Redraw(Sender:
TObject; BGLContext: TBGLContext);    procedure
ShaderScreen1UnloadTextures(Sender: TObject; BGLContext:
TBGLContext);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);    procedure Display_GlInfo; // 
private   public       gl_surface : IBGLTexture; shader3 :
TBGLShader3D;       ctx  : TBGLContext;       t : single; // uniform
time       fshader : string ; vshader : string; // fragment and
vertex  end; var   Form1: TForm1; implementation {$R *.lfm} { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin  fshader :=
FragMemo.text;  vshader := VertexMemo.Text;end; procedure
TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);begin   if gl_surface <> nil then   
 BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width,
ShaderScreen1.Height, gl_surface);   if shader3 <> nil then  begin   
BGLContext.Canvas.Lighting.ActiveShader := shader3; 
end;end; procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject;
BGLContext: TBGLContext);begin   try     gl_surface :=
BGLTexture(ResourceFile('gl.png'));    // Create shader    shader3 :=
TBGLShader3D.Create(      BGLContext.Canvas,      vshader,   // Vertex
shader      fshader,   // Fragment shader      'varying vec2
texCoord;',      '130');    // Version GLSL       ctx := BGLContext; 
except    on E: Exception do      raise exception.Create('Shader Error
: ' + E.Message);  end;end; procedure TForm1.Button2Click(Sender:
TObject);begin  try    fshader := FragMemo.Text;    vshader :=
VertexMemo.Text;     if Assigned(shader3) then    begin     
ctx.Canvas.Lighting.ActiveShader := nil;      FreeAndNil(shader3);   
end;     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader,
'varying vec2 texCoord;', '130');    // if shader error,  exception
raised by BGRAOpenGLD3 nice :);    Display_GlInfo;       //  infos
OpenGL    Timer1.Enabled := True; // timer1  except    on E: Exception
do      ShowMessage('Shader Error : ' + E.Message); 
end;end; procedure TForm1.ShaderScreen1UnloadTextures(Sender:
TObject;  BGLContext: TBGLContext);begin  gl_surface  := nil; 
FreeAndNil(shader3);  BGLContext.Canvas.Lighting.ActiveShader :=
nil;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  if
shader3 <> nil then  begin   
shader3.UniformPointF['resolution'].Value :=
Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));   
shader3.UniformSingle['time'].Value := t;   
shader3.UniformSingle['speed'].Value := 0.8;    
shader3.UniformSingle['r'].Value := 0.0;   
shader3.UniformSingle['g'].Value := 0.8;   
shader3.UniformSingle['b'].Value := 0.0;     t := t + 0.014;   
ShaderScreen1.Invalidate;  end;end; procedure
TForm1.Display_GlInfo;begin  Memo1.Clear;  // opengl infos 
Memo1.Lines.Add('OpenGL Vendor: '   + glGetString(GL_VENDOR)); 
Memo1.Lines.Add('OpenGL Renderer: ' + glGetString(GL_RENDERER)); 
Memo1.Lines.Add('OpenGL Version: '  + glGetString(GL_VERSION)); 
Memo1.Lines.Add('EXT :');  Memo1.Lines.Add(
glGetString(GL_EXTENSIONS));end; end.

----------------------------------------------------------------------
Gigatron · 2025-03-21 19:06

Ok here are two lpk , 2DStarfield  and TextScroll, please uninstall
2DStarfield if you got it , 
these lpk is now use OldSchoolFX tab in package palette all My future
extensions Tab.

2DStarfield and ScrollText are animated in DesignTime (Editor);

The goal is minimal code , like so :

Have Fun.

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,   uScrollText,
u2DStarfield; type   { TForm1 }   TForm1 = class(TForm)   
ScrollText1: TScrollText;    ScrollText2: TScrollText;    ScrollText3:
TScrollText;    ScrollText4: TScrollText;    ScrollText5:
TScrollText;    ScrollText6: TScrollText;    ScrollText7:
TScrollText;    T2DStarfield1: T2DStarfield;    procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);   private   public   end; var  Form1: TForm1;  sc_txt :Array
of PChar; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin   SetLength(sc_txt, 1); 
sc_txt[0] := '........ GIGATRON PRESENTS LAZARUS 8.0 AND FPC SERVAL
6.0 CRACKED ON 03.06.2034 DYNAMIC COMPILATION '+               'CODE
PATCHED BY GIGATRON SFX : ESTRAYK GFX : WWW GREETINGS TO ALL MEMBERS
OF LAZARUS FORUM MAY THE'+               ' FORCES BE WITH YOU SEE YOU
ON NEXT PRODUCTION ........ ';     ScrollText1.ScrollText:=sc_txt[0]; 
ScrollText2.ScrollText:=sc_txt[0]; 
ScrollText3.ScrollText:=sc_txt[0]; 
ScrollText4.ScrollText:=sc_txt[0]; 
ScrollText5.ScrollText:=sc_txt[0]; 
ScrollText6.ScrollText:=sc_txt[0]; 
ScrollText7.ScrollText:=sc_txt[0]; end;  procedure
TForm1.FormDestroy(Sender: TObject);begin end;  end.

----------------------------------------------------------------------
Gigatron · 2025-06-04 17:51

Hello,

Here's a demonstration using Windows' native canvas and optimised draw
routines under Lazarus FPC.

The goal was to display 50,000 stars.
I'm sending you the link to the video, so you can watch the
performance.
Regards

https://www.youtube.com/watch?v=ZoAo-02kmls

The executable Link : https://filesharer.io/en/d/wjqU1Ljx88Zllz

** Edited description

----------------------------------------------------------------------
440bx · 2025-06-04 20:12

Quote from: Gigatron on June 04, 2025, 07:51:17 pmI'm sending you the
link to the video, so you can watch the performance.
But... how does your demonstration prove anything about Pascal/FPC ?
libXMP is written in C and it is reasonable to presume that, it is
that library that is mostly, if not entirely, responsible for the
performance.

Can you make a demo like the one in your video using _pure_ Pascal/FPC
?

Also, if you give credit to the language used, in this case Pascal,
then it seems reasonable that you provide the source code for the
results to be verified by others.

----------------------------------------------------------------------
Gigatron · 2025-06-04 20:37

You are absolutely right.
I did not manage to get the same performance with the pascal code
without directly using the Windows API. So I'm going to change the
description. Thank you

----------------------------------------------------------------------
440bx · 2025-06-04 21:31

Quote from: Gigatron on June 04, 2025, 10:37:02 pmYou are absolutely
right.
I did not manage to get the same performance with the pascal code
without directly using the Windows API. So I'm going to change the
description. Thank you
You're welcome, anytime.  I'm pleased you see the point.

ETA:

Just for the record, I think that using the Windows API to implement
your demo is perfectly reasonable and valid.

----------------------------------------------------------------------
Gigatron · 2025-06-09 00:36

Hi,

I am working on an new Library project using Windows Api to include
some Amiga like
effects.
If you want to see the exemple here is the YT Link;

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

----------------------------------------------------------------------
440bx · 2025-06-09 00:55

That looks quite nice.

Do you plan on eventually sharing the library ?  Aside from being
useful, it would be very educational (at least to me.)

----------------------------------------------------------------------
Gigatron · 2025-06-09 10:54

Quote from: 440bx on June 09, 2025, 02:55:55 amThat looks quite nice.

Do you plan on eventually sharing the library ?  Aside from being
useful, it would be very educational (at least to me.)

Hi,

Absolutely, soon I'm going to start a new topic on this library and
start step by step,
that way you can see the progress.
A library only dedicated to Amiga effects, was that my dream:)

----------------------------------------------------------------------
440bx · 2025-06-09 11:03

Quote from: Gigatron on June 09, 2025, 12:54:42 pmHi,

Absolutely, soon I'm going to start a new topic on this library and
start step by step,
that way you can see the progress.
A library only dedicated to Amiga effects, was that my dream:)
That sounds great.  I'm looking forward to it.