Demo Scene Bitmap Font Scroller

[Gigatron]

Hi L&G,

I will try to share a bitmap font scroller using BGRABitmap, you will learn how to scroll text.
Bitmap font from the champs cracktro Amiga;

https://www.youtube.com/watch?v=05C-iyxoqLs

The Result in LP :
https://www.youtube.com/watch?v=puFsvBfmIoA

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; uplaysound;
10.  
11. const
12.   ascii : Array [0..58] of integer = (26,37,99,99,99,99,99,41,42,43,99,99,44,99,38,99,27,28,29,30,31,32,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
13.   cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
14.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
15.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
16.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
17.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
18.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
19.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
20.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
21.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
22.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
23.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
24.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
25.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
26.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
27.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
28.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
29.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
30.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
31.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
32.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
33.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
34.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
35.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
36.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
37.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
38.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
39.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
40.                                             '#000099','#000088','#000077');
41.  
42. var
43.   CharImage: TBGRABitmap;
44.   ScrollSpeed: integer = 2;
45.   ScrollCounter: integer = 1;
46.   CharWidth : integer = 30;
47.   CharW     : integer = 30;
48.   CharHeight :  integer = 48;
49.   CharsPerLine : integer = 240;
50.   ScrollText : String = '                  ....       GIGATRON THE LEADER PRESENTS BITMAP FONT SCROLLER DEMO CODED WITH LAZARUS PASCAL GREETINGS TO PUMA, JAGUAR, SERVAL, LYNX, CARACAL, PANTHER, OCELOT, CHEETAH, WILD CAT,  ...  FONT FROM THE CHAMPS CRACKTRO AMIGA IN 1988  RELEASE DATE LATE ON (( 22.04.2024 ))     SEE YOU    .....';
51.   hexColor: string;
52.   red, green, blue: Byte;
53.   j,pause,snd_timer  : integer;
54.  
55. type
56.  
57.   { TForm1 }
58.  
59.   TForm1 = class(TForm)
60.     BGRAVirtualScreen1: TBGRAVirtualScreen;
61.     playsound1: Tplaysound;
62.     Timer1: TTimer;
63.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
64.     procedure FormCreate(Sender: TObject);
65.     procedure FormDestroy(Sender: TObject);
66.     procedure Timer1Timer(Sender: TObject);
67.   private
68.  
69.   public
70.  
71.   end;
72.  
73.  
74. var
75.   Form1: TForm1;
76.  
77. implementation
78.  
79. {$R *.lfm}
80.  
81.  
82. procedure TForm1.FormCreate(Sender: TObject);
83. begin
84.  // playsound1.Execute;        // play once when form created !
85.   CharImage := TBGRABitmap.Create('font2x.png');
86.   CharImage.SetSize(30,2226);
87.   j:=0;
88.   pause := 0;
89. end;
90.  
91. procedure HexToRGB(hex: string; var r, g, b: Byte);
92. begin
93.   r := StrToInt('$' + Copy(hex, 2, 2));
94.   g := StrToInt('$' + Copy(hex, 4, 2));
95.   b := StrToInt('$' + Copy(hex, 6, 2));
96. end;
97.  
98. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
99. var
100.    I,   Chr: Integer;
101.    CharX, CharY: Integer;
102.    ScrollOffset: Integer;
103.  
104. begin
105.   Bitmap.Fill(BGRAPixelTransparent);
106.  
107.   // raster bars cycle colors
108.   for i := 0 to 20 do
109.   begin
110.        hexColor := cop_col[i+j];
111.        HexToRGB(hexColor, red, green, blue);
112.        Bitmap.FillRect(0,242+i*2,640,242+i*2-2,RGBToColor(red,green,blue));
113.  
114.   end;
115.  
116.      inc(pause);
117.    if (pause>=1) then
118.    begin
119.        inc(j);
120.        pause := 0;
121.        if(j>=184) then j:=0;
122.  
123.     end;
124.  
125.   // Bitmap Scrolling  copy bitmap char with correct ascii code ,  x,y,x1,y1 like Amiga blitter
126.   ScrollOffset :=  ScrollCounter ;
127.   for I := 0 to 24 do
128.     begin
129.        Chr   := Ord(ScrollText[I]);
130.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
131.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
132.        Bitmap.PutImagePart(CharX , 240+CharY , CharImage, Rect(0, ascii[Chr-32]*CharHeight , CharW, ascii[Chr-32]*CharHeight+CharHeight), dmDrawWithTransparency);
133.  
134.   end;
135.  
136.   ScrollCounter := ScrollCounter + ScrollSpeed;
137.  
138.   if ScrollCounter >= CharWidth then
139.      begin
140.             ScrollCounter := ScrollCounter - CharWidth;
141.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
142.      end;
143.  
144.  // play sound every xxx sec
145.  // inc(snd_timer);
146.  //  if(snd_timer>500) then
147.  // begin
148.  //     snd_timer :=0;
149.  //     playsound1.Execute;
150.  
151.  //  end
152.  
153. end;
154.  
155. procedure TForm1.Timer1Timer(Sender: TObject);
156. begin
157.       BGRAVirtualScreen1.RedrawBitmap;
158.  
159. end;
160.  
161. procedure TForm1.FormDestroy(Sender: TObject);
162. // libere tout !!
163. begin
164.    //playsound1.Free;
165.    CharImage.Free;
166.  
167. end;
168.  
169. end.
170.  

