Binary Matrix Effect
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-05-09 18:12

Hi,

Short code to simulate animated binary matrix effect.

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, Spin,  BGRAVirtualScreen,
BGRABitmap, BGRABitmapTypes; type   { TForm1 }   TForm1 =
class(TForm)    Panel1: TPanel;    Red_Spin: TSpinEdit;    Green_Spin:
TSpinEdit;    Blue_Spin: TSpinEdit;    Vscreen: TBGRAVirtualScreen;  
Timer1: TTimer;    procedure VScreenRedraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);    procedure FormDestroy(Sender:
TObject);  private    Ypos: array of Integer;    Colcnt: Integer;   
Buff: TBGRABitmap;  public  end; var  Form1: TForm1; 
RRed,RGreen,RBlue : integer; implementation {$R *.lfm} { TForm1
} procedure TForm1.FormCreate(Sender: TObject);var  i: Integer;begin 
Randomize;  Colcnt := Round(Vscreen.Width / 14);  SetLength(Ypos,
Colcnt);  Buff := TBGRABitmap.Create(Vscreen.Width, Vscreen.Height);  
// fill Ypos table  for i := 0 to High(Ypos) do    Ypos[i] :=
Random(Vscreen.Height div 2); // mid end; procedure
TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);var  x, y,
i: Integer;begin   Buff.FillRect(0, 0, Buff.Width, Buff.Height,
BGRA(0, 0, 0, 35), dmDrawWithTransparency);  Buff.FontHeight := 15;
//**  Buff.FontName := 'Courier New';  Buff.FontStyle := [fsBold];  
for i := 0 to High(Ypos) do  begin    x := i * 15; // 15 = space;
fontH **    y := Ypos[i];    if Random > 0.5 then      Buff.TextOut(x,
y, '1', BGRA(RRed, RGreen,RBlue)) //  or Chr(Random(128)) instead '1' 
  else      Buff.TextOut(x, y, '0', BGRA(RRed, RGreen,RBlue)); // Or
Chr(Random(128)) instead '0'  end;   Bitmap.BlendImage(0, 0, Buff,
boLinearBlend);end; procedure TForm1.Timer1Timer(Sender: TObject);var 
i: Integer;begin   for i := 0 to High(Ypos) do  begin    if (Ypos[i] >
Vscreen.Height) or ((Ypos[i] > 100) and (Random > 0.98)) then     
Ypos[i] := 0    else      Ypos[i] := Ypos[i] + 15; // 15 ** FontH 
end;  RRed := Red_Spin.Value;  RGreen := Green_Spin.Value;  RBlue :=
Blue_Spin.Value;  Vscreen.RedrawBitmap; end; // free allprocedure
TForm1.FormDestroy(Sender: TObject);begin  SetLength(Ypos, 0); 
Buff.Free;end; end.

----------------------------------------------------------------------
Hansvb · 2025-05-09 18:46

Nice.

----------------------------------------------------------------------
Gigatron · 2025-05-13 17:35

Hi

You can see here how CPU is working, or the cortex of programmer  in
slow motion, fast optimised code.

Edit:
Maybe i can finish to code led scrolling text ! (see pic)

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+}interfaceuses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  BGRAVirtualScreen,
BGRABitmap, BGRABitmapTypes;const  xx = 42;  yy = 31;  Cell_Size =
15;  Chr_Count = 2; // Only Char 0 -1 , ascii code 48=0 49=1type  {
TForm1 }  TForm1 = class(TForm)    Panel1: TPanel;    Red_Spin:
TSpinEdit;    Green_Spin: TSpinEdit;    Blue_Spin: TSpinEdit;   
Vscreen: TBGRAVirtualScreen;    Timer1: TTimer;    procedure
VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure
FormCreate(Sender: TObject);    procedure Timer1Timer(Sender:
TObject);    procedure FormDestroy(Sender: TObject);  private    Buff:
TBGRABitmap;    CharBitmaps: array[0..Chr_Count-1] of TBGRABitmap; //
bitmap table 0 to charcount    CharMatrix: array[0..xx, 0..yy] of
Byte;    ChrCol    : TBGRAPixel;    procedure GenChar;    procedure
UpdateCharBitmaps;  public  end;var  Form1: TForm1; implementation {$R
*.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);var  i:
Integer;begin  Randomize;  Buff := TBGRABitmap.Create(Vscreen.Width,
Vscreen.Height);   for i := 0 to Chr_Count-1 do  begin   
CharBitmaps[i] := TBGRABitmap.Create(Cell_Size, Cell_Size);   
CharBitmaps[i].FontHeight := 15;    CharBitmaps[i].FontName :=
'Courier New';    CharBitmaps[i].FontStyle := [fsBold];  end;  
GenChar;  ChrCol := BGRA(Red_Spin.Value, Green_Spin.Value,
Blue_Spin.Value);  UpdateCharBitmaps;end; procedure
TForm1.UpdateCharBitmaps;var  i, textW, textH: Integer;  charToUse:
Char;begin  for i := 0 to Chr_Count-1 do  begin   
CharBitmaps[i].Fill(BGRABlack);    charToUse := Chr(48 + i); //0-1   
// OR  (A-Z from Ascii code 65 To Chr_Count ):    // charToUse :=
Chr(65 + i);    textW := CharBitmaps[i].TextSize(charToUse).cx;   
textH := CharBitmaps[i].TextSize(charToUse).cy;    if (charTouse='0')
then    CharBitmaps[i].TextOut((Cell_Size - textW) div 2,(Cell_Size -
textH) div 2,charToUse,ChrCol);     if (charTouse='1') then   
CharBitmaps[i].TextOut((Cell_Size - textW) div 2,(Cell_Size - textH)
div 2,charToUse,BGRA(255,255,255));   end;end; procedure
TForm1.GenChar;var  i, j: Integer;begin  for i := 0 to xx do    for j
:= 0 to yy do      CharMatrix[i, j] :=
Random(Chr_Count);end; procedure TForm1.VScreenRedraw(Sender: TObject;
Bitmap: TBGRABitmap);var  i, j, x, y: Integer;begin 
Buff.Fill(BGRABlack);   for i := 0 to xx do    for j := 0 to yy do   
begin      x := i * Cell_Size;      y := j * Cell_Size;     
Buff.PutImage(x, y, CharBitmaps[CharMatrix[i, j]],
dmDrawWithTransparency);    end;   Bitmap.PutImage(0, 0, Buff,
dmSet); end; procedure TForm1.Timer1Timer(Sender: TObject);begin   
GenChar;    // optimisation maximale    ChrCol := BGRA(Red_Spin.Value,
Green_Spin.Value, Blue_Spin.Value);    UpdateCharBitmaps;   
Vscreen.RedrawBitmap;end; procedure TForm1.FormDestroy(Sender:
TObject);var  i: Integer;begin  Buff.Free;  for i := 0 to Chr_Count-1
do    CharBitmaps[i].Free;end; end.

----------------------------------------------------------------------
Curt Carpenter · 2025-05-14 14:33

Thanks!  I've been meaning to learn something about BGRA and your very
visually appealing code looks like a good way to start doing that.

----------------------------------------------------------------------
Gigatron · 2025-05-14 17:06

Quote from: Curt Carpenter on May 14, 2025, 04:33:26 pmThanks!  I've
been meaning to learn something about BGRA and your very visually
appealing code looks like a good way to start doing that.

I'm glad you're learning something in programming, I'm trying to
simplify as much as possible.