Binary Matrix Effect

[Gigatron]

Hi,

Short code to simulate animated binary matrix effect.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Panel1: TPanel;
17.     Red_Spin: TSpinEdit;
18.     Green_Spin: TSpinEdit;
19.     Blue_Spin: TSpinEdit;
20.     Vscreen: TBGRAVirtualScreen;
21.     Timer1: TTimer;
22.     procedure VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
23.     procedure FormCreate(Sender: TObject);
24.     procedure Timer1Timer(Sender: TObject);
25.     procedure FormDestroy(Sender: TObject);
26.   private
27.     Ypos: array of Integer;
28.     Colcnt: Integer;
29.     Buff: TBGRABitmap;
30.   public
31.   end;
32.  
33. var
34.   Form1: TForm1;
35.   RRed,RGreen,RBlue : integer;
36.  
37. implementation
38.  
39. {$R *.lfm}
40.  
41. { TForm1 }
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. var
45.   i: Integer;
46. begin
47.   Randomize;
48.   Colcnt := Round(Vscreen.Width / 14);
49.   SetLength(Ypos, Colcnt);
50.   Buff := TBGRABitmap.Create(Vscreen.Width, Vscreen.Height);
51.  
52.   // fill Ypos table
53.   for i := 0 to High(Ypos) do
54.     Ypos[i] := Random(Vscreen.Height div 2); // mid
55.  
56. end;
57.  
58. procedure TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
59. var
60.   x, y, i: Integer;
61. begin
62.  
63.   Buff.FillRect(0, 0, Buff.Width, Buff.Height, BGRA(0, 0, 0, 35), dmDrawWithTransparency);
64.   Buff.FontHeight := 15; //**
65.   Buff.FontName := 'Courier New';
66.   Buff.FontStyle := [fsBold];
67.  
68.   for i := 0 to High(Ypos) do
69.   begin
70.     x := i * 15; // 15 = space; fontH **
71.     y := Ypos[i];
72.     if Random > 0.5 then
73.       Buff.TextOut(x, y, '1', BGRA(RRed, RGreen,RBlue)) //  or Chr(Random(128)) instead '1'
74.     else
75.       Buff.TextOut(x, y, '0', BGRA(RRed, RGreen,RBlue)); // Or Chr(Random(128)) instead '0'
76.   end;
77.  
78.   Bitmap.BlendImage(0, 0, Buff, boLinearBlend);
79. end;
80.  
81. procedure TForm1.Timer1Timer(Sender: TObject);
82. var
83.   i: Integer;
84. begin
85.  
86.   for i := 0 to High(Ypos) do
87.   begin
88.     if (Ypos[i] > Vscreen.Height) or ((Ypos[i] > 100) and (Random > 0.98)) then
89.       Ypos[i] := 0
90.     else
91.       Ypos[i] := Ypos[i] + 15; // 15 ** FontH
92.   end;
93.   RRed := Red_Spin.Value;
94.   RGreen := Green_Spin.Value;
95.   RBlue := Blue_Spin.Value;
96.   Vscreen.RedrawBitmap;
97.  
98. end;
99.  
100. // free all
101. procedure TForm1.FormDestroy(Sender: TObject);
102. begin
103.   SetLength(Ypos, 0);
104.   Buff.Free;
105. end;
106.  
107. end.

[Hansvb]

Nice.