[circular]

That's clever to use the font as mask, so you can do any gradient in it. 

[KodeZwerg]

That's clever to use the font as mask, so you can do any gradient in it. 

I also was looking twice if I misread there something.
Last time I played with BitmapFontScrollers the Bitmap was colored to save some cycles of CPU.
Okay, it was back when I had my first 386 and every little cache and cycle needed to be used clever
So a new way of doing such is pretty welcomed 
(while I become never a fan of pre-initialized values for such, if colored in realtime, color can also be calculated in realtime)
(same with many variable that G uses, it works on his display/setting, but some code snippets are missing the initial values shown, like size for screen/image etc ^_^)

[Gigatron]

That's clever to use the font as mask, so you can do any gradient in it. 

In addition I don't write all the gradient datas
Copper of Amiga make this gradient with skip,move and wait command, i am using Winuae to
make screenshot without antialiasing methode and extract the picture of the raster bar or copper bar.
After that i use this code to extract copper datas.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes ;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
17.     Memo1: TMemo;
18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormShow(Sender: TObject);
21.   private
22.  
23.   public
24.  
25.   end;
26.  
27. var
28.   Form1: TForm1;
29.   image  : TBGRABitmap;
30.  
31. implementation
32.  
33. {$R *.lfm}
34.  
35. { TForm1 }
36.  
37. procedure TForm1.FormCreate(Sender: TObject);
38. begin
39.        image := TBGRABitmap.Create('rasters.png'); // 1 pixel en y ; 640 pixel en x
40. end;
41.  
42. procedure TForm1.FormShow(Sender: TObject);
43. var  x,c : integer;
44.      p : PBGRAPixel;
45.      rez,final  : string;
46. begin
47.     c:= 0;  // data array counter
48.     rez := '';  // store raster color data
49.     final :=''; // final result of color data
50.     memo1.Text :=''; // clear memo1 text
51.  
52.     for x := 0 to image.Width-1 do
53.     begin
54.       p := image.GetScanlineAt(x,0);  // scan just x to 639+1
55.       rez := intToHex(p^.red) + intToHex(p^.green) + intToHex(p^.blue);  // extract r,g,b component ;
56.       final := final + QuotedStr('#'+rez) +',' ;
57.       c:= x;
58.     end;
59.       SetLength(final,length(final)-1); // remove last char :
60.       memo1.Text := 'const ' + #13#10;
61.       memo1.Text := memo1.Text  + 'raster_data :Array[0..'+intToStr(c)+'] of String =('  + final + ');' ;
62.  
63. end;
64.  
65. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
66. begin
67.        Bitmap.Canvas2D.drawImage(image,0,0,640-1,160,rfLinear); // stretch a bit ;
68. end;
69.  
70. end.
71.  

[TRon]

That's clever to use the font as mask, so you can do any gradient in it. 

Cookie cutting  was such a bliss with the blitter. The copper handled the rest

So much grunt required on a 'normal' pc to be able to achieve the same effects...

[circular]

Cookie cutting sounds tasty. 

I presume it was to a particular technology?

[TRon]

Cookie cutting sounds tasty. 

For sure it is but beware of its ability to make you fat(ter) 

I presume it was to a particular technology?

correct. It is a particular usage of the blitter. For an small introduction see "The cookie-cut function" on this page.

For a technical view of the blitter see attachment from the AHRM.

More information about minterm's see this page.

[Gigatron]

Hi,

