Forum > Graphics

Demo Scene Bitmap Font Scroller

(1/8) > >>

Gigatron:
Hi L&G,

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

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

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


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);  cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#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','#eeeeff','#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',                                            '#000055','#000044','#000033','#000022','#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','#eeeeff','#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','#000055','#000044',                                            '#000033','#000022','#000011','#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','#eeeeff','#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','#000055','#000044','#000033',                                            '#000022','#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','#eeeeff','#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'); 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:
That's clever to use the font as mask, so you can do any gradient in it.  :)

KodeZwerg:

--- Quote from: circular on April 24, 2024, 06:53:32 pm ---That's clever to use the font as mask, so you can do any gradient in it.  :)
--- End quote ---
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 :D
So a new way of doing such is pretty welcomed  O:-)
(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:

--- Quote from: circular on April 24, 2024, 06:53:32 pm ---That's clever to use the font as mask, so you can do any gradient in it.  :)

--- End quote ---
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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:

--- Quote from: circular on April 24, 2024, 06:53:32 pm ---That's clever to use the font as mask, so you can do any gradient in it.  :)

--- End quote ---
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...

Navigation

[0] Message Index

[#] Next page

Go to full version