[Gigatron]

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][+][-]

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
6.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
7. const
8.   xx = 42;
9.   yy = 31;
10.   Cell_Size = 15;
11.   Chr_Count = 2; // Only Char 0 -1 , ascii code 48=0 49=1
12. type
13.   { TForm1 }
14.   TForm1 = class(TForm)
15.     Panel1: TPanel;
16.     Red_Spin: TSpinEdit;
17.     Green_Spin: TSpinEdit;
18.     Blue_Spin: TSpinEdit;
19.     Vscreen: TBGRAVirtualScreen;
20.     Timer1: TTimer;
21.     procedure VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
22.     procedure FormCreate(Sender: TObject);
23.     procedure Timer1Timer(Sender: TObject);
24.     procedure FormDestroy(Sender: TObject);
25.   private
26.     Buff: TBGRABitmap;
27.     CharBitmaps: array[0..Chr_Count-1] of TBGRABitmap; // bitmap table 0 to charcount
28.     CharMatrix: array[0..xx, 0..yy] of Byte;
29.     ChrCol    : TBGRAPixel;
30.     procedure GenChar;
31.     procedure UpdateCharBitmaps;
32.   public
33.   end;
34. var
35.   Form1: TForm1;
36.  
37. implementation
38.  
39. {$R *.lfm}
40.  
41. { TForm1 }
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. var
45.   i: Integer;
46. begin
47.   Randomize;
48.   Buff := TBGRABitmap.Create(Vscreen.Width, Vscreen.Height);
49.  
50.   for i := 0 to Chr_Count-1 do
51.   begin
52.     CharBitmaps[i] := TBGRABitmap.Create(Cell_Size, Cell_Size);
53.     CharBitmaps[i].FontHeight := 15;
54.     CharBitmaps[i].FontName := 'Courier New';
55.     CharBitmaps[i].FontStyle := [fsBold];
56.   end;
57.  
58.   GenChar;
59.   ChrCol := BGRA(Red_Spin.Value, Green_Spin.Value, Blue_Spin.Value);
60.   UpdateCharBitmaps;
61. end;
62.  
63. procedure TForm1.UpdateCharBitmaps;
64. var
65.   i, textW, textH: Integer;
66.   charToUse: Char;
67. begin
68.   for i := 0 to Chr_Count-1 do
69.   begin
70.     CharBitmaps[i].Fill(BGRABlack);
71.     charToUse := Chr(48 + i); //0-1
72.     // OR  (A-Z from Ascii code 65 To Chr_Count ):
73.     // charToUse := Chr(65 + i);
74.     textW := CharBitmaps[i].TextSize(charToUse).cx;
75.     textH := CharBitmaps[i].TextSize(charToUse).cy;
76.     if (charTouse='0') then
77.     CharBitmaps[i].TextOut((Cell_Size - textW) div 2,(Cell_Size - textH) div 2,charToUse,ChrCol);
78.  
79.     if (charTouse='1') then
80.     CharBitmaps[i].TextOut((Cell_Size - textW) div 2,(Cell_Size - textH) div 2,charToUse,BGRA(255,255,255));
81.  
82.   end;
83. end;
84.  
85. procedure TForm1.GenChar;
86. var
87.   i, j: Integer;
88. begin
89.   for i := 0 to xx do
90.     for j := 0 to yy do
91.       CharMatrix[i, j] := Random(Chr_Count);
92. end;
93.  
94. procedure TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
95. var
96.   i, j, x, y: Integer;
97. begin
98.   Buff.Fill(BGRABlack);
99.  
100.   for i := 0 to xx do
101.     for j := 0 to yy do
102.     begin
103.       x := i * Cell_Size;
104.       y := j * Cell_Size;
105.       Buff.PutImage(x, y, CharBitmaps[CharMatrix[i, j]], dmDrawWithTransparency);
106.     end;
107.  
108.   Bitmap.PutImage(0, 0, Buff, dmSet);
109.  
110. end;
111.  
112. procedure TForm1.Timer1Timer(Sender: TObject);
113. begin
114.     GenChar;
115.     // optimisation maximale
116.     ChrCol := BGRA(Red_Spin.Value, Green_Spin.Value, Blue_Spin.Value);
117.     UpdateCharBitmaps;
118.     Vscreen.RedrawBitmap;
119. end;
120.  
121. procedure TForm1.FormDestroy(Sender: TObject);
122. var
123.   i: Integer;
124. begin
125.   Buff.Free;
126.   for i := 0 to Chr_Count-1 do
127.     CharBitmaps[i].Free;
128. end;
129.  
130. end.

[Curt Carpenter]

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]

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.

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