After raster image ripped from an intro on winuae and extracted the colors, i can now display them and play with it
by cycling it on transparent logo or picture ;
the code is easy to understand.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   BGRAVirtualScreen, BGRABitmap,BGRABitmapTypes;
10.  
11. const
12.  
13. raster_data :Array[0..639] of String =('#110000','#120000','#150000','#1A0000','#200000','#250000','#290000','#2C0000','#300000','#330000','#370000','#3B0000',
14. '#3F0000','#430000','#460000','#4A0000','#4E0000','#520000','#560000','#590000','#5D0000','#610000','#650000','#690000','#6C0000','#700000','#750000','#780000',
15. '#7B0000','#7F0000','#840000','#880000','#8B0000','#8F0000','#930000','#970000','#9B0000','#9E0000','#A20000','#A60000','#AA0000','#AD0000','#B10000','#B50000',
16. '#BA0000','#BD0000','#C00000','#C40000','#C90000','#CD0000','#D00000','#D30000','#D80000','#DC0000','#DF0000','#E20000','#E60000','#EB0000','#EF0000','#F40000',
17. '#F80000','#FD0000','#FF0000','#FE0000','#FA0000','#F50000','#F10000','#EC0000','#E70000','#E30000','#E00000','#DD0000','#D90000','#D40000','#D00000','#CD0000',
18. '#CA0000','#C50000','#C10000','#BE0000','#BB0000','#B60000','#B20000','#AE0000','#AB0000','#A70000','#A30000','#9F0000','#9B0000','#980000','#940000','#900000',
19. '#8C0000','#890000','#850000','#810000','#7C0000','#790000','#760000','#720000','#6D0000','#690000','#660000','#630000','#5E0000','#5A0000','#570000','#530000',
20. '#4F0000','#4B0000','#470000','#440000','#400000','#3C0000','#380000','#340000','#310000','#2D0000','#290000','#250000','#210000','#1E0000','#1A0000','#160000',
21. '#120000','#0E0002','#090005','#050009','#01000E','#000012','#000016','#00001A','#00001E','#000022','#000025','#000029','#00002D','#000031','#000034','#000038',
22. '#00003C','#000040','#000044','#000047','#00004B','#00004F','#000054','#000057','#00005A','#00005E','#000063','#000066','#00006A','#00006D','#000072','#000076',
23. '#000079','#00007D','#000081','#000085','#000089','#00008C','#000090','#000094','#000098','#00009B','#00009F','#0000A3','#0000A8','#0000AB','#0000AE','#0000B2',
24. '#0000B7','#0000BB','#0000BE','#0000C1','#0000C6','#0000CA','#0000CD','#0000D1','#0000D5','#0000D9','#0000DD','#0000E0','#0000E3','#0000E7','#0000EC','#0000F1',
25. '#0000F5','#0000FA','#0000FE','#0000FF','#0000FD','#0000F8','#0000F4','#0000EF','#0000EA','#0000E5','#0000E2','#0000DF','#0000DC','#0000D7','#0000D3','#0000CF',
26. '#0000CC','#0000C9','#0000C4','#0000C0','#0000BD','#0000B9','#0000B5','#0000B1','#0000AD','#0000AA','#0000A6','#0000A2','#00009E','#00009A','#000097','#000093',
27. '#00008E','#00008B','#000088','#000084','#00007F','#00007B','#000078','#000075','#000070','#00006C','#000068','#000065','#000061','#00005D','#000059','#000056',
28. '#000052','#00004E','#00004A','#000046','#000043','#00003F','#00003B','#000037','#000033','#000030','#00002B','#000127','#000024','#000020','#00001D','#000019',
29. '#000015','#000011','#00030C','#000608','#000B04','#000F01','#001300','#001700','#001B00','#001F00','#002300','#002601','#002A00','#002E00','#003200','#003500',
30. '#003900','#003D00','#004200','#004500','#004800','#004C00','#005100','#005500','#005800','#005C00','#006000','#006400','#006700','#006B00','#006F00','#007300',
31. '#007700','#007A00','#007E00','#008200','#008600','#008A00','#008D00','#009100','#009600','#009900','#009C00','#00A000','#00A500','#00A900','#00AC00','#00AF00',
32. '#00B400','#00B800','#00BC00','#00BF00','#00C300','#00C700','#00CB00','#00CE00','#00D200','#00D600','#00DB00','#00DE00','#00E100','#00E400','#00E900','#00EE00',
33. '#00F200','#00F700','#00FB00','#00FF00','#00FF00','#00FB00','#00F700','#00F200','#00EE00','#00E900','#00E400','#00E100','#00DE00','#00DB00','#00D600','#00D200',
34. '#00CE00','#00CB00','#00C700','#00C300','#00BF00','#00BC00','#00B800','#00B400','#00AF00','#00AC00','#00A900','#00A500','#00A000','#009C00','#009900','#009600',
35. '#009100','#008D00','#008A00','#008600','#008200','#007E00','#007A00','#007700','#007300','#006F00','#006B00','#006700','#006400','#006000','#005C00','#005800',
36. '#005500','#005100','#004C00','#004800','#004500','#004200','#003D00','#003900','#003500','#003200','#002F00','#002B00','#012700','#002300','#001F00','#001A00',
37. '#001600','#001300','#011000','#040E00','#080E00','#0C0F00','#111100','#151400','#191700','#1D1B00','#202000','#242400','#272800','#2B2C00','#303000','#333300',
38. '#373700','#3B3B00','#3F3F00','#434300','#464600','#4A4A00','#4E4E00','#525200','#565600','#595900','#5D5D00','#616100','#656500','#686800','#6C6C00','#707000',
39. '#757500','#787800','#7B7B00','#7F7F00','#848400','#888800','#8B8B00','#8E8E00','#939300','#979700','#9A9A00','#9E9E00','#A2A200','#A6A600','#AAAA00','#ADAD00',
40. '#B1B100','#B5B500','#B9B900','#BDBD00','#C0C000','#C4C400','#C9C900','#CCCC00','#CFCF00','#D3D300','#D7D700','#DCDC00','#DFDF00','#E2E200','#E5E500','#EAEA00',
41. '#EFEF00','#F4F400','#F8F800','#FDFD00','#FFFF00','#FEFE00','#FAFA00','#F5F500','#F1F100','#ECEC00','#E7E700','#E3E300','#E0E000','#DDDD00','#D9D900','#D5D500',
42. '#D1D100','#CDCD00','#CACA00','#C6C600','#C1C100','#BEBE00','#BBBB00','#B7B700','#B2B200','#AEAE00','#ABAB00','#A8A800','#A3A300','#9F9F00','#9B9B00','#989800',
43. '#949400','#909000','#8C8C00','#898900','#858500','#818100','#7D7D00','#797900','#767600','#727200','#6D6D00','#6A6A00','#666600','#636300','#5E5E00','#5A5A00',
44. '#575700','#545400','#4F4F00','#4B4B00','#474700','#444400','#404000','#3C3C00','#383800','#343400','#313100','#2D2D00','#292900','#252500','#212100','#1D1D00',
45. '#191900','#151500','#121200','#101001','#0E0E05','#0E0E09','#0F0F0E','#121212','#151516','#18181A','#1D1D1E','#212121','#252525','#292929','#2D2D2D','#313131',
46. '#343434','#383838','#3C3C3C','#404040','#444444','#474747','#4B4B4B','#4F4F4F','#535353','#575757','#5A5A5A','#5E5E5E','#636363','#666666','#696969','#6D6D6D',
47. '#727272','#767676','#797979','#7C7C7C','#818181','#858585','#898989','#8C8C8C','#909090','#949494','#989898','#9B9B9B','#9F9F9F','#A3A3A3','#A7A7A7','#ABABAB',
48. '#AEAEAE','#B2B2B2','#B6B6B6','#BBBBBB','#BEBEBE','#C1C1C1','#C5C5C5','#CACACA','#CDCDCD','#D0D0D0','#D4D4D4','#D9D9D9','#DDDDDD','#E0E0E0','#E3E3E3','#E7E7E7',
49. '#ECECEC','#F1F1F1','#F5F5F5','#FAFAFA','#FEFEFE','#FFFFFF','#FDFDFD','#F8F8F8','#F4F4F4','#EFEFEF','#EBEBEB','#E6E6E6','#E2E2E2','#DFDFDF','#DCDCDC','#D8D8D8',
50. '#D3D3D3','#D0D0D0','#CDCDCD','#C9C9C9','#C4C4C4','#C0C0C0','#BDBDBD','#BABABA','#B5B5B5','#B1B1B1','#ADADAD','#AAAAAA','#A6A6A6','#A2A2A2','#9E9E9E','#9B9B9B',
51. '#979797','#939393','#8F8F8F','#8B8B8B','#888888','#848484','#7F7F7F','#7B7B7B','#787878','#757575','#707070','#6C6C6C','#696969','#656565','#616161','#5D5D5D',
52. '#595959','#565656','#525252','#4E4E4E','#4A4A4A','#464646','#434343','#3F3F3F','#3B3B3B','#373737','#333333','#303030','#2C2C2C','#282828','#242424','#202020',
53. '#1C1C1C','#171717','#141414','#111111');
54.  
55.  
56. var
57.   hexColor: string;
58.   red, green, blue: Byte;
59.   j : integer;
60.   logo : TBGRABitmap;
61.  
62.  
63. type
64.  
65.   { TForm1 }
66.  
67.   TForm1 = class(TForm)
68.     BGRAVirtualScreen1: TBGRAVirtualScreen;
69.     Timer1: TTimer;
70.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
71.     procedure FormCreate(Sender: TObject);
72.     procedure Timer1Timer(Sender: TObject);
73.   private
74.  
75.   public
76.  
77.   end;
78.  
79. var
80.   Form1: TForm1;
81.  
82. implementation
83.  
84. {$R *.lfm}
85.  
86. { TForm1 }
87.  
88. procedure HexToRGB(hex: string; var r, g, b: Byte);   // hexstring color conversion '#ff0000' red 255, green 0 , blue 0
89. begin
90.   r := StrToInt('$' + Copy(hex, 2, 2));
91.   g := StrToInt('$' + Copy(hex, 4, 2));
92.   b := StrToInt('$' + Copy(hex, 6, 2));
93. end;
94.  
95. procedure TForm1.FormCreate(Sender: TObject);
96. begin
97.   j       := 0; // raster color index
98.   logo    := TBGRABitmap.Create('gtr1.png'); // 640 * 100 pixel
99. end;
100.  
101. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
102. var
103.   i  : integer;
104. begin
105.     // raster bars cycle colors slow down with sleep
106.   for i := 0 to 639 do
107.    begin
108.  
109.        hexColor := raster_data[j];
110.        HexToRGB(hexColor, red, green, blue);
111.        Bitmap.FillRect(i*8,0,i*8+8,100,RGBToColor(red,green,blue));
112.        j:=j+3;
113.        if(j>=639) then j:=0;
114.    end;
115.        Bitmap.StretchPutImage(rect(0,0,640,100),logo,dmDrawWithTransparency,255);
116.        sleep(25); // sleep a bit please
117. end;
118.  
119.  
120. procedure TForm1.Timer1Timer(Sender: TObject);
121.  
122. begin
123.      BGRAVirtualScreen1.RedrawBitmap;
124.  
125. end;
126.  
127. end.
128.  

