Demo Scene Bitmap Font Scroller lazarus / 39-Graphics ---------------------------------------------------------------------- Gigatron · 2024-04-23 15:56 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][+][-]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,  BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; uplaysound; const  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,3 3,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);  cop_col:Array[0..245] of String =('#0 00066','#000055','#000044','#000033','#000022','#000011','#000011','#0 00022','#000033',                                            '#000044' ,'#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb' ,'#0000cc',                                            '#0000dd','#000 0ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#666 6ff',                                            '#7777ff','#8888ff',' #9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',                                            '#ffffff','#ffffff','#eeffff ','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',                                          '#8888ff','#7777ff','#6666ff','#555 5ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',                                          '#0000ee','#0000dd','#0000cc','#0000bb','# 0000aa','#000099','#000088','#000077','#000066',                                          '#000055','#000044','#000033','#000022','#000011' ,'#000022','#000033','#000044','#000055',                                          '#000066','#000077','#000088','#000099','#0000aa','#0000 bb','#0000cc','#0000dd','#0000ee',                                          '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6 666ff','#7777ff','#8888ff',                                          '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff', '#ffffff','#ffffff',                                            '#eeff ff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888 ff','#7777ff',                                            '#6666ff','# 5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','# 0000dd',                                            '#0000cc','#0000bb ','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044 ',                                            '#000033','#000022','#00 0011','#000011','#000022','#000033','#000044','#000055','#000066',                                          '#000077','#000088','#000099',' #0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',                                          '#1111ff','#2222ff','#3333ff','#4444ff ','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',                                          '#aaaaff','#bbbbff','#ccccff','#ddddff','#eee eff','#eeffff','#ffffff','#ffffff','#eeffff',                                          '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','# 9999ff','#8888ff','#7777ff','#6666ff',                                          '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff' ,'#0000ee','#0000dd','#0000cc',                                          '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#0000 55','#000044','#000033',                                            '# 000022','#000011','#000022','#000033','#000044','#000055','#000066','# 000077','#000088',                                            '#000099 ','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff ','#2222ff',                                            '#3333ff','#44 44ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bb bbff',                                            '#ccccff','#ddddff', '#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',                                           '#ccccff','#bbbbff','#aaaaf f','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',                                          '#3333ff','#2222ff','#1111ff','#00 00ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',                                          '#000099','#000088','#000077'); var  CharImage: TBGRABitmap;  ScrollSpeed: integer = 2;  ScrollCounter: integer = 1;  CharWidth : integer = 30;  CharW     : integer = 30;  CharHeight :  integer = 48;  CharsPerLine : integer = 240;  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    .....';  hexColor: string;  red, green, blue: Byte;  j,pause,snd_timer  : integer; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    playsound1: Tplaysound;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   end;  var  Form1: TForm1; implementation {$R *.lfm}  procedure TForm1.FormCreate(Sender: TObject);begin // playsound1.Execute;        // play once when form created !  CharImage := TBGRABitmap.Create('font2x.png');  CharImage.SetSize(30,2226);  j:=0;  pause := 0;end; procedure HexToRGB(hex: string; var r, g, b: Byte);begin  r := StrToInt('$' + Copy(hex, 2, 2));  g := StrToInt('$' + Copy(hex, 4, 2));  b := StrToInt('$' + Copy(hex, 6, 2));end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var   I,   Chr: Integer;   CharX, CharY: Integer;   ScrollOffset: Integer; begin  Bitmap.Fill(BGRAPixelTransparent);   // raster bars cycle colors  for i := 0 to 20 do  begin       hexColor := cop_col[i+j];       HexToRGB(hexColor, red, green, blue);       Bitmap .FillRect(0,242+i*2,640,242+i*2-2,RGBToColor(red,green,blue));   end;      inc(pause);   if (pause>=1) then   begin       inc(j);       pause := 0;       if(j>=184) then j:=0;     end;   // Bitmap Scrolling  copy bitmap char with correct ascii code ,  x,y,x1,y1 like Amiga blitter  ScrollOffset :=  ScrollCounter ;  for I := 0 to 24 do  begin       Chr   := Ord(ScrollText[I]);       CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;       CharY := ((I - 1) div CharsPerLine) * CharHeight  ;       Bitmap.PutImagePart(CharX , 240+CharY , CharImage, Rect(0, ascii[Chr-32]*CharHeight , CharW, ascii[Chr-32]*CharHeight+CharHeight), dmDrawWithTransparency);   end;   ScrollCounter := ScrollCounter + ScrollSpeed;   if ScrollCounter >= CharWidth then     begin            ScrollCounter := ScrollCounter - CharWidth;            ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];     end;  // play sound every xxx sec // inc(snd_timer); //  if(snd_timer>500) then // begin //     snd_timer :=0; //     playsound1.Execute;  //  end end; procedure TForm1.Timer1Timer(Sender: TObject);begin      BGRAVirtualScreen1.RedrawBitmap; end; procedure TForm1.FormDestroy(Sender: TObject);// libere tout !!begin   //playsound1.Free;   CharImage.Free; end; end. ---------------------------------------------------------------------- circular · 2024-04-24 16:53 That's clever to use the font as mask, so you can do any gradient in it. ---------------------------------------------------------------------- KodeZwerg · 2024-04-24 17:21 Quote from: circular on April 24, 2024, 06:53:32 pmThat'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 · 2024-04-25 01:14 Quote from: circular on April 24, 2024, 06:53:32 pmThat'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][+][-]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, StdCtrls,  BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes ; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Memo1: TMemo;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormShow(Sender: TObject);  private   public   end; var  Form1: TForm1;  image  : TBGRABitmap; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin       image := TBGRABitmap.Create('rasters.png'); // 1 pixel en y ; 640 pixel en xend; procedure TForm1.FormShow(Sender: TObject);var  x,c : integer;   p : PBGRAPixel;     rez,final  : string;begin    c:= 0;  // data array counter    rez := '';  // store raster color data    final :=''; // final result of color data    memo1.Text :=''; // clear memo1 text     for x := 0 to image.Width-1 do    begin      p := image.GetScanlineAt(x,0);  // scan just x to 639+1      rez := intToHex(p^.red) + intToHex(p^.green) + intToHex(p^.blue);  // extract r,g,b component ;      final := final + QuotedStr('#'+rez) +',' ;    c:= x;    end;      SetLength(final,length(final)-1); // remove last char :      memo1.Text := 'const ' + #13#10;      memo1.Text := memo1.Text  + 'raster_data :Array[0..'+intToStr(c)+'] of String =('  + final + ');' ; end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);begin       Bitmap.Canvas2D.drawImage(image,0,0,640-1,160,rfLinear); // stretch a bit ;end; end. ---------------------------------------------------------------------- TRon · 2024-04-26 00:26 Quote from: circular on April 24, 2024, 06:53:32 pmThat'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 · 2024-04-26 06:34 Cookie cutting sounds tasty.  I presume it was to a particular technology? ---------------------------------------------------------------------- TRon · 2024-04-26 06:52 Quote from: circular on April 26, 2024, 08:34:55 amCookie cutting sounds tasty.  For sure it is but beware of its ability to make you fat(ter)  QuoteI 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 · 2024-04-26 22:35 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][+][-]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; const raster_data :Array[0..639] of String =('#110000','#120000','#150000','#1A0000','#200000','#250000','#290000 ','#2C0000','#300000','#330000','#370000','#3B0000','#3F0000','#430000 ','#460000','#4A0000','#4E0000','#520000','#560000','#590000','#5D0000 ','#610000','#650000','#690000','#6C0000','#700000','#750000','#780000 ','#7B0000','#7F0000','#840000','#880000','#8B0000','#8F0000','#930000 ','#970000','#9B0000','#9E0000','#A20000','#A60000','#AA0000','#AD0000 ','#B10000','#B50000','#BA0000','#BD0000','#C00000','#C40000','#C90000 ','#CD0000','#D00000','#D30000','#D80000','#DC0000','#DF0000','#E20000 ','#E60000','#EB0000','#EF0000','#F40000','#F80000','#FD0000','#FF0000 ','#FE0000','#FA0000','#F50000','#F10000','#EC0000','#E70000','#E30000 ','#E00000','#DD0000','#D90000','#D40000','#D00000','#CD0000','#CA0000 ','#C50000','#C10000','#BE0000','#BB0000','#B60000','#B20000','#AE0000 ','#AB0000','#A70000','#A30000','#9F0000','#9B0000','#980000','#940000 ','#900000','#8C0000','#890000','#850000','#810000','#7C0000','#790000 ','#760000','#720000','#6D0000','#690000','#660000','#630000','#5E0000 ','#5A0000','#570000','#530000','#4F0000','#4B0000','#470000','#440000 ','#400000','#3C0000','#380000','#340000','#310000','#2D0000','#290000 ','#250000','#210000','#1E0000','#1A0000','#160000','#120000','#0E0002 ','#090005','#050009','#01000E','#000012','#000016','#00001A','#00001E ','#000022','#000025','#000029','#00002D','#000031','#000034','#000038 ','#00003C','#000040','#000044','#000047','#00004B','#00004F','#000054 ','#000057','#00005A','#00005E','#000063','#000066','#00006A','#00006D ','#000072','#000076','#000079','#00007D','#000081','#000085','#000089 ','#00008C','#000090','#000094','#000098','#00009B','#00009F','#0000A3 ','#0000A8','#0000AB','#0000AE','#0000B2','#0000B7','#0000BB','#0000BE ','#0000C1','#0000C6','#0000CA','#0000CD','#0000D1','#0000D5','#0000D9 ','#0000DD','#0000E0','#0000E3','#0000E7','#0000EC','#0000F1','#0000F5 ','#0000FA','#0000FE','#0000FF','#0000FD','#0000F8','#0000F4','#0000EF ','#0000EA','#0000E5','#0000E2','#0000DF','#0000DC','#0000D7','#0000D3 ','#0000CF','#0000CC','#0000C9','#0000C4','#0000C0','#0000BD','#0000B9 ','#0000B5','#0000B1','#0000AD','#0000AA','#0000A6','#0000A2','#00009E ','#00009A','#000097','#000093','#00008E','#00008B','#000088','#000084 ','#00007F','#00007B','#000078','#000075','#000070','#00006C','#000068 ','#000065','#000061','#00005D','#000059','#000056','#000052','#00004E ','#00004A','#000046','#000043','#00003F','#00003B','#000037','#000033 ','#000030','#00002B','#000127','#000024','#000020','#00001D','#000019 ','#000015','#000011','#00030C','#000608','#000B04','#000F01','#001300 ','#001700','#001B00','#001F00','#002300','#002601','#002A00','#002E00 ','#003200','#003500','#003900','#003D00','#004200','#004500','#004800 ','#004C00','#005100','#005500','#005800','#005C00','#006000','#006400 ','#006700','#006B00','#006F00','#007300','#007700','#007A00','#007E00 ','#008200','#008600','#008A00','#008D00','#009100','#009600','#009900 ','#009C00','#00A000','#00A500','#00A900','#00AC00','#00AF00','#00B400 ','#00B800','#00BC00','#00BF00','#00C300','#00C700','#00CB00','#00CE00 ','#00D200','#00D600','#00DB00','#00DE00','#00E100','#00E400','#00E900 ','#00EE00','#00F200','#00F700','#00FB00','#00FF00','#00FF00','#00FB00 ','#00F700','#00F200','#00EE00','#00E900','#00E400','#00E100','#00DE00 ','#00DB00','#00D600','#00D200','#00CE00','#00CB00','#00C700','#00C300 ','#00BF00','#00BC00','#00B800','#00B400','#00AF00','#00AC00','#00A900 ','#00A500','#00A000','#009C00','#009900','#009600','#009100','#008D00 ','#008A00','#008600','#008200','#007E00','#007A00','#007700','#007300 ','#006F00','#006B00','#006700','#006400','#006000','#005C00','#005800 ','#005500','#005100','#004C00','#004800','#004500','#004200','#003D00 ','#003900','#003500','#003200','#002F00','#002B00','#012700','#002300 ','#001F00','#001A00','#001600','#001300','#011000','#040E00','#080E00 ','#0C0F00','#111100','#151400','#191700','#1D1B00','#202000','#242400 ','#272800','#2B2C00','#303000','#333300','#373700','#3B3B00','#3F3F00 ','#434300','#464600','#4A4A00','#4E4E00','#525200','#565600','#595900 ','#5D5D00','#616100','#656500','#686800','#6C6C00','#707000','#757500 ','#787800','#7B7B00','#7F7F00','#848400','#888800','#8B8B00','#8E8E00 ','#939300','#979700','#9A9A00','#9E9E00','#A2A200','#A6A600','#AAAA00 ','#ADAD00','#B1B100','#B5B500','#B9B900','#BDBD00','#C0C000','#C4C400 ','#C9C900','#CCCC00','#CFCF00','#D3D300','#D7D700','#DCDC00','#DFDF00 ','#E2E200','#E5E500','#EAEA00','#EFEF00','#F4F400','#F8F800','#FDFD00 ','#FFFF00','#FEFE00','#FAFA00','#F5F500','#F1F100','#ECEC00','#E7E700 ','#E3E300','#E0E000','#DDDD00','#D9D900','#D5D500','#D1D100','#CDCD00 ','#CACA00','#C6C600','#C1C100','#BEBE00','#BBBB00','#B7B700','#B2B200 ','#AEAE00','#ABAB00','#A8A800','#A3A300','#9F9F00','#9B9B00','#989800 ','#949400','#909000','#8C8C00','#898900','#858500','#818100','#7D7D00 ','#797900','#767600','#727200','#6D6D00','#6A6A00','#666600','#636300 ','#5E5E00','#5A5A00','#575700','#545400','#4F4F00','#4B4B00','#474700 ','#444400','#404000','#3C3C00','#383800','#343400','#313100','#2D2D00 ','#292900','#252500','#212100','#1D1D00','#191900','#151500','#121200 ','#101001','#0E0E05','#0E0E09','#0F0F0E','#121212','#151516','#18181A ','#1D1D1E','#212121','#252525','#292929','#2D2D2D','#313131','#343434 ','#383838','#3C3C3C','#404040','#444444','#474747','#4B4B4B','#4F4F4F ','#535353','#575757','#5A5A5A','#5E5E5E','#636363','#666666','#696969 ','#6D6D6D','#727272','#767676','#797979','#7C7C7C','#818181','#858585 ','#898989','#8C8C8C','#909090','#949494','#989898','#9B9B9B','#9F9F9F ','#A3A3A3','#A7A7A7','#ABABAB','#AEAEAE','#B2B2B2','#B6B6B6','#BBBBBB ','#BEBEBE','#C1C1C1','#C5C5C5','#CACACA','#CDCDCD','#D0D0D0','#D4D4D4 ','#D9D9D9','#DDDDDD','#E0E0E0','#E3E3E3','#E7E7E7','#ECECEC','#F1F1F1 ','#F5F5F5','#FAFAFA','#FEFEFE','#FFFFFF','#FDFDFD','#F8F8F8','#F4F4F4 ','#EFEFEF','#EBEBEB','#E6E6E6','#E2E2E2','#DFDFDF','#DCDCDC','#D8D8D8 ','#D3D3D3','#D0D0D0','#CDCDCD','#C9C9C9','#C4C4C4','#C0C0C0','#BDBDBD ','#BABABA','#B5B5B5','#B1B1B1','#ADADAD','#AAAAAA','#A6A6A6','#A2A2A2 ','#9E9E9E','#9B9B9B','#979797','#939393','#8F8F8F','#8B8B8B','#888888 ','#848484','#7F7F7F','#7B7B7B','#787878','#757575','#707070','#6C6C6C ','#696969','#656565','#616161','#5D5D5D','#595959','#565656','#525252 ','#4E4E4E','#4A4A4A','#464646','#434343','#3F3F3F','#3B3B3B','#373737 ','#333333','#303030','#2C2C2C','#282828','#242424','#202020','#1C1C1C ','#171717','#141414','#111111');  var  hexColor: string;  red, green, blue: Byte;  j : integer;  logo : TBGRABitmap;  type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure HexToRGB(hex: string; var r, g, b: Byte);   // hexstring color conversion '#ff0000' red 255, green 0 , blue 0begin  r := StrToInt('$' + Copy(hex, 2, 2));  g := StrToInt('$' + Copy(hex, 4, 2));  b := StrToInt('$' + Copy(hex, 6, 2));end; procedure TForm1.FormCreate(Sender: TObject);begin  j       := 0; // raster color index  logo    := TBGRABitmap.Create('gtr1.png'); // 640 * 100 pixelend; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  i  : integer;begin    // raster bars cycle colors slow down with sleep  for i := 0 to 639 do   begin        hexColor := raster_data[j];       HexToRGB(hexColor, red, green, blue);       Bitmap.FillRect(i*8,0,i*8+8,100,RGBToColor(red,green,blue));       j:=j+3;       if(j>=639) then j:=0;   end;       Bitmap.StretchPutIma ge(rect(0,0,640,100),logo,dmDrawWithTransparency,255);       sleep(25); // sleep a bit pleaseend;  procedure TForm1.Timer1Timer(Sender: TObject); begin     BGRAVirtualScreen1.RedrawBitmap; end; end. ---------------------------------------------------------------------- circular · 2024-04-27 05:59 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i function GetCopperBarColor(x : integer): TBGRAPixel;const  // list of copper bar colors  Colors: array[0..4] of TColor =    (clRed, clBlue, clLime, clYellow, clWhite);  // bar size computed from expected total size  BarSize = 640 div length(Colors);var  numColor: integer;  lightness: integer;begin  // the copper bar base color changes with each bar  numColor := abs(x) div BarSize mod length(Colors);  // lightness is the opposite of the distance from the center of the bar  lightness := BarSize - abs(PositiveMod(x, BarSize)*2 - BarSize);  // compte color in gradient between copper bar color and black  result := MergeBGRA(Colors[numColor], lightness, BGRABlack, BarSize - lightness);end; Regards ---------------------------------------------------------------------- Gigatron · 2024-04-30 19:50 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][+][-]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,  ClassicScroller; type   { TForm1 }   TForm1 = class(TForm)    Timer1: TTimer;    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   end; var  Form1: TForm1;  Canvas: TCanvas;  Scroller: TClassicScroller;  Scroller1: TClassicScroller;  Scroller2: TClassicScroller;  Scroller3: TClassicScroller;   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 ........          '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Canvas := Form1.Canvas;     Scroller := TClassicScroller.Create(Canvas,  'tf.png', ' ',          640, 396, 64, 84,0,4, s_text);//  Scroller1 := TClassicScroller.Create(Canvas, 'flt_font.png', ' ',    640, 280, 34, 32,0,3, s_text); // Scroller2 := TClassicScroller.Create(Canvas, 'oracle_font.png', ' ', 640, 180, 32, 32,0,2, s_text);    Scroller3 := TClassicScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  300, 32, 32,10,3, s_text);  //  TClassicScroller.Create(canvas , font bitmap, first char font bitmap, width,posy, char_w, char_h,sinus_ratio,speed, text to scroll ; end; procedure TForm1.Timer1Timer(Sender: TObject);begin  Canvas.Clear;  Scroller.Draw;//  Scroller1.Draw;//  Scroller2.Draw;  Scroller3.Draw;end; end.  Classic Scroller function 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 ClassicScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TClassicScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: String;    canvas_ctx: TCanvas;    scroll_speed: Integer;    scroll_pause: Boolean;    scroll_pause_time: Integer; // 3000ms = 3s    sx: Integer;    tx: Integer;    fonts: TImage;    fonts_width: Integer;    fonts_height: Integer;    sin_h     : integer;     font_height_zoom: Integer;    function Asc(s: Char): Integer;    function DrawFontChar(charek: Char; x: Integer): Boolean;  public    constructor Create(canvas: TCanvas; font_name: String; offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed : integer ;sText: String);    procedure Draw;   end; implementation { TClassicScroller } constructor TClassicScroller.Create(canvas: TCanvas; font_name: String;  offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed: integer ; sText: String);begin  offset_char := offset;  pos_y := posY;  width := w;  scroll_text := sText;  canvas_ctx := canvas;  scroll_speed := speed;  scroll_pause := False;  scroll_pause_time := 3000; // 3000ms = 3s  sx := width;  tx := 0;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(font_name);  fonts_width := fWidth;  fonts_height := fHeight;  sin_h  :=  sHeight;  font_height_zoom := 1;end; function TClassicScroller.Asc(s: Char): Integer;begin  Result := Ord(s);end; function TClassicScroller.DrawFontChar(charek: Char; x: Integer): Boolean;var  p, cx, cy: Integer;  destRect, srcRect: TRect;  begin  Result := True;   if (x > width) and (x > 0) then  begin    Result := False;    Exit;  end;   p := Asc(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;   if (cx >= 0) and (x <= width) and (x + fonts_width >= 0) then  begin     destRect := Rect(x, pos_y, x + fonts_width, pos_y + fonts_height);    srcRect := Rect(cx, cy, cx + fonts_width,cy + fonts_height);    canvas_ctx.CopyRect(destRect, fonts.Picture.Bitmap.Canvas, srcRect);  end  else    Result := False;end;  procedure TClassicScroller.Draw;var  car : Char;  i, x: Integer;  res: boolean;begin  sx := sx - scroll_speed ;  x := sx;   for i := 1 to Length(scroll_text) do  begin    car := scroll_text[i];    Inc(x, fonts_width);     if (x > -fonts_width) and (x < width + fonts_width) then    begin      res := DrawFontChar(car, x);      if not res then Break;    end;   end;    if x < 0 then    sx := width + fonts_width;end;  end.   You need to add to form a timer object; ---------------------------------------------------------------------- Gigatron · 2024-05-03 16:46 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][+][-]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, BGRABitmap,  BGRABitmapTypes,  BGRAVirtualScreen,BGRAGradientScanner; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    { private declarations }    charWidth: Integer;    charHeight: Integer;    charsPerLine: Integer;    charImage: TBGRABitmap;    scrollText: String;    charSet: String;    scrollSpeed: Integer;    scrollCounter: Integer;    g_val : Double;  cnt: Double;    grad: TBGRAGradientScanner;   public    { public declarations }  end; var  Form1: TForm1; implementation {$R *.lfm} procedure TForm1.FormCreate(Sender: TObject);begin  charWidth := 22;  charHeight := 32;  charsPerLine := 255;  charImage := TBGRABitmap.Create('pdxfnt2.png'); // paradox bitmap font  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      '  ;  charSet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ:.-+#,0123456789''!/ ';  // charset must contains the same (chars) at charimage bitmap;  scrollSpeed := 4;  scrollCounter := 0;  cnt := 0;  g_val := 0;   grad := TBGRAGradientSca nner.Create(BGRA(255,255,250),BGRA(0,0,255),gtLinear,PointF(0,0),Point F(0,65),True,True);end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  i, chr, charX : Integer;  sinVal: Double;  ScrollOffset: Integer; begin   // le gradient  bitmap.GradientFill(0,0 ,640,140,BGRA(0,160,255),BGRA(0,0,255),gtLinear,PointF(0,0),PointF(0,1 40),  dmSet);    ScrollOffset :=  ScrollCounter ;  for i := 1 to 32 do  begin       chr := Pos(scrollText[i], charSet)-1;       charX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset;       //CharY := ((I - 1) div CharsPerLine) * CharHeight  ;       sinVal := sin((cnt + (i - 1) * 0.25) * 0.2) * 120.0;       Bitmap.PutImagePart(CharX , 260+round(sinVal) , CharImage, Rect(chr*charWidth, CharHeight , chr*charWidth+22 ,  CharHeight+32),  dmFastBlend);   end;   Inc(ScrollCounter,ScrollSpeed);   if ScrollCounter >= CharWidth then   begin            ScrollCounter := ScrollCounter - CharWidth;          ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];     end;   // les 2 lignes  bitmap.DrawLine(0,410,640,410,BGRA(round(sinVal),255,255),true);  bitmap.DrawLine(0,140,640,140,BGRA(255,255,round(sinVal)),true);  // les textes  bitmap.FontHeight := 100;  bitmap.FontAntialias := false;  bitmap.FontStyle := [fsBold];  bitmap.TextOut(64,0,'GIGATRON',grad);     // draw gradient text  bitmap.FontHeight := 18;  bitmap.TextOut(51 0,100,'FRANCE',BGRA(round(- sinVal),round(sinVal)*2,round(sinVal))); end; procedure TForm1.FormDestroy(Sender: TObject);begin  CharImage.Free;end; procedure TForm1.Timer1Timer(Sender: TObject);begin       cnt := cnt + 0.2;       BGRAVirtualScreen1.RedrawBitmap;end;  end. ---------------------------------------------------------------------- Gigatron · 2024-05-14 17:27 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][+][-]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,SinScroller; type   { TForm1 }   TForm1 = class(TForm)     Timer1: TTimer;    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   end; var  Form1: TForm1;   Canvas: TCanvas;  Scroller: TSineScroller;   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 ........          '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  210, 32, 32,100, 8,  s_text); end; procedure TForm1.Timer1Timer(Sender: TObject);begin  Canvas.Clear;  Scroller.Draw;end; end.  And SinScroller unit 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 SinScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TSineScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: string;    canvas_ctx: TCanvas;    scroll_speed: Integer;    scroll_pause: Boolean;    scroll_pause_time: Integer; // 3000ms = 3s    sx, tx: Integer;    fonts: TImage;    fonts_width, fonts_height: Integer;    sine_height: Integer;    radians: Double;    font_height_zoom: Double;    function Asc(s : Char): Integer;    function drawFontChar(charek: Char; x: Integer): Integer;    procedure unpause;  public    constructor Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);    procedure draw;  end;   implementation constructor TSineScroller.Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);begin  offset_char := offset;  pos_y := py;  width := w;  scroll_text := text;  canvas_ctx := canvas;  scroll_speed := s_speed;  scroll_pause := False;  scroll_pause_time := 500; // 3000ms = 3s  sx := width;  tx := 0;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(font_name);   fonts_width := fw;  fonts_height := fh;  sine_height := sh;  radians := PI / 180;  font_height_zoom := 2;end; function TSineScroller.Asc(s: Char): Integer;begin  Result := Ord(s);end; function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m: Integer;  src_Rect,dst_Rect : TRect;begin     Result := 1;  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   p := Asc(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;   for l := 0 to fonts_width - 1 do  begin    if (cx >= 0) and (x <= width) and (x + l >= 0) then    begin      m := pos_y + Round((sine_height) * Sin(-1 * (x + tx + l) / 1.4 * radians));       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy, cx + l + 2, cy + fonts_height);      canvas_ctx.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);     end;  end;  Result := 1;end; procedure TSineScroller.draw;var  last_char: Char;  x, i: Integer;  koda: Char;begin  if not scroll_pause then    sx -= scroll_speed  else    tx -= scroll_speed;   x := sx;  for i := 1 to Length(scroll_text) do  begin    koda := scroll_text[i];    x += fonts_width;    if (x > -fonts_width) and (x < width + fonts_width) then    begin      if drawFontChar(koda, x) = -1 then        Break;    last_char := koda;    end;  end;   if last_char = '_' then  begin  scroll_pause := True;    Sleep(scroll_pause_time);    scroll_pause := False;   end;   if x < 0 then    sx := width + fonts_width;end; procedure TSineScroller.unpause;begin  scroll_pause := False;end; end. ---------------------------------------------------------------------- KodeZwerg · 2024-05-15 11:49 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 · 2024-05-15 13:24 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 · 2024-05-15 13:25 Quote from: Gigatron on May 14, 2024, 07:27:32 pmAmiga 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). QuoteToday 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i for i := 1 to Length(scroll_text) do into 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 for i := 1 to HowManyCharactersAreVisibleAtOnceAtGivenScreenWidth do And ofc adjust for that to 'scroll' through the letters as well. Quote*** 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 ---------------------------------------------------------------------- TRon · 2024-05-15 13:33 Quote from: Gigatron on May 15, 2024, 03:24:11 pmMy question on the fpc compiler side, is there a specific setting to gain speed? Sure, see commandline options to get a full overview (see option -O). Lazarus project setting can set some of these options but you can set custom options for a project in case you want to change a setting that is not 'listed' by Lazarus. But better start fixing the obvious first ?  PS: because I have seen it a couple of times now I wonder if you perhaps do that on purpose to keep us awake (meaning everything is already in place but you do not seem to make use of it). ---------------------------------------------------------------------- Gigatron · 2024-05-15 14:32 Quote from: TRon on May 15, 2024, 03:33:50 pmQuote from: Gigatron on May 15, 2024, 03:24:11 pmMy question on the fpc compiler side, is there a specific setting to gain speed? PS: because I have seen it a couple of times now I wonder if you perhaps do that on purpose to keep us awake (meaning everything is already in place but you do not seem to make use of it). Yes, what I hope is that new programmers who discover Pascal never leave it and that Lazarus FPC becomes as powerful as any programming language using the minimum amount of code. It's true I can use components that exist to do what I want, Amiga demos and the music that goes with them. But the code should be as simple as simple. I don't know if you understood me? If the sinescroll code ran at 60 fps with the basic canvas? Sorry i used google translator , english is not my native language ; ---------------------------------------------------------------------- KodeZwerg · 2024-05-15 15:22 Quote from: Gigatron on May 15, 2024, 04:32:50 pmIf the sinescroll code ran at 60 fps with the basic canvas? It depends on monitor Hz and used code so there can't be a generic "Yes" answer. Like TRon already mentioned, take advantage from buffering and just render whats needed to be rendered. My suggestion, change your "Draw" method that it output a TBitmap instead of accessing the destination canvas, that way you can pump one finished rendering and straight work on the next while the LCL cares about to paint your bitmap on whatever canvas. (simple doublebuffer) And if you want to make it simple for the interested beginners, that is first of all a really nice doing from your side but I can't say it often enough, name your variables/methods logical for others not for your own doings, make code readable. Or would you know what that header arguments mean if you have not coded it? 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     constructor Create(font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);a beginner read: font_name: cool I enter "Arial"... sad it does not work but why? I entered a font name.... offset: what the heck does that mean? lets find out and try w, py, fw, fh, sh: cool, a collection of integers s_speed: okay, this might be something about speed, maybe... text: hey I remember, that is a property of a TControl, but what does it do here? if "font_name" mean, tell me a fontfilename, why not call the variable "AFontFilename"? if "w" means "Width", first rename to "AWidth" and second, the width of what? and so on, this problematic is like a red line thru all your sources, no offend, just saying. ---------------------------------------------------------------------- Gigatron · 2024-05-15 16:18 Yes you and @Tron ​​and surely others are right. In fact it's not finished I'm in the process of optimizing the code, I knew the result of the code, but it's starting from scratch... Then gradually adding things to make it simple and optimized. Thanks for your advices. ---------------------------------------------------------------------- TRon · 2024-05-15 16:34 Quote from: KodeZwerg on May 15, 2024, 05:22:45 pmIt depends on monitor Hz and used code so there can't be a generic "Yes" answer. I am really out of things for ages but do PC graphics cards have something like (user) syncing these days ? E.g. on the c64, Amiga and many other hardware from those days you could sync with the vertical blank (or similar) and use f.e. an interrupt to sync with frames. To this day it still makes me laugh when someone shows off his PC rendering 600 fps framerate believing that it is some sort of (important) accomplishment. It has some merits when playing games (same as monitor refresh rate) but also that is only working up to a certain point. QuoteLike TRon already mentioned, take advantage from buffering and just render whats needed to be rendered. Indeed, because then it becomes more about perception. And perception can be tricked...  Especially the character-fall fx in the other thread suffers from unnecessary processing because characters at their final destination should not be part of the render loop anymore. It reminds me of an fx that I saw where characters consisted out of particles and text would morph from one sentence into another, character by character... why ? because the little Amiga that could was only able to render so much particles (full color) at the same time. QuoteAnd if you want to make it simple for the interested beginners, that is first of all a really nice doing from your side but I can't say it often enough, name your variables/methods logical for others not for your own doings, make code readable. Admittingly my variables also looked similar when writing asm.... And there it is even worse with all the jump(s/tables)... There is/was a reason people started using turbo pascal/c to wrap their asm routines ---------------------------------------------------------------------- KodeZwerg · 2024-05-15 17:07 Quote from: TRon on May 15, 2024, 06:34:45 pmQuote from: KodeZwerg on May 15, 2024, 05:22:45 pmIt depends on monitor Hz and used code so there can't be a generic "Yes" answer.I am really out of things for ages but do PC graphics cards have something like (user) syncing these days ? E.g. on the c64, Amiga and many other hardware from those days you could sync with the vertical blank (or similar) and use f.e. an interrupt to sync with frames.As far as I know can software rendering, like Gigatrons LCL Sinusscroller, only show as many images as the graphic card driver is configured for on Desktop usage. (in many cases 30 or 60 FPS) Thats the spot where buffering makes a difference. As of right now his code draw to a canvas while it could already prepare the next image etc... Quote from: TRon on May 15, 2024, 06:34:45 pmAdmittingly my variables also looked similar when writing asm.... And there it is even worse with all the jump(s/tables)... There is/was a reason people started using turbo pascal/c to wrap their asm routines Same here, but such code is not made for a pascal beginner audience, its for my own usage When I publish something, I always try at least to make method signatures and method/property names sound to something where when I open such project 10 years later I am not needing to study the code to know ahhh "w" is "Width" and so on... Variables declared within a method is a different story hahaha In First-Person-Shooters (FPS) the Frames-Per-Second (FPS) does matter, its not a good FPS when running out of FPS *pun intended* I do still have an outdated but working like a charm 31" cathode- monitor on the attic, when I want "unlimited FPS" its the choice to be. Same with wired Mouse and Keyboard, but hey, now I am mature, don't play such anymore, so a "slow" monitor and wireless Input devices are okay ---------------------------------------------------------------------- Gigatron · 2024-05-17 01:44 Hi, late on the night , the maximum speed i reached is a bit more fps than before ; 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,SinScroller; type   { TForm1 }   TForm1 = class(TForm)    Timer1: TTimer;     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  public  end; var  Form1: TForm1;  Scroller: TSineScroller;  s_text : string = ' LAZARUS FPC THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  GUVA - HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  DoubleBuffered:=true;  Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text); end; procedure TForm1.FormDestroy(Sender: TObject);begin  Scroller.Free;end; procedure TForm1.FormPaint(Sender: TObject);begin      Scroller.draw;end; procedure TForm1.Timer1Timer(Sender: TObject); begin    Repaint;end; end.  and the included sinscroller constructor ; 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 SinScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TSineScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: string;    canvas_ctx: TCanvas;    scroll_speed: Integer;    scroll_pause: Boolean;    scroll_pause_time: Integer;    sx, tx: Integer;    bm : TBitmap;    fonts: TImage;    fonts_width, fonts_height: Integer;    sine_height: Integer;    radians: Double;    font_height_zoom: Double;    function drawFontChar(charek: Char; x: Integer): Integer;   public    constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);    procedure draw;   end;   implementation  constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);begin  offset_char := offset;  pos_y := py;  width := w;  scroll_text := text;  canvas_ctx := canvas;  scroll_speed := s_speed;  scroll_pause := False;   // future  scroll_pause_time := 5;  sx := width;  tx := 0;  bm := Tbitmap.Create; // buffer  bm.Width:=width;  bm.Height:=220;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(Bitmap_font_file);  fonts_width := fw;  fonts_height := fh;  sine_height := sh;  radians := 3.14 / 180;  font_height_zoom := 2;end; function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m: Integer;  src_Rect,dst_Rect : TRect;  sinTable: array of Double;begin  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;  p := Ord(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;  sinTable :=[];  m:=0;  SetLength(sinTable, fonts_width);  // sin table[] calculation  for l := 0 to fonts_width - 1 do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians);  for l := 0 to fonts_width-2  do  begin     if (cx >= 0) and (x + l <= width) then      begin       m := pos_y + Round(sine_height * sinTable[l]);      dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);      bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)    end;  end;   Result := 1;end;   procedure TSineScroller.draw;  var    last_char: Char;    x, i: Integer;    koda: Char;    xLimit: Integer;  begin    if not scroll_pause then      dec(sx, scroll_speed)    else    dec(tx, scroll_speed);     x := sx;    xLimit := width + fonts_width;     for i := 1 to Length(scroll_text) do    begin      koda := scroll_text[i];      x := x + fonts_width;      if (x > -fonts_width) and (x < xLimit) then      begin        if drawFontChar(koda, x) = 0 then          Break;        last_char := koda;      end;    end;  if x < 0 then  sx := xLimit;  // final display     canvas_ctx.Draw(0,100,bm);     bm.Canvas.Brush.Color :=clBlack;     bm.Canvas.FillRect(0,0,640,220);  end;end. ---------------------------------------------------------------------- Josh · 2024-05-17 09:31 hi just after aquick look, Do you need the Precision of Double? Would Single Help speed? it appears as though the sin table is being calculated for each character, can this not be done just once when its created, should speed upcalculation. this would stop the alloc of memory on each call, would require the array def to be removed from proc and made/defined as global 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  sinTable: array of Double; for l := 0 to fonts_width - 1 do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians); not sure so you may need to check , pixel accuracy is fine but on most monitors you could probaly speed up by incremeting in 2, the for loop 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 for l := 0 to fonts_width-2  do  begin     if (cx >= 0) and (x + l <= width) then      begin       m := pos_y + Round(sine_height * sinTable[l]);    dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);      bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)    end;  end;  with   l:=0;  while l<=fonts_width-2  do  begin     if (cx >= 0) and (x + l <= width) then     begin       m := pos_y + Round(sine_height * sinTable[l]);       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));       src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);       bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)     end;     inc(l,2);  end; ---------------------------------------------------------------------- Gigatron · 2024-05-17 14:53 Hi, Thank you @Josh I modified the code according to your changes, I did not make the sine table calculated because of the size of the table, each time the VBL passes the calculation must be redone because the program processes in pixels, so that's a large painting. In fact there is a solution but I don't have the time I'm lazy (lazy coder) Here the 'while' loop speeds up the display 4 pixels shift / Vbl. Finally, I really like to code with Pascal language ; 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,  StdCtrls, SinScroller; type   { TForm1 }   TForm1 = class(TForm)    GroupBox1: TGroupBox;    SpinEdit1: TSpinEdit;    SpinEdit2: TSpinEdit;    Timer1: TTimer;     procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure SpinEdit1Change(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  public  end; var  Form1: TForm1;  Scroller: TSineScroller;  s_text : string = ' LAZARUS FPC THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  JOSH  -  GUVA  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  DoubleBuffered:=true;  Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text); end; procedure TForm1.FormDestroy(Sender: TObject);begin  Scroller.Free;end; procedure TForm1.FormPaint(Sender: TObject);begin      Scroller.draw;end; procedure TForm1.SpinEdit1Change(Sender: TObject);begin     Scroller.Free;     Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,SpinEdit1.Value, SpinEdit2.Value,  s_text);end; procedure TForm1.Timer1Timer(Sender: TObject); begin    Repaint;end; end.  Sinscroller unit ; 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 SinScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TSineScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: string;    canvas_ctx: TCanvas;    scroll_speed: Integer;    scroll_pause: Boolean;    scroll_pause_time: Integer;    sx, tx: Integer;    bm : TBitmap;    fonts: TImage;    fonts_width, fonts_height: Integer;    sine_height: Integer;    radians: Single; // Precision     font_height_zoom: Double;    function drawFontChar(charek: Char; x: Integer): Integer;   public    constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);    procedure draw;   end;   implementation  constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);begin  offset_char := offset;  pos_y := py;  width := w;  scroll_text := text;  canvas_ctx := canvas;  scroll_speed := s_speed;  scroll_pause := False;   // future  scroll_pause_time := 5;  sx := width;  tx := 0;  bm := Tbitmap.Create; // buffer  bm.Width:=width;  bm.Height:=220;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(Bitmap_font_file);  fonts_width := fw;  fonts_height := fh;  sine_height := sh;  radians := 3.14 / 180;  font_height_zoom := 2; end; function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m: Integer;  src_Rect,dst_Rect : TRect;  sinTable: array of Single;  // forgot: precsion is Single now; begin  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;  p := Ord(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;  sinTable :=[];  m:=0;  SetLength(sinTable, fonts_width);  // sin table[] calculation  for l := 0 to fonts_width - 1  do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians);  l:=0;  while l<=fonts_width-2  do  begin     if (cx >= 0) and (x + l <= width) then     begin       m := pos_y + Round(sine_height * sinTable[l]);       dst_Rect := Rect(x + l, m, x + l + 4, m + Round(fonts_height * font_height_zoom));       src_Rect := Rect(cx + l, cy,  cx + l + 4, cy + fonts_height);       bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)     end;     inc(l,4); // 2  end;   Result := 1;end;   procedure TSineScroller.draw;  var    last_char: Char;    x, i: Integer;    koda: Char;    xLimit: Integer;  begin    if not scroll_pause then    dec(sx, scroll_speed)    else      dec(tx, scroll_speed);    x := sx;    xLimit := width + fonts_width;    for i := 1 to Length(scroll_text) do    begin      koda := scroll_text[i];      x := x + fonts_width;      if (x > -fonts_width) and (x < xLimit) then    begin        if drawFontChar(koda, x) = 0 then          Break;        last_char := koda;      end;    end;  if x < 0 then  sx := xLimit;  // final display     canvas_ctx.Draw(0,100,bm);     bm.Canvas.Brush.Color :=clBlack;     bm.Canvas.FillRect(0,0,640,220);  end;end. ---------------------------------------------------------------------- TRon · 2024-05-17 15:20 Quote from: Josh on May 17, 2024, 11:31:35 amcan this not be done just once when its created, should speed upcalculation. this would stop the alloc of memory on each call, would require the array def to be removed from proc and made/defined as global Yes, that is the better approach but also then things could be improved. Though these days it does not matter much it is possible to use an integer table (shl to keep/store precision and shr for actual use) but that is assuming a 'normal' sine amplitude. What would be better is storing a complete cycle in a table (adjusted to real y coordinates) and only use an index (adjust with a speed increase/delay). You can then apply mod to roll over the sine table (because the number of entries in the table are known). You can apply different modifiers to the index to achieve different wave effects and/or increase/decrease speed. If you take it even one step further it is possible to pre-calc the rectangles (both the source and destination, but especially the destination rectangle would probably be the most effective). No need to bother with graphics you can just toy with the calculations and arrays for a comparison and calculate let's say a million times and time the difference between the different calculations/lookup methods. Jsut know that everything pre calculated does not take time in the actual render loop. When working with calculations each and every cpu cycle counts and the compiler is usually able to make the best out of it using optimizations but that is not always the case (you would have to output the assembler code in order to see the actual effect of the optimization). BTW: i have not looked at the actual rectangle draw implementation but ideally, and in this particular case of 2 pixels width (2xrgba =  64 bits) it is possible to write a specialized copy routine in order to 'move' the pixels around, one (vertical) line (of two pixels width) at a time using a modulo modifier. That would be able to speed up things as well but in that case it must be sure that pixels are stored inside the bitmap as 4 bytes (or 3 bytes per pixels ofc as the basics are the same). Without having seen the actual rectangle draw implementation I am ofc not sure but I suspect it would be faster. Quote from: Gigatron on May 17, 2024, 04:53:19 pmIn fact there is a solution but I don't have the time I'm lazy (lazy coder) And that, my friend, is the actual issue    But seriously, it takes another approach to optimize things to the fullest. and in case everything else fails (or isn't sufficient) there is always the option to pre-render graphics (but I personally consider that defeat). ---------------------------------------------------------------------- Josh · 2024-05-17 18:26 Hi I was thinking of something like this Precalculate the SinTable; 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 TSineScroller.PrecomputeSinTable;var  l: Integer;begin  for l := 0 to High(sinTable) do    sinTable[l] := Sin(-l / 1.4 * radians);end;       modify the code for the source and dest rect 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  add Var tableLength,Index:Integer;// should speed up calc only once.   m:=0;  tableLength := Length(sinTable);  l:=0;  while l<=fonts_width-2 do  begin    if (cx >= 0) and (x + l <= width) then    begin      index := (x + tx + l + tableLength) mod tableLength;  // make sure index is in range      m := pos_y + Round(sine_height * sinTable[index]);      dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);      bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)    end;    inc(l,1);  // increase this to 2 should give a speed boost, but may effect quality  end;         the in constructor 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 SetLength(sinTable, width + fonts_width);  PrecomputeSinTable;             The above is  only from looking at your code, I have not tried it so may or may not work. edit added some text 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 inc(l,1);  // increase this to 2 should give a speed boost, but may effect quality ---------------------------------------------------------------------- Gigatron · 2024-05-17 23:43 Ok  many tanks @Josh This is the latest version of the code, the only other thing left is to triple buffer later  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 SinScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TSineScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: string;    canvas_ctx: TCanvas;    scroll_speed: Integer;    sx: Integer;    bm: TBitmap;    fonts: TImage;    fonts_width, fonts_height: Integer;    sine_height: Integer;    radians: Single;    font_height_zoom: Single;    sinTable: array of Single;     procedure PrecalculateSinTable;    function drawFontChar(charek: Char; x: Integer): Integer;   public    constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);    procedure draw;  end; implementation constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);begin  offset_char := offset;  pos_y := py;  width := w;  scroll_text := text;  canvas_ctx := canvas;  scroll_speed := s_speed;  sx := width;  bm := TBitmap.Create; // buffer  bm.Width := width;  bm.Height := 220;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(Bitmap_font_file);  fonts_width := fw;  fonts_height := fh;  sine_height := sh;  radians := 0.0174; // PI/180 0.0174444444  font_height_zoom := 2;  SetLength(sinTable, width + fonts_width);  PrecalculateSinTable;end; procedure TSineScroller.PrecalculateSinTable;var  i: Integer;begin  for i := 0 to High(sinTable) do  begin    sinTable[i] := Sin(-1 * i / 1.4 * radians);  end;end; function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m: Integer;  src_Rect, dst_Rect: TRect;  tableLength,Index:Integer;begin   if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   p := Ord(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;  tableLength := Length(sinTable);  l := 0;   while l <= fonts_width - 2 do  begin    if (cx >= 0) or (x + l <= width) then    begin      index := (x + l + tableLength) mod tableLength;  // make sure index is in range      m := pos_y + Round(sine_height * sinTable[index]);      dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy, cx + l + 2, cy + fonts_height);      bm.Canvas.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas, src_Rect);    end;    Inc(l, 2);  end;   Result := 1;end; procedure TSineScroller.draw;var  x, i: Integer;  koda: Char;  xLimit: Integer;begin   Dec(sx, scroll_speed);   x := sx;  xLimit := width + fonts_width;  for i := 1 to Length(scroll_text) do  begin    koda := scroll_text[i];    Inc(x, fonts_width);    if (x > -fonts_width) and (x < xLimit) then    begin      if drawFontChar(koda, x) = 0 then        Break;    end;  end;   if x < 0 then sx := xLimit;  // final display  canvas_ctx.Draw(0, 100, bm);  bm.Canvas.Brush.Color := clBlack;  bm.Canvas.FillRect(Rect(0, 0, bm.Width, bm.Height));end; end. ---------------------------------------------------------------------- Josh · 2024-05-18 02:27 I assume its speeding up? Another tweek, would be to convert the array to integer should speed the calc up, but as you are aware its the amount of pixel(s) copryect thats the bottleneck Thats all the tweaks I can think of with the code, I will probably try it out over the weekend, if there was a complete project.zip file to test. 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 font_height_zoom: Integer; // does this need to float? if not font_height_mul_zoom:=fonts_height * font_height_zoom; // you probably want to change name, i chose a long descriptive one sinTable: array of Integer;   createfont_height_mul_zoom:=fonts_height * font_height_zoom;SetLength(sinTable, width + fonts_width);    procedure TSineScroller.PrecomputeSinTable;var  l: Integer;begin  for l := 0 to High(sinTable) do  sinTable[l] := Round(sine_height * (Sin(-l / 1.4 * radians)));end;   draw code       m := pos_y + sinTable[index];      dst_Rect := Rect(x + l, m, x + l + 2, m + font_height_mul_zoom); ---------------------------------------------------------------------- TRon · 2024-05-18 13:26 Quote from: Gigatron on May 17, 2024, 04:53:19 pmI did not make the sine table calculated because of the size of the table, each time the VBL passes the calculation must be redone because the program processes in pixels, so that's a large painting. In fact there is a solution but I don't have the time I'm lazy (lazy coder) Just calculate a complete wave and use offsets as I mentioned in one of my previous posts. But anyhows, the following is imho good for measurements (note that the code still calculated the sine when rendering). 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 function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;const  pixel_modulo = 8;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32var  p, cx, cy, l, m: Integer;  src_Rect,dst_Rect : TRect;begin  Result := 1;  if (x > width) and (x > 0) then  begin    Result := 0;  Exit;  end;   p := Asc(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;   l := 0;  while l < fonts_width - 1 do  begin    if (cx >= 0) and (x <= width) and (x + l >= 0) then    begin      m := pos_y + Round((sine_height) * Sin(-1 * (x + tx + l) / 1.4 * radians));       dst_Rect := Rect( x + l, m,   x + l + pixel_modulo, m  + Round(fonts_height * font_height_zoom));      src_Rect := Rect(cx + l, cy, cx + l + pixel_modulo, cy + fonts_height);       canvas_ctx.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);    end;    inc(l, pixel_modulo);  end;   Result := 1;end;  And that results to attached picture. I admit it is still poor result for simply pushing around 160k of bytes. ---------------------------------------------------------------------- Gigatron · 2024-05-18 15:00 Many Thanks @Tron & @Josh I think it's done on 95% optimized ; I will make some addition in future.. ** Don't forget, alone you don't go fast with others you exceed the speed of light ** Final code : Unit : 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,  StdCtrls, SinScroller; type   { TForm1 }   TForm1 = class(TForm)    GroupBox1: TGroupBox;    SpinEdit1: TSpinEdit;    SpinEdit2: TSpinEdit;    Timer1: TTimer;    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure SpinEdit1Change(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private  public  end; var  Form1: TForm1;  Scroller: TSineScroller;  s_text : string = ' LAZARUS PASCAL FPC 4.0.0 DYNAMIC COMPILER THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  LAINZ  TRON    KODEZWERG    JOSH    GUVA    HUKKA    MARCOV    MARTIN-FR    PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM        '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin // DoubleBuffered:=true;  Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text); end; procedure TForm1.FormDestroy(Sender: TObject);begin    Scroller.Free;end; procedure TForm1.FormPaint(Sender: TObject);begin     Scroller.draw;end; procedure TForm1.SpinEdit1Change(Sender: TObject);begin     Scroller.Free;     Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,SpinEdit1.Value, SpinEdit2.Value,  s_text);end; procedure TForm1.Timer1Timer(Sender: TObject);begin      Repaint;end; end.  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 SinScroller; interface uses  Classes, SysUtils, Graphics, ExtCtrls; type  TSineScroller = class  private    offset_char: Char; // First Character in bitmap fonts    pos_y: Integer;    width: Integer;    scroll_text: string;    canvas_ctx: TCanvas;    scroll_speed: Integer;    sx: Integer;    bm: TBitmap;    fonts: TImage;    fonts_width, fonts_height: Integer;    sine_height: Integer;    radians: Single;    font_height_zoom: Integer;    sinTable: array of Single;    tableLength : integer;     procedure PrecalculateSinTable;    function drawFontChar(charek: Char; x: Integer): Integer;   public    constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);    procedure draw;  end; implementation constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);begin  offset_char := offset;  pos_y := py;  width := w;  scroll_text := text;  canvas_ctx := canvas;  scroll_speed := s_speed;  sx := width;  fonts := TImage.Create(nil);  fonts.Picture.LoadFromFile(Bitmap_font_file);  fonts_width := fw;  fonts_height := fh;  sine_height := sh;  bm := TBitmap.Create; // buffer  bm.Width := width;  bm.Height := 220;   radians := 0.0174; // PI/180 0.0174444444  font_height_zoom := 2;  SetLength(sinTable, width + fonts_width);  tableLength := Length(sinTable);  PrecalculateSinTable;end; procedure TSineScroller.PrecalculateSinTable;var  i: Integer;begin  for i := 0 to High(sinTable) do  begin    sinTable[i] := Sin(-1 * i / 1.4 * radians);    // float single precision   // sinTable[i] := Round(sine_height * (Sin(-i / 1.4 * radians)));   // int  end;end; function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;const  pixel_modulo = 4;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32var  p, cx, cy, l, m: Integer;  src_Rect,dst_Rect : TRect;begin  Result := 1;  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   p := Ord(charek);  cx := (p - Ord(offset_char)) * fonts_width;  cy := 0;   l := 0;  while l < fonts_width - 2 do  begin      m := pos_y + Round((sine_height) * Sin(-1 * (x +  l) / 1.4 * radians));      dst_Rect := Rect( x + l, m, x + l + pixel_modulo, m  + Round(fonts_height * font_height_zoom));    src_Rect := Rect(cx + l, cy, cx + l + pixel_modulo, cy + fonts_height);    if (cx >= 0) and (x <= width) and (x + l >= 0) then    begin       if(p<>32) then bm.Canvas.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);   // bypass Space char (32) !    end;    inc(l, pixel_modulo);  end;   Result := 1;end; procedure TSineScroller.draw;var  x, i: Integer;  koda: Char;  xLimit: Integer;begin   Dec(sx, scroll_speed);   x := sx;  xLimit := width + fonts_width;  for i := 1 to Length(scroll_text) do  begin    koda := scroll_text[i];    Inc(x, fonts_width);    if (x > -fonts_width) and (x < xLimit) then    begin      if drawFontChar(koda, x) = 0 then      Break;    end;  end;   if x < 0 then sx := xLimit;  // final display  canvas_ctx.Draw(0, 100, bm);  bm.Canvas.Brush.Color := clBlack;  bm.Canvas.FillRect(Rect(0, 0, bm.Width, bm.Height));end; end. ---------------------------------------------------------------------- TRon · 2024-05-18 15:12 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 const  pixel_modulo = 8;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32 Oops, wrong comment  It should read: 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 const  pixel_modulo = 8;  // make this a power of 2, thus 1, 2, 4, 8, 16 or 32 ---------------------------------------------------------------------- Gigatron · 2024-05-27 23:08 Hi, And I discovered yet another fantastic function thank you @Circular, ( @Lainz )  : BGRA Scanner; I can now use it like Amiga Copper circuit to move each lines to make like sinus scroll; The result is really awesome , reflection and bitmap sinus scroll on 60/fps !!! Will upload project soon ! 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, BGRATransform; const     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,1 3,14,15,16,17,18,19,20,21,22,23,24,25);  var  CharImage: TBGRABitmap;  ScrollSpeed: integer = 3;  ScrollCounter: integer = 1;  CharWidth : integer = 15;  CharHeight :  integer = 22;  CharsPerLine : integer = 700;  ScrollText2: String = '                                              OF COURSE !!!  ))))) GIGATRON (((((  PRESENTS : BGRA REFLECTION FX MADE WITH LAZARUS FPC THE BEST SALUTE GO TO : CIRCULAR LAINZ JOSH KODEZWERG TRON GUVACODE RAYSAN5 LAZARUS AND FPC TEAM  AND ALL OTHER !!!  THE SPECIAL GREETINGS IN ALPHABETICAL ORDER GO TO : AXXESS ANTITRAX BFBS BLIZZARDS BS1 BST CCW ERNIE FREE NETWORK GENERAL INDY IBB KNIGHT HAWKS MEGAFORCE NEW AGE MR.NEWLOOK NORTHERN LIGHTS POWERXTREME RANDOM ACCESS RED SECTOR SKYLINE TLC TOM VISITOR WIZARDS AND ALL THE OTHERS WE KNOW....   COMMING SOON MORE AND MORE NEW PRG FROM THE UNATTAINABLE   ))))) GIGATRON ((((( IN 2024 !!!!!                                                                       ';   type  TWaveScanner = class(TBGRAAffineBitmapTransform)    Time: integer;    function GetOffset({%H-}X, Y: Single): Single;    { fast integer scanning (used by PutImage) }    procedure ScanMoveTo(X, Y: Integer); override;    { slow floating point scanning }    function ScanAt(X, Y: Single): TBGRAPixel; override;    constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean);  end;   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    copper,top_pic,bot_pic,f_pic: TBGRABitmap;    WaveScanner: TWaveScanner;    txt_scanner: TWaveScanner;  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  top_pic := TBGRABitmap.Create('giga.png');  copper  := TBGRABitmap.Create('copper.png');  bot_pic := TBGRABitmap.Create('giga.png');  WaveScanner := TWaveScanner.Create(bot_pic,false, false); // reflection bitmap  WaveScanner.scale(1,0.60);  WaveScanner.Translate(0,300);  WaveScanner.GlobalOpacity:=105;  bot_pic.VerticalFlip;   CharImage := TBGRABitmap.Create('font.png');  f_pic := TBGRABitmap.Create(740,202); // important !  txt_scanner := TWaveScanner.Create(f_pic,false,false);  txt_scanner.Translate(-50,0);  txt_scanner.scale(2.0,1.50);  txt_scanner.GlobalOpacity:=235; end; // wobble or sinwave !!procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var   I,   Chr: Integer;   CharX, CharY: Integer;   ScrollOffset: Integer;begin   Bitmap.PutImage(0,0,copper,dmSet);  Bitmap.PutImage(0,80,top_pic,dmFastBlend);  inc(WaveScanner.Time);  Bitmap.Fill(WaveScanner,dmFastBlend);   inc(txt_scanner.Time,2);   ScrollOffset :=  ScrollCounter ;    for I := 0 to Length(ScrollText2) do    begin       Chr := Ord(ScrollText2[I]);       CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;       CharY := ((I - 1) div CharsPerLine) * CharHeight  ;       f_pic.PutImagePart(CharX ,180+CharY , CharImage, Rect(0, 24*ascii[chr-32] , 15, 24*ascii[chr-32]+CharHeight), dmSet);     end;      ScrollCounter := ScrollCounter + ScrollSpeed;     if ScrollCounter >= CharWidth then   begin    ScrollCounter := ScrollCounter - CharWidth;    ScrollText2 := Copy(ScrollText2,2, Length(ScrollText2) - 1) + ScrollText2[1];   end;   // Scroll bitmap font text   Bitmap.Fill(txt_scanner,dmFastBlend);  end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGRAVirtualScreen1.RedrawBitmap;end; { TWaveScanner } function TWaveScanner.GetOffset(X, Y: Single): Single;begin  result := 10 * sin((Y + Time) * 30/5 * PI / 180);end; procedure TWaveScanner.ScanMoveTo(X, Y: Integer);begin  inherited ScanMoveTo(X + round(GetOffset(X, Y)), Y);end; function TWaveScanner.ScanAt(X, Y: Single): TBGRAPixel;begin  Result:=inherited ScanAt(X + GetOffset(X, Y), Y);end; constructor TWaveScanner.Create(ASource: TBGRACustomBitmap;  ARepeatX,ARepeatY: boolean);begin  inherited Create(ASource, ARepeatX, ARepeatY);  Time := 0;end; end. ---------------------------------------------------------------------- lainz · 2024-05-27 23:56 In fact thanks to @circular, I only contribute in BGRAControls =) ---------------------------------------------------------------------- Gigatron · 2024-05-29 14:38 Hi I would like to note here , BGRA is really awesome !! The cube was missing in the demos I coded, it's done :=) ---------------------------------------------------------------------- Gigatron · 2024-05-31 01:02 Hi, Before sleeping late on night i would like to share a nice bitmap sinus scroller made by using BGRA and the awesome Putimagepart command ! This time the font is not 1 pixel plane(1bit color)  but 8bit colors and accept unaligned bitmap on multi lines ! Enjoy ; 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, BCTypes,BGRABitmapTypes; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   procedure draw;   function drawFontChar(charek: Char; x: Integer): Integer;  end; var  Form1: TForm1;  bitmap_font,dest_bitmap,copper  : TBGRABitmap;   radians: single;  fonts_width, fonts_height,pos_y: Integer;  sx, tx: Integer;  charek : char;  offset: Char;  sine_height: Integer;  scroll_speed :integer;  sine_counter : single;   s_text : string = 'LAZARUS FPC 5.0 CRACKED BY GIGATRON ON 29.05.2032 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  MATTIAS  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........        '; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin       bitmap_font := TBGRABitmap.Create('022_32.png');       dest_bitmap := TBGRABitmap.Create(800,440);       copper      := TBGRABitmap.Create('copper.png');       radians := PI / 180;       fonts_width  :=32;       fonts_height := 32;       sx := 800;  // star scroll pos x       charek :=' '; // void always !       offset := ' '; // the first char on s_text = ' ' = space       sine_height := 100;       scroll_speed := 3;       pos_y := 200;       sine_counter :=0; end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap); begin           bitmap.PutImage(0,10,dest_bitmap,dmset);           bitmap.PutImage(0,100,copper,dmset);           bitmap.PutImage(0,344,copper,dmset);           draw;  // scrollingend; procedure TForm1.Timer1Timer(Sender: TObject);begin     BGRAVirtualScreen1.RedrawBitmap;     sine_counter := sine_counter +0.04;end; function TForm1.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m,r: Integer;  sinTable: array of single;begin  if (x > width) and (x > 0) then  begin    Result := 0;  Exit;  end;    p := Ord(charek) ;   r :=  (p - Ord(offset))  div 10 ;   cx := (p - Ord(offset) -r * 10 )  * fonts_width;   cy := 0 + (r * fonts_height); // 0   SetLength(sinTable, fonts_width);  for l := 0 to fonts_width - 1 do sinTable[l] := Sin(-1 * (x + tx + l) / 1.8 * radians); // sin table calculation   for l := 0 to fonts_width-2  do  begin    if (cx >= 0) and (x + l <= width) then    begin        m := pos_y + Round(sine_height * sinTable[l])  ;        dest_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy, cx + l + 2, cy + fonts_height), dmset);    end;  end;   Result := 1;end; procedure TForm1.draw;var  last_char: Char;  x, i: Integer;  koda: Char;  xLimit: Integer;begin   dec(sx, scroll_speed);  x := sx;  xLimit := width + fonts_width;   for i := 1 to Length(s_text) do  begin    koda := s_text[i];    x := x + fonts_width;   if (x > -fonts_width) and (x < xLimit) then    begin      if drawFontChar(koda, x) = 0 then        Break;      last_char := koda;  end;  end;  if x < 0 then sx := xLimit; end; end. ---------------------------------------------------------------------- Gigatron · 2024-05-31 14:36 Hi, Ok, if we combine all fx we have a nice Amiga Style intro. We are now in 2032 and someone cracked Lazarus FPC 5.0  The plein explained code ; I know now how code Intro demo with Lazarus FPC, Thank you guys for your contribution !!! ( All of you are credited in this intro ) Maybe you want to see the result on YT ? https://www.youtube.com/watch?v=S5miEG55OPw 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, mmsystem,BGRABitmapTypes; type  TStar = record        //  starfiled - !    X, Y, Z, Speed : Single;  // precision is now ok !    end;   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    // star field :    Stars: array of TStar;    procedure InitializeStarfield;    procedure UpdateStarfield;   public    MyAudio_File: AnsiString;    WavStream : TMemoryStream;   procedure draw;   function drawFontChar(charek: Char; x: Integer): Integer;  end; var  Form1: TForm1;  bitmap_font,dest_bitmap,copper,logo : TBGRABitmap; // images  radians ,sine_counter: single;  fonts_width, fonts_height,pos_y: Integer;  sx, tx : Integer;  alfa   : byte;  charek : char;  offset: Char;  sine_height,scroll_speed : Integer;  mess: Array[0..12] Of String =('                          ',                               '     CODE : GIGATRON      ',                               '                          ',                               '    FONT : ACKERLIGHT     ',                                 '                        ',                                 '  SFX  : ASTAROTH AMIGA   ',                                 '      JOCHEN HIPPEL       ',                                 '                        ',                                 '  DESIGN : TRONIC-SYSTEM  ',                               '                          ',                               '     CONTACT GIGATRON     ',                               '     BP : 3300 68000      ',                               '      COLMAR FRANCE       ');   tx_id : integer;  s_text : string = 'LAZARUS FPC 5.0 CRACKED BY GIGATRON ON 29.05.2032 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ  -  TRON   -  JOSH  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -  MARCOV  -  MARTIN- FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          '; implementation {$R *.lfm} { TForm1 } procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, 150); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);    Stars[i].Y := 330+Random(BGRAVirtualScreen1.Height div 2)-230;   // Stars[i].Z := Random(FFieldDepth);    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i: Integer;begin  for i := 0 to High(Stars) do  begin     Stars[i].X := Stars[i].X - Stars[i].Speed ;   if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := BGRAVirtualScreen1.Width;      Stars[i].Y := 330+ Random(BGRAVirtualScreen1.Height div 2)-230;      Stars[i].Speed := Random * 7 + 1;    end;  end;end; procedure TForm1.FormCreate(Sender: TObject);begin     bitmap_font := TBGRABitmap.Create('038_32.png');  //022.32     dest_bitmap := TBGRABitmap.Create(760,440);     copper    := TBGRABitmap.Create('copper.png');     logo        := TBGRABitmap.Create('logo.png');     radians := PI / 180;     fonts_width  :=32;     fonts_height := 32;     sx := 800;  // start scroll pos x   right     charek :=' '; // void always !     offset := ' '; // the first char on s_text = ' ' = space     sine_height := 50; // sinus height     scroll_speed := 5;     pos_y := 100;     sine_counter :=0;  // move sinus movement     alfa :=0;     tx_id :=0;  // message line index      InitializeStarfield; // star field   // audio stream    MyAudio_File := 'astaroth.wav';    WavStream    := TMemoryStream.Create;  //  WavStream.LoadFromFile(MyAudio_File);  //  PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY); end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap); var i: Integer; StarPosition: TPoint; sttype : integer = 7; col: TBGRAPixel; begin       // font to display message !       Bitmap.FontName:='AmigaDigital';       Bitmap.FontHeight:=36;        bitmap.StretchPutImage(Rect(0,0,760,880),dest_bitmap,dmSet);       draw;  // text scrolling    // Star Field  *----------------------------   for i := 0 to High(Stars) do   begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);       case  (sttype)  of      1: col := BGRA(50,50,50);      2: col := BGRA(75,75,75);      3: col := BGRA(100,100,100);      4: col := BGRA(125,125,125);      5: col := BGRA(150,150,150);      6: col := BGRA(175,175,175);      7: col := BGRA(200,200,200);      8: col := BGRA(254,254,254);      end;     Bitmap.Rectangle(rect(StarPosition.X, StarPosition.Y,StarPosition.X+2, StarPosition.Y+2),col,dmDrawWithTransparency);   end;   // Z-INDEX care !!   bitmap.PutImage(0,100,copper,dmset); // cop rasters  1 & 2   bitmap.PutImage(0,352,copper,dmset);   // Message display   Bitmap.TextOut(200,400,mess[tx_id],BGRA(alfa,alfa,alfa));   // logo display   bitmap.StretchPutImage(Rect(70,10,700,90),logo,dmDrawWithTra nsparency); end; procedure TForm1.Timer1Timer(Sender: TObject);begin   BGRAVirtualScreen1.RedrawBitmap;     sine_counter := sine_counter +0.04;     inc(alfa);     if (alfa >= 255) then      begin      alfa :=0;      tx_id := tx_id +1;      if tx_id>12 then tx_id :=0;      end;     UpdateStarfield;end; function TForm1.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m,r: Integer;  sinTable: array of single;begin  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   // 32 x 32 pixel bitmap font scroller !! nothing else   p := Ord(charek) ;   r :=  (p - Ord(offset))  div 10 ;   cx := (p - Ord(offset) -r * 10 )  * fonts_width;   cy := 0 + (r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !   SetLength(sinTable, fonts_width);  for l := 0 to fonts_width - 1 do sinTable[l] := Sin(-1 * (x + tx + l+sine_counter) / 1.8 * radians); // sin table calculation + sine_counter   for l := 0 to fonts_width-2  do  begin    if (cx >= 0) and (x + l <= width) then    begin        m := pos_y + Round(sine_height * sinTable[l])  ;        dest_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy, cx + l + 2, cy + fonts_height), dmset);    end;    sine_counter := sine_counter +0.002; // +  end;   Result := 1;end; procedure TForm1.draw;var  last_char: Char;  x, i: Integer;  koda: Char;  xLimit: Integer;begin   dec(sx, scroll_speed);  x := sx;  xLimit := width + fonts_width;   for i := 1 to Length(s_text) do  begin    koda := s_text[i];    x := x + fonts_width;   if (x > -fonts_width) and (x < xLimit) then    begin      if drawFontChar(koda, x) = 0 then        Break;      last_char := koda;    end;  end;  if x < 0 then sx := xLimit; end; // Liber et vire tout , Free allprocedure TForm1.FormDestroy(Sender: TObject);begin  bitmap_font.free;  dest_bitmap.Free;  copper.free;  logo.free;end; end. ---------------------------------------------------------------------- TRon · 2024-06-01 05:29 Quote from: Gigatron on May 31, 2024, 04:36:57 pmOk, if we combine all fx we have a nice Amiga Style intro. Nice Gigatron ! For some additional (quick mock-up) motion: 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 ...uses  graphutil...type  TRainBowDirection = -1..1; procedure RenderHorizontalRainbow(const aBitmap: TBGRABitmap; const aBox: TRect; const HueInterval: byte; const HueCycleSpeed: byte; const Direction : TRainBowDirection);const  Lightness = 128;  Saturation = 255;  HueDeg: integer = 0;var  x,y: integer;  Hue: integer;  n, count: integer;  idx: integer = 0;  srcPixel: TBGRAPixel;begin  x := aBox.Left;   while x < aBox.Right do  begin    Hue := round(255/360 * ((huedeg + idx * hueinterval) mod 360));    HLStoRGB(Hue, Lightness, Saturation, srcPixel.Red, srcPixel.Green, srcPixel.Blue);     if x + HueInterval < aBitmap.Width     then count := HueInterval      else count := aBitmap.Width - x;     for n := 1 to count do    begin      for y := aBox.Top to aBox.Bottom-1        do aBitmap.SetPixel(x,y,srcpixel);    inc(x);    end;     case direction of     -1  : dec(idx);      0  : { nothing };      1  : inc(idx);    end;  end;   huedeg := (HueDeg + HueCycleSpeed) mod 360;end; and replace 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   bitmap.PutImage(0,100,copper,dmset); // cop rasters  1 & 2  bitmap.PutImage(0,352,copper,dmset);  with 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   RenderHorizontalRainbow(Bitmap, Bounds(0,100, Bitmap.Width, 2), 6, 1*6, 1);  RenderHorizontalRainbow(Bitmap, Bounds(0,352, Bitmap.Width, 2), 6, 1*6, -1); Initially I tried to solve it with bgra multigradient but I seem unable to get that working on a per pixel color/interval base. It goes almost without saying that pre-rendering speeds things up significantly. My aim was to get rid of the png image and add some motion  PS: Some minor issue with the sine scroller using original code as can be seen... ---------------------------------------------------------------------- Gigatron · 2024-06-01 14:09 Hi thank you @Tron; For the issue you must just substract 1 to cy at : 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 tx_scroll_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy,    cx + l + 2, cy + fonts_height), dmset);With this one ; 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 tx_scroll_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy-1, cx + l + 2, cy + fonts_height), dmset); This code will working with all unaligned 32x32 bitmap font like a charm Unaligned i mean not  like 32*(32*28) pixel but (320*192) pixel image ; x 10 chars y = 6 chars look font image ** Edit(2) Perfect work for Horizontal Rasters movement, THX !!!! 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, mmsystem,BGRABitmapTypes,graphutil; type  TStar = record        //  starfiled - !    X, Y, Z, Speed : single;  end; type  TRainBowDirection = -1..1;   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private    // star field :    Stars: array of TStar;    procedure InitializeStarfield;    procedure UpdateStarfield;   public    MyAudio_File: AnsiString;    WavStream : TMemoryStream;   procedure drawSineScroll;   function drawFontChar(charek: Char; x: Integer): Integer;  end; var  Form1: TForm1;  bitmap_font,tx_scroll_bitmap,logo : TBGRABitmap; // images  radians ,sine_counter: single;  fonts_width, fonts_height,pos_y: Integer;  sx, tx : Integer;  alfa   : byte;  charek : char;  offset: Char;  sine_height,scroll_speed : Integer;  mess: Array[0..12] Of String =('                          ',                               '     CODE : GIGATRON      ',                               '                          ',                               '    FONT : ACKERLIGHT     ',                                 '                        ',                                 '  SFX  : ASTAROTH AMIGA   ',                                 '      JOCHEN HIPPEL       ',                                 '                        ',                                 '  DESIGN : TRONIC-SYSTEM  ',                               '                          ',                               '     CONTACT GIGATRON     ',                               '     BP : 3300 68000      ',                               '      COLMAR FRANCE       ');   tx_id : integer;  s_text : string = 'LAZARUS FPC 5.0 CRACKED BY GIGATRON ON 29.05.2032 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ  -  TRON   -  JOSH  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -  MARCOV  -  MARTIN- FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          '; implementation {$R *.lfm} { TForm1 } // moving H-Rasters from @Tron , perfect work !procedure RenderHorizontalRainbow(const aBitmap: TBGRABitmap; const aBox: TRect; const HueInterval: byte; const HueCycleSpeed: byte; const Direction : TRainBowDirection);const  Lightness = 128;  Saturation = 255;  HueDeg: integer = 0;var  x,y: integer;  Hue: integer;  n, count: integer;  idx: integer = 0;  srcPixel: TBGRAPixel;begin  x := aBox.Left;   while x < aBox.Right do  begin    Hue := round(255/360 * ((huedeg + idx * hueinterval) mod 360));    HLStoRGB(Hue, Lightness, Saturation, srcPixel.Red, srcPixel.Green, srcPixel.Blue);     if x + HueInterval < aBitmap.Width     then count := HueInterval      else count := aBitmap.Width - x;     for n := 1 to count do    begin      for y := aBox.Top to aBox.Bottom-1        do aBitmap.SetPixel(x,y,srcpixel);    inc(x);    end;     case direction of     -1  : dec(idx);      0  : { nothing };      1  : inc(idx);    end;  end;   huedeg := (HueDeg + HueCycleSpeed) mod 360;end;  procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, 150); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);    Stars[i].Y := 100+Random(290);   // Stars[i].Z := Random(FFieldDepth);    Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i: Integer;begin  for i := 0 to High(Stars) do  begin     Stars[i].X := Stars[i].X - Stars[i].Speed ;   if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := BGRAVirtualScreen1.Width;      Stars[i].Y := 100+ Random(290);      Stars[i].Speed := Random * 7 + 1;    end;  end;end; procedure TForm1.FormCreate(Sender: TObject);begin     bitmap_font      := TBGRABitmap.Create('022_32.png');  //038.32     tx_scroll_bitmap := TBGRABitmap.Create(760,220); // 240     logo           := TBGRABitmap.Create('logo.png');     radians := PI / 180;     fonts_width  :=32;     fonts_height := 32;     sx := 800;  // start scroll pos x   right     charek :=' '; // void always !     offset := ' '; // the first char on s_text = ' ' = space     sine_height := 60; // sinus height     scroll_speed := 6;     pos_y := 104;     sine_counter :=0;  // move sinus movement     alfa :=0;     tx_id :=0;  // message line index      InitializeStarfield; // star field   // audio stream    MyAudio_File := 'astaroth.wav';    WavStream    := TMemoryStream.Create;  //  WavStream.LoadFromFile(MyAudio_File);  //  PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY); end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap); var i: Integer; StarPosition: TPoint; sttype : integer = 1; col: TBGRAPixel; begin     // font to display message !     Bitmap.FontName:='AmigaDigital';     Bitmap.FontHeight:=36;     bitmap.StretchPutImage(Rect(0,20,760,440),tx_scroll_bitmap,dmSet); // 440     drawSineScroll;  // sinustext scrolling    // Star Field  *----------------------------   for i := 0 to High(Stars) do   begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);       case  (sttype)  of      1: col := BGRA(50,50,50);      2: col := BGRA(75,75,75);      3: col := BGRA(100,100,100);      4: col := BGRA(125,125,125);      5: col := BGRA(150,150,150);      6: col := BGRA(175,175,175);      7: col := BGRA(200,200,200);      8: col := BGRA(254,254,254);      end;     Bitmap.Rectangle(rect(StarPosition.X, StarPosition.Y,StarPosition.X+2, StarPosition.Y+2),col,dmDrawWithTransparency);   end;   // Z-INDEX care !!   RenderHorizontalRainbow(Bitmap, Bounds(0,100, Bitmap.Width, 2), 8, 1*4, 1);   //   H rasters !   RenderHorizontalRainbow(Bitmap, Bounds(0,400, Bitmap.Width, 2), 8, 1*4, -1);   // Message display   Bitmap.TextOut(200,420,mess[tx_id],BGRA(alfa,alfa,alfa));   // logo display   bitmap.StretchPutImage(Rect(70,10,700,90),logo,dmDrawWithTra nsparency); end; procedure TForm1.Timer1Timer(Sender: TObject);begin   sine_counter := sine_counter +2.0;     inc(alfa);     if (alfa >= 255) then      begin      alfa :=0;      tx_id := tx_id +1;      if tx_id>12 then tx_id :=0;      end;      BGRAVirtualScreen1.RedrawBitmap;      UpdateStarfield;end; function TForm1.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l, m,r: Integer;  sinTable: array of single;begin  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   // 32 x 32 pixel bitmap font scroller !! nothing else   p := Ord(charek) ;   r :=  (p - Ord(offset))  div 10 ;   cx := (p - Ord(offset) -r * 10 )  * fonts_width;   cy := 0 + (r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !   SetLength(sinTable, fonts_width);  for l := 0 to fonts_width - 1 do sinTable[l] := Sin(-1 * (x + 0 + l+sine_counter) / 1.8 * radians); // sin table calculation + sine_counter   for l := 0 to fonts_width-1  do  begin     if (cx >= 0) and (x + l <= width) then    begin        m := pos_y + Round(sine_height * sinTable[l])  ;        tx_scroll_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy-1, cx + l + 2, cy + fonts_height), dmset);    end;   end;   Result := 1;end; procedure TForm1.drawSineScroll;var  last_char: Char;  x, i: Integer;  koda: Char;  xLimit: Integer;begin   dec(sx, scroll_speed);  x := sx;  xLimit := width + fonts_width;   for i := 1 to Length(s_text) do  begin    koda := s_text[i];    x := x + fonts_width;   if (x > -fonts_width) and (x < xLimit) then    begin    if drawFontChar(koda, x) = 0 then        Break;      last_char := koda;    end;  end;  if x < 0 then sx := xLimit; end; // Libere et vire tout , Free allprocedure TForm1.FormDestroy(Sender: TObject);begin  bitmap_font.free;  tx_scroll_bitmap.Free;  logo.free;end;end. ---------------------------------------------------------------------- Gigatron · 2024-06-05 14:56 Hi, This is another nice intro coded in 2 days !! The goal is The LightForce Cracktro on Amiga and exactly to replicate 3D Rotating Starfield ; https://www.youtube.com/watch?v=e7IOAEDNAe8 You can play and improve this code if you like demo, coz it's not optimized yet but running at full speed for me (the text effect gave me a headache !! )  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, BGRAGradientScanner,mmsystem; const   NUM_STARS = 3000; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    procedure FormDestroy(Sender: TObject);  private   public   MyAudio_File: AnsiString;   WavStream : TMemoryStream;   procedure drawSineScroll;   function drawFontChar(charek: Char; x: Integer): Integer;   end; var  Form1: TForm1;   sin1: Single;  tempx, tempy: Single;  sx, sy: Integer;  sz: Single;  strz: array[0..NUM_STARS * 3 - 1] of Single;  rotate_dir,r_timer : integer;   bitmap_font,tx_scroll_bitmap,logo,mess_bitmap : TBGRABitmap; // images  radians ,sine_counter: single;  fonts_width, fonts_height,pos_y: Integer;  sxx, tx : Integer;  alfa   : byte;  charek : char;  offset: Char;  sine_height,scroll_speed : Integer;  charSet: String;  s_text : string = 'GIGATRON !!! ON 04.06.2024 PRESENTS BGRA 3D ROTATING STARFIELD  GREETINGS TO :  THE LIGHTFORCE  -  CIRCULAR  -  LAINZ  -  TRON   -  JOSH  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          ';    message_1: Array[0..24] Of String =('                         ',                                 '     CODE : GIGATRON      ',                                 '                        ',                                 '  FONT : THE LIGHTFORCE   ',                                 '                        ',                                 'SFX: JOURNEY TROUGH GALAXY',                               '         MARK II          ',                               '                          ',                               '  DESIGN : TRONIC-SYSTEM  ',                               '                          ',                                 '   CONTACT GIGATRON     ',                                 '     BP : 3300 68000      ',                                 '      COLMAR FRANCE       ',                                 '                        ',                                 '                          ',                               '                          ',                               '                          ',                               '                          ',                               '                          ',                                 '                        ',                                 '                        ',                                 '                        ',                                 '                          ',                               '                          ',                               '                          ');    message_2: Array[0..24] Of String =('                         ',                               ' TECH INFOS  :            ',                               ' 320 LINES OF PASCAL CODE ',                                 ' BGRA COMPONENT           ',                                 ' 68000 LIKE TEXT FX CODE  ',                                 ' 2 DAYS OF WORK           ',                                 ' FULL 60 FPS            ',                                 ' AMD 8 CORES CPU          ',                               ' 64 GIGABYTE OF RAM       ',                               ' FREE PASACAL LAZARUS 3.2 ',                               ' FPC 3.2.2                ',                                 ' THX TO THE TEAM LAZARUS  ',                                 '     ----------         ',                                 '                        ',                                 '                        ',                                 '                          ',                               '                          ',                               '                          ',                               '                          ',                                 '                          ',                                 '                        ',                                 '                        ',                                 '                        ',                                 '                          ',                               '                          ');    mess_id,mess_chr : integer;  mess_timer : integer;  char_pos : integer;  mess_page : integer;   implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);var   i,j : integer;begin        Randomize;        j:= 0;        for i:=0 to NUM_STARS - 1 do        begin          j:= j + 1;          strz[j] := strz[j] + Round(random()* (900 div 2))-900 div 2 ;          strz[j] := strz[j] + Round(random()* (900 div 2))-900 div 2 ;          strz[j] := strz[j] + random()*1800;         end;      rotate_dir := 0;      r_timer := 0;     // audio stream     //MyAudio_File := 'jtg.wav';     //WavStream    := TMemoryStream.Create;     //WavStream.LoadFromFile(MyAudio_File);     //PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);      logo      := TBGRABitmap.Create('logo.png');      bitmap_font      := TBGRABitmap.Create('lffont2.png');     tx_scroll_bitmap := TBGRABitmap.Create(640,23); // 240     mess_bitmap := TBGRABitmap.Create(640,480); // 240      radians := PI / 180;     fonts_width  :=16;     fonts_height := 22;     sxx := 600;  // start scroll pos x   right     charek :=' '; // void always !     offset := ' '; // the first char on s_text = ' ' = space     sine_height := 0; // no-sinus height     scroll_speed := 1;     pos_y := 0;      //// Message     mess_timer :=0;     alfa    :=0;     mess_chr := 0;     mess_id :=0;  // message line index     char_pos :=0;     mess_page :=0;     alfa :=0; end; procedure TForm1.Timer1Timer(Sender: TObject);begin     inc(r_timer);     if(r_timer>300) then      begin      rotate_dir := 0+  Random(3);    r_timer :=0;      end;      if(rotate_dir=0) then sin1  += 0.00;     if(rotate_dir=1) then sin1  += 0.01;     if(rotate_dir=2) then sin1  -= 0.01;       inc(alfa);      if (alfa>=55) then alfa :=0;       BGRAVirtualScreen1.RedrawBitmap;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  // st    i,j : integer;    col: TBGRAPixel;    grad: TBGRAGradientScanner; begin      // font to display message !       mess_Bitmap.FontName:='AmigaDigital8';       mess_Bitmap.FontHeight:=36;       grad := TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(0,0,200+alfa),  gtLinear,PointF(0,0),PointF(0,35),True,True);    for i := 0 to NUM_STARS - 1 do    begin     j := i * 3;      sz := strz[j + 2];     if sz <= 0 then       strz[j + 2] := 1600       else      strz[j + 2] -= 10;     tempx := strz[j+0] * Cos(sin1) - strz[j + 1] * Sin(sin1);  tempy := strz[j+0] * Sin(sin1 + 0.2) +  strz[j + 1] * Cos(sin1);    // stz stars z pos depth!    if sz >= 1200 then                       Col := BGRA(50,50,50)    else if (sz >= 1000) and (sz < 1200) then  Col := BGRA(75, 75, 75)    else if (sz >= 800) and (sz < 1000) then Col := BGRA(100, 100, 100)    else if (sz >= 700) and (sz < 800) then  Col := BGRA(125, 125, 125)    else if (sz >= 600) and (sz < 700) then    Col := BGRA(150, 150, 150)    else if (sz >= 500) and (sz < 600) then    Col := BGRA(175, 175, 175)    else if (sz >= 400) and (sz < 500) then    Col := BGRA(200, 200, 200)    else if (sz >= 300) and (sz < 400) then    Col := BGRA(225, 225, 225)    else  Col := BGRA(255, 255, 255);     sx := Round((tempx * 500) / (sz + 250) + 640 div 2);    sy := Round((tempy * 500) / (sz + 250) + 480 div 2 );    sz -= 1;     if ((sx > 0) and (sx < 640)) and ((sy > 0) and (sy < 480)) then     Bitmap.Rectangle(Rect(sx, sy,sx+2, sy+2),col,dmSet);     // end stars !!  end;     logo.AlphaFill(alfa,0,1);     bitmap.StretchPut Image(Rect(25,-35,25+600,-35+200),logo,dmDrawWithTransparency); // Logo     bitmap.StretchPutImage(Rect(0,420,640+1000,420+48),tx_scroll_ bitmap,dmDrawWithTransparency); // scroll text simple      // Message display     inc(mess_timer,2);     if (mess_timer >= 16) then      begin       if mess_page=0 then mess_Bitmap.TextOut(mess_chr*20,char_p os*22,message_1[mess_id][mess_chr],grad);       if mess_page=1 then me ss_Bitmap.TextOut(mess_chr*20,char_pos*22,message_2[mess_id][mess_chr] ,grad);      mess_timer :=0;      mess_chr := mess_chr + 1;        if mess_chr>=27 then        begin         mess_chr :=0;         mess_id := mess_id +1 ;          char_pos := char_pos +1;         if mess_id>=18 then          begin           char_pos := 0;           mess_id := 0;           mess_Bitmap.FillRect(0,0,640,480,BGRA(255,192,0,0),dmSet);           mess_page := mess_page + 1;           if mess_page>=2 then mess_page:=0;         end;        end;      end;       Bitmap.StretchP utImage(Rect(20,90,740,90+520),mess_bitmap,dmDrawWithTransparency);    drawSineScroll;  // normal text scrolling  end;  function TForm1.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy, l,r: Integer;begin  if (x > width) and (x > 0) then  begin    Result := 0;    Exit;  end;   // 16 x 22 pixel bitmap font scroller !! nothing else      p := Ord(charek) ;      r :=  (p - Ord(offset))  div 10 ;      cx := (p - Ord(offset) -r * 10 )  * fonts_width;      cy := 0+(r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !   for l := 0 to fonts_width-1  do  begin      // if (cx >= 0) and (x <= width) and (x + fonts_width >= 0) then    if (cx >= 0) and (x + l <= width) then    begin          tx_scroll_bitmap.PutImagePart(x + l  , pos_y , bitmap_font, Rect(cx + l, cy-1, cx + l + 1, cy + fonts_height-1), dmSet); // 2  = m    end;  end;   Result := 1;end; procedure TForm1.drawSineScroll;var  last_char: Char;  x, i: Integer;  koda: Char;  xLimit: Integer;begin   dec(sxx, scroll_speed);  x := sxx;  xLimit := width + fonts_width;   for i := 1 to Length(s_text) do  begin    koda := s_text[i];    x := x + fonts_width-4;   if (x > -fonts_width) and (x < xLimit) then    begin      if drawFontChar(koda, x) = 0 then        Break;      last_char := koda;    end;  end;  if x < 0 then sxx := xLimit; end; // Libere et vire tout , Free allprocedure TForm1.FormDestroy(Sender: TObject);begin  bitmap_font.free;  tx_scroll_bitmap.Free;  logo.free;  mess_bitmap.free;end; end.