[circular]

Very nice indeed with the text outline.

Regarding the gradient of colors, there is a simpler (and more optimized) way to determine them using a bit of math:

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

1. function GetCopperBarColor(x : integer): TBGRAPixel;
2. const
3.   // list of copper bar colors
4.   Colors: array[0..4] of TColor =
5.     (clRed, clBlue, clLime, clYellow, clWhite);
6.   // bar size computed from expected total size
7.   BarSize = 640 div length(Colors);
8. var
9.   numColor: integer;
10.   lightness: integer;
11. begin
12.   // the copper bar base color changes with each bar
13.   numColor := abs(x) div BarSize mod length(Colors);
14.   // lightness is the opposite of the distance from the center of the bar
15.   lightness := BarSize - abs(PositiveMod(x, BarSize)*2 - BarSize);
16.   // compte color in gradient between copper bar color and black
17.   result := MergeBGRA(Colors[numColor], lightness, BGRABlack, BarSize - lightness);
18. end;

Regards

[Gigatron]

Hi, i would like to share another bitmap font scroller project port from javascript with classic canvas not BGRA.
My goal is to port for maximum perfs to BGRA;

main code ;

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   ClassicScroller;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Timer1: TTimer;
17.     procedure FormCreate(Sender: TObject);
18.     procedure Timer1Timer(Sender: TObject);
19.   private
20.  
21.   public
22.  
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.   Canvas: TCanvas;
28.   Scroller: TClassicScroller;
29.   Scroller1: TClassicScroller;
30.   Scroller2: TClassicScroller;
31.   Scroller3: TClassicScroller;
32.  
33.   s_text : string = ' LAZARUS FPC CRACKED BY GIGATRON ON 30.04.2003 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  TRON  -  KODEZWERG  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          ';
34.  
35. implementation
36.  
37. {$R *.lfm}
38.  
39. { TForm1 }
40.  
41. procedure TForm1.FormCreate(Sender: TObject);
42. begin
43.   Canvas := Form1.Canvas;
44.  
45.     Scroller := TClassicScroller.Create(Canvas,  'tf.png', ' ',          640, 396, 64, 84,0,4, s_text);
46. //  Scroller1 := TClassicScroller.Create(Canvas, 'flt_font.png', ' ',    640, 280, 34, 32,0,3, s_text);
47.  // Scroller2 := TClassicScroller.Create(Canvas, 'oracle_font.png', ' ', 640, 180, 32, 32,0,2, s_text);
48.     Scroller3 := TClassicScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  300, 32, 32,10,3, s_text);
49.   //  TClassicScroller.Create(canvas , font bitmap, first char font bitmap, width,posy, char_w, char_h,sinus_ratio,speed, text to scroll ;
50.  
51. end;
52.  
53. procedure TForm1.Timer1Timer(Sender: TObject);
54. begin
55.   Canvas.Clear;
56.   Scroller.Draw;
57. //  Scroller1.Draw;
58. //  Scroller2.Draw;
59.   Scroller3.Draw;
60. end;
61.  
62. end.
63.  

Classic Scroller function

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

1. unit ClassicScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TClassicScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: String;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     scroll_pause: Boolean;
18.     scroll_pause_time: Integer; // 3000ms = 3s
19.     sx: Integer;
20.     tx: Integer;
21.     fonts: TImage;
22.     fonts_width: Integer;
23.     fonts_height: Integer;
24.     sin_h       : integer;
25.  
26.     font_height_zoom: Integer;
27.     function Asc(s: Char): Integer;
28.     function DrawFontChar(charek: Char; x: Integer): Boolean;
29.   public
30.     constructor Create(canvas: TCanvas; font_name: String; offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed : integer ;sText: String);
31.     procedure Draw;
32.  
33.   end;
34.  
35. implementation
36.  
37. { TClassicScroller }
38.  
39. constructor TClassicScroller.Create(canvas: TCanvas; font_name: String;
40.   offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed: integer ; sText: String);
41. begin
42.   offset_char := offset;
43.   pos_y := posY;
44.   width := w;
45.   scroll_text := sText;
46.   canvas_ctx := canvas;
47.   scroll_speed := speed;
48.   scroll_pause := False;
49.   scroll_pause_time := 3000; // 3000ms = 3s
50.   sx := width;
51.   tx := 0;
52.   fonts := TImage.Create(nil);
53.   fonts.Picture.LoadFromFile(font_name);
54.   fonts_width := fWidth;
55.   fonts_height := fHeight;
56.   sin_h  :=  sHeight;
57.   font_height_zoom := 1;
58. end;
59.  
60. function TClassicScroller.Asc(s: Char): Integer;
61. begin
62.   Result := Ord(s);
63. end;
64.  
65. function TClassicScroller.DrawFontChar(charek: Char; x: Integer): Boolean;
66. var
67.   p, cx, cy: Integer;
68.   destRect, srcRect: TRect;
69.  
70.  
71. begin
72.   Result := True;
73.  
74.   if (x > width) and (x > 0) then
75.   begin
76.     Result := False;
77.     Exit;
78.   end;
79.  
80.   p := Asc(charek);
81.   cx := (p - Ord(offset_char)) * fonts_width;
82.   cy := 0;
83.  
84.   if (cx >= 0) and (x <= width) and (x + fonts_width >= 0) then
85.   begin
86.  
87.     destRect := Rect(x, pos_y, x + fonts_width, pos_y + fonts_height);
88.     srcRect := Rect(cx, cy, cx + fonts_width,cy + fonts_height);
89.     canvas_ctx.CopyRect(destRect, fonts.Picture.Bitmap.Canvas, srcRect);
90.   end
91.   else
92.     Result := False;
93. end;
94.  
95.  
96. procedure TClassicScroller.Draw;
97. var
98.   car : Char;
99.   i, x: Integer;
100.   res: boolean;
101. begin
102.   sx := sx - scroll_speed ;
103.   x := sx;
104.  
105.   for i := 1 to Length(scroll_text) do
106.   begin
107.     car := scroll_text[i];
108.     Inc(x, fonts_width);
109.  
110.     if (x > -fonts_width) and (x < width + fonts_width) then
111.     begin
112.       res := DrawFontChar(car, x);
113.       if not res then Break;
114.     end;
115.  
116.   end;
117.  
118.  
119.   if x < 0 then
120.     sx := width + fonts_width;
121. end;
122.  
123.  
124. end.
125.  
126.  

You need to add to form a timer object;

[Gigatron]

Hi,
This time i will share a bitmap font with sinus fx for each chars, the font is from paradox, usefull if you want make splash or about
screen; Using the best command of BGRA Component: Bitmap.PutImagePart;

I like the result and music
Music from Magical Murphy/ Paradise  Amiga intro

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

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, BGRABitmap,
9.   BGRABitmapTypes,  BGRAVirtualScreen,BGRAGradientScanner;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormDestroy(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.   private
23.     { private declarations }
24.     charWidth: Integer;
25.     charHeight: Integer;
26.     charsPerLine: Integer;
27.     charImage: TBGRABitmap;
28.     scrollText: String;
29.     charSet: String;
30.     scrollSpeed: Integer;
31.     scrollCounter: Integer;
32.     g_val : Double;
33.     cnt: Double;
34.     grad: TBGRAGradientScanner;
35.  
36.   public
37.     { public declarations }
38.   end;
39.  
40. var
41.   Form1: TForm1;
42.  
43. implementation
44.  
45. {$R *.lfm}
46.  
47. procedure TForm1.FormCreate(Sender: TObject);
48. begin
49.   charWidth := 22;
50.   charHeight := 32;
51.   charsPerLine := 255;
52.   charImage := TBGRABitmap.Create('pdxfnt2.png'); // paradox bitmap font
53.   scrollText := '                                       GIGATRON  - FRANCE -  PRESENTS AMIGA FONT TOOLS FROM TRONIC SYSTEM SOFTWARE INTRO CODED WITH LAZARUS FPC ON 02.05.2024  CONTACT GIGATRON AT BP: 3300 68000 COLMAR FRANCE      '  ;
54.   charSet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ:.-+#,0123456789''!/ ';  // charset must contains the same (chars) at charimage bitmap;
55.   scrollSpeed := 4;
56.   scrollCounter := 0;
57.   cnt := 0;
58.   g_val := 0;
59.  
60.   grad := TBGRAGradientScanner.Create(BGRA(255,255,250),BGRA(0,0,255),gtLinear,PointF(0,0),PointF(0,65),True,True);
61. end;
62.  
63. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
64. var
65.   i, chr, charX : Integer;
66.   sinVal: Double;
67.   ScrollOffset: Integer;
68.  
69. begin
70.  
71.   // le gradient
72.   bitmap.GradientFill(0,0,640,140,BGRA(0,160,255),BGRA(0,0,255),gtLinear,PointF(0,0),PointF(0,140),  dmSet);
73.  
74.    ScrollOffset :=  ScrollCounter ;
75.   for i := 1 to 32 do
76.   begin
77.        chr := Pos(scrollText[i], charSet)-1;
78.        charX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset;
79.        //CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
80.        sinVal := sin((cnt + (i - 1) * 0.25) * 0.2) * 120.0;
81.        Bitmap.PutImagePart(CharX , 260+round(sinVal) , CharImage, Rect(chr*charWidth, CharHeight , chr*charWidth+22 ,  CharHeight+32),  dmFastBlend);
82.  
83.   end;
84.  
85.   Inc(ScrollCounter,ScrollSpeed);
86.  
87.   if ScrollCounter >= CharWidth then
88.      begin
89.             ScrollCounter := ScrollCounter - CharWidth;
90.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
91.      end;
92.  
93.   // les 2 lignes
94.   bitmap.DrawLine(0,410,640,410,BGRA(round(sinVal),255,255),true);
95.   bitmap.DrawLine(0,140,640,140,BGRA(255,255,round(sinVal)),true);
96.   // les textes
97.   bitmap.FontHeight := 100;
98.   bitmap.FontAntialias := false;
99.   bitmap.FontStyle := [fsBold];
100.   bitmap.TextOut(64,0,'GIGATRON',grad);       // draw gradient text
101.   bitmap.FontHeight := 18;
102.   bitmap.TextOut(510,100,'FRANCE',BGRA(round(-sinVal),round(sinVal)*2,round(sinVal)));
103.  
104. end;
105.  
106. procedure TForm1.FormDestroy(Sender: TObject);
107. begin
108.   CharImage.Free;
109. end;
110.  
111. procedure TForm1.Timer1Timer(Sender: TObject);
112. begin
113.        cnt := cnt + 0.2;
114.        BGRAVirtualScreen1.RedrawBitmap;
115. end;
116.  
117.  
118. end.
119.  

[Gigatron]

Hi,
Sorry I'm busy with my professional work, but coding with pascal at my spare time;

Amiga demo without Sinus Scroll is unimaginable

Today it's time to share something new with you: Bitmap sinus scroll using no component ; @Tron  the speed result is really
bad on my 8 core and 64GB,  GPU with gtx 1080.

*** I feel like I'm in basic Cpc464 )))

What you need is default project with form and Timer... with 2 units included Sinscroller;

The base source is from a javascript amiga intro ; font from zenith included ; My goal is to improve it to gain maximum speed !!

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,SinScroller;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.  
16.     Timer1: TTimer;
17.     procedure FormCreate(Sender: TObject);
18.     procedure Timer1Timer(Sender: TObject);
19.   private
20.  
21.   public
22.  
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.  
28.   Canvas: TCanvas;
29.   Scroller: TSineScroller;
30.  
31.   s_text : string = 'LAZARUS_ FPC CRACKED BY GIGATRON ON 14.05.2024 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          ';
32.  
33. implementation
34.  
35. {$R *.lfm}
36.  
37. { TForm1 }
38.  
39. procedure TForm1.FormCreate(Sender: TObject);
40. begin
41.  
42.   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  210, 32, 32,100, 8,  s_text);
43.  
44. end;
45.  
46. procedure TForm1.Timer1Timer(Sender: TObject);
47. begin
48.   Canvas.Clear;
49.   Scroller.Draw;
50. end;
51.  
52. end.
53.  

And SinScroller unit

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

1. unit SinScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TSineScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: string;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     scroll_pause: Boolean;
18.     scroll_pause_time: Integer; // 3000ms = 3s
19.     sx, tx: Integer;
20.     fonts: TImage;
21.     fonts_width, fonts_height: Integer;
22.     sine_height: Integer;
23.     radians: Double;
24.     font_height_zoom: Double;
25.     function Asc(s : Char): Integer;
26.     function drawFontChar(charek: Char; x: Integer): Integer;
27.     procedure unpause;
28.   public
29.     constructor Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
30.     procedure draw;
31.   end;
32.  
33.   implementation
34.  
35. constructor TSineScroller.Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
36. begin
37.   offset_char := offset;
38.   pos_y := py;
39.   width := w;
40.   scroll_text := text;
41.   canvas_ctx := canvas;
42.   scroll_speed := s_speed;
43.   scroll_pause := False;
44.   scroll_pause_time := 500; // 3000ms = 3s
45.   sx := width;
46.   tx := 0;
47.   fonts := TImage.Create(nil);
48.   fonts.Picture.LoadFromFile(font_name);
49.  
50.   fonts_width := fw;
51.   fonts_height := fh;
52.   sine_height := sh;
53.   radians := PI / 180;
54.   font_height_zoom := 2;
55. end;
56.  
57. function TSineScroller.Asc(s: Char): Integer;
58. begin
59.   Result := Ord(s);
60. end;
61.  
62. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
63. var
64.   p, cx, cy, l, m: Integer;
65.   src_Rect,dst_Rect : TRect;
66. begin
67.      Result := 1;
68.   if (x > width) and (x > 0) then
69.   begin
70.     Result := 0;
71.     Exit;
72.   end;
73.  
74.   p := Asc(charek);
75.   cx := (p - Ord(offset_char)) * fonts_width;
76.   cy := 0;
77.  
78.   for l := 0 to fonts_width - 1 do
79.   begin
80.     if (cx >= 0) and (x <= width) and (x + l >= 0) then
81.     begin
82.       m := pos_y + Round((sine_height) * Sin(-1 * (x + tx + l) / 1.4 * radians));
83.  
84.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
85.       src_Rect := Rect(cx + l, cy, cx + l + 2, cy + fonts_height);
86.       canvas_ctx.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);
87.  
88.     end;
89.   end;
90.   Result := 1;
91. end;
92.  
93. procedure TSineScroller.draw;
94. var
95.   last_char: Char;
96.   x, i: Integer;
97.   koda: Char;
98. begin
99.   if not scroll_pause then
100.     sx -= scroll_speed
101.   else
102.     tx -= scroll_speed;
103.  
104.   x := sx;
105.   for i := 1 to Length(scroll_text) do
106.   begin
107.     koda := scroll_text[i];
108.     x += fonts_width;
109.     if (x > -fonts_width) and (x < width + fonts_width) then
110.     begin
111.       if drawFontChar(koda, x) = -1 then
112.         Break;
113.       last_char := koda;
114.     end;
115.   end;
116.  
117.   if last_char = '_' then
118.   begin
119.     scroll_pause := True;
120.     Sleep(scroll_pause_time);
121.     scroll_pause := False;
122.  
123.   end;
124.  
125.   if x < 0 then
126.     sx := width + fonts_width;
127. end;
128.  
129. procedure TSineScroller.unpause;
130. begin
131.   scroll_pause := False;
132. end;
133.  
134. end.

[KodeZwerg]

If needed, I can convert one of my classics to FreePascal.
It ain't crosscompile, it used pure Windows API.
It runs smooth and fast (compiled with Delphi) and is pretty resource friendly.
It does not use bitmap font, it use actual screen font to do its job.

[Gigatron]

Thanks KodeZwerg

I'm shocked to see that's sinescroller super slow?
My question on the fpc compiler side, is there a specific setting to gain speed?

Regards

[TRon]

Amiga demo without Sinus Scroll is unimaginable

Indeed. It was one of the first things I did (besides copper bars) in order to get a better understanding of the copper (and the first gentle experience with the blitter).

Today it's time to share something new with you: Bitmap sinus scroll using no component ; @Tron  the speed result is really
bad on my 8 core and 64GB,  GPU with gtx 1080.

You might want to change:

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

1. for i := 1 to Length(scroll_text) do
2.  

into

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

1. for i := 1 to HowManyCharactersAreVisibleAtOnceAtGivenScreenWidth do
2.  

And ofc adjust for that to 'scroll' through the letters as well.

*** I feel like I'm in basic Cpc464 )))

But isn't that the challenge ? Work it up till it breaks and then come up with a better solution ?

The Amiga had it easy with its custom hardware. You simply blitted the characters in sight, changed the horizontal start and stop of the plane to match the scrolling of a single char and let the sine get through the made the sinus 'walk through' the vertical start and stop. And ofc it was just a single bitplane. In modern days you need to push around a few more bytes.

If push comes to shove then scroll the characters in a off-screen bitmap (even/odd) and copy the rectangles (opposite even odd) to their respective destination rectangle. If you have the sinus pre-calculated or keep their (verical) positions then you can update the coordinates with a simple move, calculate the newest coordinate (in case not entirely precalculated) to fill in the empty gap.

I still haven't seen you use any double, tripple or quad buffering