Recent

Author Topic: Demo Scene Bitmap Font Scroller  (Read 5575 times)

TRon

  • Hero Member
  • *****
  • Posts: 2739
Re: Demo Scene Bitmap Font Scroller
« Reply #30 on: May 18, 2024, 05:12:29 pm »
Code: Pascal  [Select][+][-]
  1. const
  2.   pixel_modulo = 8;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32
  3.  
Oops, wrong comment  :-[

It should read:
Code: Pascal  [Select][+][-]
  1. const
  2.   pixel_modulo = 8;  // make this a power of 2, thus 1, 2, 4, 8, 16 or 32
  3.  

Gigatron

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #31 on: May 28, 2024, 01:08:35 am »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, BGRATransform;
  10.  
  11. const
  12.  
  13.     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);
  14.  
  15.  
  16. var
  17.   CharImage: TBGRABitmap;
  18.   ScrollSpeed: integer = 3;
  19.   ScrollCounter: integer = 1;
  20.   CharWidth : integer = 15;
  21.   CharHeight :  integer = 22;
  22.   CharsPerLine : integer = 700;
  23.   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 !!!!!                                                                         ';
  24.  
  25.  
  26.  
  27. type
  28.   TWaveScanner = class(TBGRAAffineBitmapTransform)
  29.     Time: integer;
  30.     function GetOffset({%H-}X, Y: Single): Single;
  31.     { fast integer scanning (used by PutImage) }
  32.     procedure ScanMoveTo(X, Y: Integer); override;
  33.     { slow floating point scanning }
  34.     function ScanAt(X, Y: Single): TBGRAPixel; override;
  35.     constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean);
  36.   end;
  37.  
  38.   { TForm1 }
  39.  
  40.   TForm1 = class(TForm)
  41.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  42.     Timer1: TTimer;
  43.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure Timer1Timer(Sender: TObject);
  46.   private
  47.     copper,top_pic,bot_pic,f_pic: TBGRABitmap;
  48.     WaveScanner: TWaveScanner;
  49.     txt_scanner: TWaveScanner;
  50.   public
  51.   end;
  52.  
  53. var
  54.   Form1: TForm1;
  55.  
  56. implementation
  57.  
  58. {$R *.lfm}
  59.  
  60. { TForm1 }
  61.  
  62. procedure TForm1.FormCreate(Sender: TObject);
  63. begin
  64.   top_pic := TBGRABitmap.Create('giga.png');
  65.   copper  := TBGRABitmap.Create('copper.png');
  66.   bot_pic := TBGRABitmap.Create('giga.png');
  67.   WaveScanner := TWaveScanner.Create(bot_pic,false, false); // reflection bitmap
  68.   WaveScanner.scale(1,0.60);
  69.   WaveScanner.Translate(0,300);
  70.   WaveScanner.GlobalOpacity:=105;
  71.   bot_pic.VerticalFlip;
  72.  
  73.   CharImage := TBGRABitmap.Create('font.png');
  74.   f_pic := TBGRABitmap.Create(740,202); // important !
  75.   txt_scanner := TWaveScanner.Create(f_pic,false,false);
  76.   txt_scanner.Translate(-50,0);
  77.   txt_scanner.scale(2.0,1.50);
  78.   txt_scanner.GlobalOpacity:=235;
  79.  
  80. end;
  81.  
  82. // wobble or sinwave !!
  83. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  84. var
  85.    I,   Chr: Integer;
  86.    CharX, CharY: Integer;
  87.    ScrollOffset: Integer;
  88. begin
  89.  
  90.   Bitmap.PutImage(0,0,copper,dmSet);
  91.   Bitmap.PutImage(0,80,top_pic,dmFastBlend);
  92.   inc(WaveScanner.Time);
  93.   Bitmap.Fill(WaveScanner,dmFastBlend);
  94.  
  95.   inc(txt_scanner.Time,2);
  96.  
  97.   ScrollOffset :=  ScrollCounter ;
  98.  
  99.    for I := 0 to Length(ScrollText2) do
  100.     begin
  101.        Chr := Ord(ScrollText2[I]);
  102.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
  103.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  104.        f_pic.PutImagePart(CharX ,180+CharY , CharImage, Rect(0, 24*ascii[chr-32] , 15, 24*ascii[chr-32]+CharHeight), dmSet);
  105.  
  106.     end;
  107.  
  108.      ScrollCounter := ScrollCounter + ScrollSpeed;
  109.      if ScrollCounter >= CharWidth then
  110.    begin
  111.     ScrollCounter := ScrollCounter - CharWidth;
  112.     ScrollText2 := Copy(ScrollText2,2, Length(ScrollText2) - 1) + ScrollText2[1];
  113.    end;
  114.    // Scroll bitmap font text
  115.    Bitmap.Fill(txt_scanner,dmFastBlend);
  116.  
  117.  
  118. end;
  119.  
  120. procedure TForm1.Timer1Timer(Sender: TObject);
  121. begin
  122.   BGRAVirtualScreen1.RedrawBitmap;
  123. end;
  124.  
  125. { TWaveScanner }
  126.  
  127. function TWaveScanner.GetOffset(X, Y: Single): Single;
  128. begin
  129.   result := 10 * sin((Y + Time) * 30/5 * PI / 180);
  130. end;
  131.  
  132. procedure TWaveScanner.ScanMoveTo(X, Y: Integer);
  133. begin
  134.   inherited ScanMoveTo(X + round(GetOffset(X, Y)), Y);
  135. end;
  136.  
  137. function TWaveScanner.ScanAt(X, Y: Single): TBGRAPixel;
  138. begin
  139.   Result:=inherited ScanAt(X + GetOffset(X, Y), Y);
  140. end;
  141.  
  142. constructor TWaveScanner.Create(ASource: TBGRACustomBitmap;
  143.   ARepeatX,ARepeatY: boolean);
  144. begin
  145.   inherited Create(ASource, ARepeatX, ARepeatY);
  146.   Time := 0;
  147. end;
  148.  
  149. end.


 
« Last Edit: May 28, 2024, 04:37:45 am by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

lainz

  • Hero Member
  • *****
  • Posts: 4542
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: Demo Scene Bitmap Font Scroller
« Reply #32 on: May 28, 2024, 01:56:48 am »
In fact thanks to @circular, I only contribute in BGRAControls =)

Gigatron

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #33 on: May 29, 2024, 04:38:23 pm »
Hi
I would like to note here , BGRA is really awesome !!

The cube was missing in the demos I coded, it's done :=)

Sub Quantum Technology ! We are in a micro universe.

Gigatron

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #34 on: May 31, 2024, 03:02:25 am »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   BGRAVirtualScreen, BGRABitmap, BCTypes,BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Timer1: TTimer;
  18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure Timer1Timer(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.    procedure draw;
  25.    function drawFontChar(charek: Char; x: Integer): Integer;
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.   bitmap_font,dest_bitmap,copper  : TBGRABitmap;
  31.  
  32.   radians: single;
  33.   fonts_width, fonts_height,pos_y: Integer;
  34.   sx, tx: Integer;
  35.   charek : char;
  36.   offset: Char;
  37.   sine_height: Integer;
  38.   scroll_speed :integer;
  39.   sine_counter : single;
  40.  
  41.   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 ........          ';
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. { TForm1 }
  48.  
  49. procedure TForm1.FormCreate(Sender: TObject);
  50. begin
  51.        bitmap_font := TBGRABitmap.Create('022_32.png');
  52.        dest_bitmap := TBGRABitmap.Create(800,440);
  53.        copper      := TBGRABitmap.Create('copper.png');
  54.        radians := PI / 180;
  55.        fonts_width  :=32;
  56.        fonts_height := 32;
  57.        sx := 800;  // star scroll pos x
  58.        charek :=' '; // void always !
  59.        offset := ' '; // the first char on s_text = ' ' = space
  60.        sine_height := 100;
  61.        scroll_speed := 3;
  62.        pos_y := 200;
  63.        sine_counter :=0;
  64.  
  65. end;
  66.  
  67. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  68.  
  69. begin
  70.            bitmap.PutImage(0,10,dest_bitmap,dmset);
  71.            bitmap.PutImage(0,100,copper,dmset);
  72.            bitmap.PutImage(0,344,copper,dmset);
  73.            draw;  // scrolling
  74. end;
  75.  
  76. procedure TForm1.Timer1Timer(Sender: TObject);
  77. begin
  78.      BGRAVirtualScreen1.RedrawBitmap;
  79.      sine_counter := sine_counter +0.04;
  80. end;
  81.  
  82. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  83. var
  84.   p, cx, cy, l, m,r: Integer;
  85.   sinTable: array of single;
  86. begin
  87.   if (x > width) and (x > 0) then
  88.   begin
  89.     Result := 0;
  90.     Exit;
  91.   end;
  92.  
  93.    p := Ord(charek) ;
  94.    r :=  (p - Ord(offset))  div 10 ;
  95.    cx := (p - Ord(offset) -r * 10 )  * fonts_width;
  96.    cy := 0 + (r * fonts_height); // 0
  97.  
  98.   SetLength(sinTable, fonts_width);
  99.   for l := 0 to fonts_width - 1 do sinTable[l] := Sin(-1 * (x + tx + l) / 1.8 * radians); // sin table calculation
  100.  
  101.   for l := 0 to fonts_width-2  do
  102.   begin
  103.     if (cx >= 0) and (x + l <= width) then
  104.     begin
  105.         m := pos_y + Round(sine_height * sinTable[l])  ;
  106.         dest_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy, cx + l + 2, cy + fonts_height), dmset);
  107.     end;
  108.   end;
  109.  
  110.   Result := 1;
  111. end;
  112.  
  113. procedure TForm1.draw;
  114. var
  115.   last_char: Char;
  116.   x, i: Integer;
  117.   koda: Char;
  118.   xLimit: Integer;
  119. begin
  120.  
  121.   dec(sx, scroll_speed);
  122.   x := sx;
  123.   xLimit := width + fonts_width;
  124.  
  125.   for i := 1 to Length(s_text) do
  126.   begin
  127.     koda := s_text[i];
  128.     x := x + fonts_width;
  129.    if (x > -fonts_width) and (x < xLimit) then
  130.     begin
  131.       if drawFontChar(koda, x) = 0 then
  132.         Break;
  133.       last_char := koda;
  134.     end;
  135.   end;
  136.   if x < 0 then sx := xLimit;
  137.  
  138. end;
  139.  
  140. end.
  141.  

« Last Edit: May 31, 2024, 04:44:48 pm by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

Gigatron

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #35 on: May 31, 2024, 04:36:57 pm »
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  :P

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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, BGRAVirtualScreen, BGRABitmap, mmsystem,BGRABitmapTypes;
  9.  
  10. type
  11.   TStar = record        //  starfiled - !
  12.     X, Y, Z, Speed : Single;  // precision is now ok !
  13.    end;
  14.  
  15.   { TForm1 }
  16.  
  17.   TForm1 = class(TForm)
  18.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  19.     Timer1: TTimer;
  20.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure FormDestroy(Sender: TObject);
  23.     procedure Timer1Timer(Sender: TObject);
  24.   private
  25.     // star field :
  26.     Stars: array of TStar;
  27.     procedure InitializeStarfield;
  28.     procedure UpdateStarfield;
  29.  
  30.   public
  31.     MyAudio_File: AnsiString;
  32.     WavStream : TMemoryStream;
  33.    procedure draw;
  34.    function drawFontChar(charek: Char; x: Integer): Integer;
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.   bitmap_font,dest_bitmap,copper,logo : TBGRABitmap; // images
  40.   radians ,sine_counter: single;
  41.   fonts_width, fonts_height,pos_y: Integer;
  42.   sx, tx : Integer;
  43.   alfa   : byte;
  44.   charek : char;
  45.   offset: Char;
  46.   sine_height,scroll_speed : Integer;
  47.   mess: Array[0..12] Of String =('                          ',
  48.                                  '     CODE : GIGATRON      ',
  49.                                  '                          ',
  50.                                  '    FONT : ACKERLIGHT     ',
  51.                                  '                          ',
  52.                                  '  SFX  : ASTAROTH AMIGA   ',
  53.                                  '      JOCHEN HIPPEL       ',
  54.                                  '                          ',
  55.                                  '  DESIGN : TRONIC-SYSTEM  ',
  56.                                  '                          ',
  57.                                  '     CONTACT GIGATRON     ',
  58.                                  '     BP : 3300 68000      ',
  59.                                  '      COLMAR FRANCE       ');
  60.  
  61.   tx_id : integer;
  62.   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 ........          ';
  63.  
  64. implementation
  65.  
  66. {$R *.lfm}
  67.  
  68. { TForm1 }
  69.  
  70. procedure TForm1.InitializeStarfield;
  71. var
  72.   i: Integer;
  73. begin
  74.   SetLength(Stars, 150); // Nombre d'étoiles
  75.   for i := 0 to High(Stars) do
  76.   begin
  77.     Stars[i].X := Random(ClientWidth);
  78.     Stars[i].Y := 330+Random(BGRAVirtualScreen1.Height div 2)-230;
  79.    // Stars[i].Z := Random(FFieldDepth);
  80.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
  81.   end;
  82. end;
  83.  
  84. procedure TForm1.UpdateStarfield;
  85. var
  86.   i: Integer;
  87. begin
  88.   for i := 0 to High(Stars) do
  89.   begin
  90.      Stars[i].X := Stars[i].X - Stars[i].Speed ;
  91.    if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
  92.     begin
  93.       Stars[i].X := BGRAVirtualScreen1.Width;
  94.       Stars[i].Y := 330+ Random(BGRAVirtualScreen1.Height div 2)-230;
  95.       Stars[i].Speed := Random * 7 + 1;
  96.     end;
  97.   end;
  98. end;
  99.  
  100. procedure TForm1.FormCreate(Sender: TObject);
  101. begin
  102.      bitmap_font := TBGRABitmap.Create('038_32.png');  //022.32
  103.      dest_bitmap := TBGRABitmap.Create(760,440);
  104.      copper      := TBGRABitmap.Create('copper.png');
  105.      logo        := TBGRABitmap.Create('logo.png');
  106.      radians := PI / 180;
  107.      fonts_width  :=32;
  108.      fonts_height := 32;
  109.      sx := 800;  // start scroll pos x   right
  110.      charek :=' '; // void always !
  111.      offset := ' '; // the first char on s_text = ' ' = space
  112.      sine_height := 50; // sinus height
  113.      scroll_speed := 5;
  114.      pos_y := 100;
  115.      sine_counter :=0;  // move sinus movement
  116.      alfa :=0;
  117.      tx_id :=0;  // message line index
  118.  
  119.      InitializeStarfield; // star field
  120.  
  121.     // audio stream
  122.     MyAudio_File := 'astaroth.wav';
  123.     WavStream    := TMemoryStream.Create;
  124.   //  WavStream.LoadFromFile(MyAudio_File);
  125.   //  PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  126.  
  127. end;
  128.  
  129. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  130.  var
  131.  i: Integer;
  132.  StarPosition: TPoint;
  133.  sttype : integer = 7;
  134.  col: TBGRAPixel;
  135.  
  136. begin
  137.        // font to display message !
  138.        Bitmap.FontName:='AmigaDigital';
  139.        Bitmap.FontHeight:=36;
  140.  
  141.        bitmap.StretchPutImage(Rect(0,0,760,880),dest_bitmap,dmSet);
  142.        draw;  // text scrolling
  143.  
  144.    // Star Field  *----------------------------
  145.    for i := 0 to High(Stars) do
  146.    begin
  147.  
  148.     StarPosition.X := Round(Stars[i].X );
  149.     StarPosition.Y := Round(Stars[i].Y);
  150.     sttype := Round(Stars[i].Speed);
  151.  
  152.       case  (sttype)  of
  153.       1: col := BGRA(50,50,50);
  154.       2: col := BGRA(75,75,75);
  155.       3: col := BGRA(100,100,100);
  156.       4: col := BGRA(125,125,125);
  157.       5: col := BGRA(150,150,150);
  158.       6: col := BGRA(175,175,175);
  159.       7: col := BGRA(200,200,200);
  160.       8: col := BGRA(254,254,254);
  161.       end;
  162.      Bitmap.Rectangle(rect(StarPosition.X, StarPosition.Y,StarPosition.X+2, StarPosition.Y+2),col,dmDrawWithTransparency);
  163.    end;
  164.    // Z-INDEX care !!
  165.    bitmap.PutImage(0,100,copper,dmset); // cop rasters  1 & 2
  166.    bitmap.PutImage(0,352,copper,dmset);
  167.    // Message display
  168.    Bitmap.TextOut(200,400,mess[tx_id],BGRA(alfa,alfa,alfa));
  169.    // logo display
  170.    bitmap.StretchPutImage(Rect(70,10,700,90),logo,dmDrawWithTransparency);
  171.  
  172. end;
  173.  
  174. procedure TForm1.Timer1Timer(Sender: TObject);
  175. begin
  176.      BGRAVirtualScreen1.RedrawBitmap;
  177.      sine_counter := sine_counter +0.04;
  178.      inc(alfa);
  179.      if (alfa >= 255) then
  180.       begin
  181.       alfa :=0;
  182.       tx_id := tx_id +1;
  183.       if tx_id>12 then tx_id :=0;
  184.       end;
  185.      UpdateStarfield;
  186. end;
  187.  
  188. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  189. var
  190.   p, cx, cy, l, m,r: Integer;
  191.   sinTable: array of single;
  192. begin
  193.   if (x > width) and (x > 0) then
  194.   begin
  195.     Result := 0;
  196.     Exit;
  197.   end;
  198.    // 32 x 32 pixel bitmap font scroller !! nothing else
  199.    p := Ord(charek) ;
  200.    r :=  (p - Ord(offset))  div 10 ;
  201.    cx := (p - Ord(offset) -r * 10 )  * fonts_width;
  202.    cy := 0 + (r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !
  203.  
  204.   SetLength(sinTable, fonts_width);
  205.   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
  206.  
  207.   for l := 0 to fonts_width-2  do
  208.   begin
  209.     if (cx >= 0) and (x + l <= width) then
  210.     begin
  211.         m := pos_y + Round(sine_height * sinTable[l])  ;
  212.         dest_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy, cx + l + 2, cy + fonts_height), dmset);
  213.     end;
  214.     sine_counter := sine_counter +0.002; // +
  215.   end;
  216.  
  217.   Result := 1;
  218. end;
  219.  
  220. procedure TForm1.draw;
  221. var
  222.   last_char: Char;
  223.   x, i: Integer;
  224.   koda: Char;
  225.   xLimit: Integer;
  226. begin
  227.  
  228.   dec(sx, scroll_speed);
  229.   x := sx;
  230.   xLimit := width + fonts_width;
  231.  
  232.   for i := 1 to Length(s_text) do
  233.   begin
  234.     koda := s_text[i];
  235.     x := x + fonts_width;
  236.    if (x > -fonts_width) and (x < xLimit) then
  237.     begin
  238.       if drawFontChar(koda, x) = 0 then
  239.         Break;
  240.       last_char := koda;
  241.     end;
  242.   end;
  243.   if x < 0 then sx := xLimit;
  244.  
  245. end;
  246.  
  247. // Liber et vire tout , Free all
  248. procedure TForm1.FormDestroy(Sender: TObject);
  249. begin
  250.   bitmap_font.free;
  251.   dest_bitmap.Free;
  252.   copper.free;
  253.   logo.free;
  254. end;
  255.  
  256. end.
  257.  
  258.  

« Last Edit: June 01, 2024, 01:05:52 am by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

TRon

  • Hero Member
  • *****
  • Posts: 2739
Re: Demo Scene Bitmap Font Scroller
« Reply #36 on: June 01, 2024, 07:29:49 am »
Ok, if we combine all fx we have a nice Amiga Style intro.
Nice Gigatron !

For some additional (quick mock-up) motion:
Code: Pascal  [Select][+][-]
  1. ...
  2. uses
  3.   graphutil
  4. ...
  5. type
  6.   TRainBowDirection = -1..1;
  7.  
  8. procedure RenderHorizontalRainbow(const aBitmap: TBGRABitmap; const aBox: TRect; const HueInterval: byte; const HueCycleSpeed: byte; const Direction : TRainBowDirection);
  9. const
  10.   Lightness = 128;
  11.   Saturation = 255;
  12.   HueDeg: integer = 0;
  13. var
  14.   x,y: integer;
  15.   Hue: integer;
  16.   n, count: integer;
  17.   idx: integer = 0;
  18.   srcPixel: TBGRAPixel;
  19. begin
  20.   x := aBox.Left;
  21.  
  22.   while x < aBox.Right do
  23.   begin
  24.     Hue := round(255/360 * ((huedeg + idx * hueinterval) mod 360));
  25.     HLStoRGB(Hue, Lightness, Saturation, srcPixel.Red, srcPixel.Green, srcPixel.Blue);
  26.  
  27.     if x + HueInterval < aBitmap.Width
  28.      then count := HueInterval
  29.       else count := aBitmap.Width - x;
  30.  
  31.     for n := 1 to count do
  32.     begin
  33.       for y := aBox.Top to aBox.Bottom-1
  34.         do aBitmap.SetPixel(x,y,srcpixel);
  35.       inc(x);
  36.     end;
  37.  
  38.     case direction of
  39.      -1  : dec(idx);
  40.       0  : { nothing };
  41.       1  : inc(idx);
  42.     end;
  43.   end;
  44.  
  45.   huedeg := (HueDeg + HueCycleSpeed) mod 360;
  46. end;

and replace

Code: Pascal  [Select][+][-]
  1.   bitmap.PutImage(0,100,copper,dmset); // cop rasters  1 & 2
  2.   bitmap.PutImage(0,352,copper,dmset);
  3.  

with

Code: Pascal  [Select][+][-]
  1.   RenderHorizontalRainbow(Bitmap, Bounds(0,100, Bitmap.Width, 2), 6, 1*6, 1);
  2.   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

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #37 on: June 01, 2024, 04:09:26 pm »
Hi thank you @Tron;

For the issue you must just substract 1 to cy at :

Code: Pascal  [Select][+][-]
  1. 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][+][-]
  1. 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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, BGRAVirtualScreen,
  9.   BGRABitmap, mmsystem,BGRABitmapTypes,graphutil;
  10.  
  11. type
  12.   TStar = record        //  starfiled - !
  13.     X, Y, Z, Speed : single;
  14.   end;
  15.  
  16. type
  17.   TRainBowDirection = -1..1;
  18.  
  19.   { TForm1 }
  20.  
  21.   TForm1 = class(TForm)
  22.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  23.     Timer1: TTimer;
  24.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.     procedure Timer1Timer(Sender: TObject);
  28.   private
  29.     // star field :
  30.     Stars: array of TStar;
  31.     procedure InitializeStarfield;
  32.     procedure UpdateStarfield;
  33.  
  34.   public
  35.     MyAudio_File: AnsiString;
  36.     WavStream : TMemoryStream;
  37.    procedure drawSineScroll;
  38.    function drawFontChar(charek: Char; x: Integer): Integer;
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.   bitmap_font,tx_scroll_bitmap,logo : TBGRABitmap; // images
  44.   radians ,sine_counter: single;
  45.   fonts_width, fonts_height,pos_y: Integer;
  46.   sx, tx : Integer;
  47.   alfa   : byte;
  48.   charek : char;
  49.   offset: Char;
  50.   sine_height,scroll_speed : Integer;
  51.   mess: Array[0..12] Of String =('                          ',
  52.                                  '     CODE : GIGATRON      ',
  53.                                  '                          ',
  54.                                  '    FONT : ACKERLIGHT     ',
  55.                                  '                          ',
  56.                                  '  SFX  : ASTAROTH AMIGA   ',
  57.                                  '      JOCHEN HIPPEL       ',
  58.                                  '                          ',
  59.                                  '  DESIGN : TRONIC-SYSTEM  ',
  60.                                  '                          ',
  61.                                  '     CONTACT GIGATRON     ',
  62.                                  '     BP : 3300 68000      ',
  63.                                  '      COLMAR FRANCE       ');
  64.  
  65.   tx_id : integer;
  66.   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 ........          ';
  67.  
  68. implementation
  69.  
  70. {$R *.lfm}
  71.  
  72. { TForm1 }
  73.  
  74. // moving H-Rasters from @Tron , perfect work !
  75. procedure RenderHorizontalRainbow(const aBitmap: TBGRABitmap; const aBox: TRect; const HueInterval: byte; const HueCycleSpeed: byte; const Direction : TRainBowDirection);
  76. const
  77.   Lightness = 128;
  78.   Saturation = 255;
  79.   HueDeg: integer = 0;
  80. var
  81.   x,y: integer;
  82.   Hue: integer;
  83.   n, count: integer;
  84.   idx: integer = 0;
  85.   srcPixel: TBGRAPixel;
  86. begin
  87.   x := aBox.Left;
  88.  
  89.   while x < aBox.Right do
  90.   begin
  91.     Hue := round(255/360 * ((huedeg + idx * hueinterval) mod 360));
  92.     HLStoRGB(Hue, Lightness, Saturation, srcPixel.Red, srcPixel.Green, srcPixel.Blue);
  93.  
  94.     if x + HueInterval < aBitmap.Width
  95.      then count := HueInterval
  96.       else count := aBitmap.Width - x;
  97.  
  98.     for n := 1 to count do
  99.     begin
  100.       for y := aBox.Top to aBox.Bottom-1
  101.         do aBitmap.SetPixel(x,y,srcpixel);
  102.       inc(x);
  103.     end;
  104.  
  105.     case direction of
  106.      -1  : dec(idx);
  107.       0  : { nothing };
  108.       1  : inc(idx);
  109.     end;
  110.   end;
  111.  
  112.   huedeg := (HueDeg + HueCycleSpeed) mod 360;
  113. end;
  114.  
  115.  
  116. procedure TForm1.InitializeStarfield;
  117. var
  118.   i: Integer;
  119. begin
  120.   SetLength(Stars, 150); // Nombre d'étoiles
  121.   for i := 0 to High(Stars) do
  122.   begin
  123.     Stars[i].X := Random(ClientWidth);
  124.     Stars[i].Y := 100+Random(290);
  125.    // Stars[i].Z := Random(FFieldDepth);
  126.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
  127.   end;
  128. end;
  129.  
  130. procedure TForm1.UpdateStarfield;
  131. var
  132.   i: Integer;
  133. begin
  134.   for i := 0 to High(Stars) do
  135.   begin
  136.      Stars[i].X := Stars[i].X - Stars[i].Speed ;
  137.    if Stars[i].X <= 0 then // Réinitialiser la position si l'étoile sort de l'écran
  138.     begin
  139.       Stars[i].X := BGRAVirtualScreen1.Width;
  140.       Stars[i].Y := 100+ Random(290);
  141.       Stars[i].Speed := Random * 7 + 1;
  142.     end;
  143.   end;
  144. end;
  145.  
  146. procedure TForm1.FormCreate(Sender: TObject);
  147. begin
  148.      bitmap_font      := TBGRABitmap.Create('022_32.png');  //038.32
  149.      tx_scroll_bitmap := TBGRABitmap.Create(760,220); // 240
  150.      logo             := TBGRABitmap.Create('logo.png');
  151.      radians := PI / 180;
  152.      fonts_width  :=32;
  153.      fonts_height := 32;
  154.      sx := 800;  // start scroll pos x   right
  155.      charek :=' '; // void always !
  156.      offset := ' '; // the first char on s_text = ' ' = space
  157.      sine_height := 60; // sinus height
  158.      scroll_speed := 6;
  159.      pos_y := 104;
  160.      sine_counter :=0;  // move sinus movement
  161.      alfa :=0;
  162.      tx_id :=0;  // message line index
  163.  
  164.      InitializeStarfield; // star field
  165.  
  166.     // audio stream
  167.     MyAudio_File := 'astaroth.wav';
  168.     WavStream    := TMemoryStream.Create;
  169.   //  WavStream.LoadFromFile(MyAudio_File);
  170.   //  PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  171.  
  172. end;
  173.  
  174. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  175.  var
  176.  i: Integer;
  177.  StarPosition: TPoint;
  178.  sttype : integer = 1;
  179.  col: TBGRAPixel;
  180.  
  181. begin
  182.      // font to display message !
  183.      Bitmap.FontName:='AmigaDigital';
  184.      Bitmap.FontHeight:=36;
  185.      bitmap.StretchPutImage(Rect(0,20,760,440),tx_scroll_bitmap,dmSet); // 440
  186.      drawSineScroll;  // sinustext scrolling
  187.  
  188.    // Star Field  *----------------------------
  189.    for i := 0 to High(Stars) do
  190.    begin
  191.  
  192.     StarPosition.X := Round(Stars[i].X );
  193.     StarPosition.Y := Round(Stars[i].Y);
  194.     sttype := Round(Stars[i].Speed);
  195.  
  196.       case  (sttype)  of
  197.       1: col := BGRA(50,50,50);
  198.       2: col := BGRA(75,75,75);
  199.       3: col := BGRA(100,100,100);
  200.       4: col := BGRA(125,125,125);
  201.       5: col := BGRA(150,150,150);
  202.       6: col := BGRA(175,175,175);
  203.       7: col := BGRA(200,200,200);
  204.       8: col := BGRA(254,254,254);
  205.       end;
  206.      Bitmap.Rectangle(rect(StarPosition.X, StarPosition.Y,StarPosition.X+2, StarPosition.Y+2),col,dmDrawWithTransparency);
  207.    end;
  208.    // Z-INDEX care !!
  209.    RenderHorizontalRainbow(Bitmap, Bounds(0,100, Bitmap.Width, 2), 8, 1*4, 1);   //   H rasters !
  210.    RenderHorizontalRainbow(Bitmap, Bounds(0,400, Bitmap.Width, 2), 8, 1*4, -1);
  211.    // Message display
  212.    Bitmap.TextOut(200,420,mess[tx_id],BGRA(alfa,alfa,alfa));
  213.    // logo display
  214.    bitmap.StretchPutImage(Rect(70,10,700,90),logo,dmDrawWithTransparency);
  215.  
  216. end;
  217.  
  218. procedure TForm1.Timer1Timer(Sender: TObject);
  219. begin
  220.      sine_counter := sine_counter +2.0;
  221.      inc(alfa);
  222.      if (alfa >= 255) then
  223.       begin
  224.       alfa :=0;
  225.       tx_id := tx_id +1;
  226.       if tx_id>12 then tx_id :=0;
  227.       end;
  228.       BGRAVirtualScreen1.RedrawBitmap;
  229.       UpdateStarfield;
  230. end;
  231.  
  232. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  233. var
  234.   p, cx, cy, l, m,r: Integer;
  235.   sinTable: array of single;
  236. begin
  237.   if (x > width) and (x > 0) then
  238.   begin
  239.     Result := 0;
  240.     Exit;
  241.   end;
  242.    // 32 x 32 pixel bitmap font scroller !! nothing else
  243.    p := Ord(charek) ;
  244.    r :=  (p - Ord(offset))  div 10 ;
  245.    cx := (p - Ord(offset) -r * 10 )  * fonts_width;
  246.    cy := 0 + (r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !
  247.  
  248.   SetLength(sinTable, fonts_width);
  249.   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
  250.  
  251.   for l := 0 to fonts_width-1  do
  252.   begin
  253.  
  254.     if (cx >= 0) and (x + l <= width) then
  255.     begin
  256.         m := pos_y + Round(sine_height * sinTable[l])  ;
  257.         tx_scroll_bitmap.PutImagePart(x + l  , m , bitmap_font, Rect(cx + l, cy-1, cx + l + 2, cy + fonts_height), dmset);
  258.     end;
  259.  
  260.   end;
  261.  
  262.   Result := 1;
  263. end;
  264.  
  265. procedure TForm1.drawSineScroll;
  266. var
  267.   last_char: Char;
  268.   x, i: Integer;
  269.   koda: Char;
  270.   xLimit: Integer;
  271. begin
  272.  
  273.   dec(sx, scroll_speed);
  274.   x := sx;
  275.   xLimit := width + fonts_width;
  276.  
  277.   for i := 1 to Length(s_text) do
  278.   begin
  279.     koda := s_text[i];
  280.     x := x + fonts_width;
  281.    if (x > -fonts_width) and (x < xLimit) then
  282.     begin
  283.       if drawFontChar(koda, x) = 0 then
  284.         Break;
  285.       last_char := koda;
  286.     end;
  287.   end;
  288.   if x < 0 then sx := xLimit;
  289.  
  290. end;
  291.  
  292. // Libere et vire tout , Free all
  293. procedure TForm1.FormDestroy(Sender: TObject);
  294. begin
  295.   bitmap_font.free;
  296.   tx_scroll_bitmap.Free;
  297.   logo.free;
  298. end;
  299. end.
  300.  
« Last Edit: June 02, 2024, 07:14:10 am by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

Gigatron

  • Jr. Member
  • **
  • Posts: 74
  • Amiga Rulez !!
Re: Demo Scene Bitmap Font Scroller
« Reply #38 on: June 05, 2024, 04:56:50 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGRAVirtualScreen, BGRABitmap,BGRABitmapTypes, BGRAGradientScanner,mmsystem;
  10.  
  11. const
  12.    NUM_STARS = 3000;
  13.  
  14. type
  15.  
  16.   { TForm1 }
  17.  
  18.   TForm1 = class(TForm)
  19.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  20.     Timer1: TTimer;
  21.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Timer1Timer(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.   private
  26.  
  27.   public
  28.    MyAudio_File: AnsiString;
  29.    WavStream : TMemoryStream;
  30.    procedure drawSineScroll;
  31.    function drawFontChar(charek: Char; x: Integer): Integer;
  32.    end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37.   sin1: Single;
  38.   tempx, tempy: Single;
  39.   sx, sy: Integer;
  40.   sz: Single;
  41.   strz: array[0..NUM_STARS * 3 - 1] of Single;
  42.   rotate_dir,r_timer : integer;
  43.  
  44.   bitmap_font,tx_scroll_bitmap,logo,mess_bitmap : TBGRABitmap; // images
  45.   radians ,sine_counter: single;
  46.   fonts_width, fonts_height,pos_y: Integer;
  47.   sxx, tx : Integer;
  48.   alfa   : byte;
  49.   charek : char;
  50.   offset: Char;
  51.   sine_height,scroll_speed : Integer;
  52.   charSet: String;
  53.   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 ........          ';
  54.  
  55.    message_1: Array[0..24] Of String =('                         ',
  56.                                  '     CODE : GIGATRON      ',
  57.                                  '                          ',
  58.                                  '  FONT : THE LIGHTFORCE   ',
  59.                                  '                          ',
  60.                                  'SFX: JOURNEY TROUGH GALAXY',
  61.                                  '         MARK II          ',
  62.                                  '                          ',
  63.                                  '  DESIGN : TRONIC-SYSTEM  ',
  64.                                  '                          ',
  65.                                  '     CONTACT GIGATRON     ',
  66.                                  '     BP : 3300 68000      ',
  67.                                  '      COLMAR FRANCE       ',
  68.                                  '                          ',
  69.                                  '                          ',
  70.                                  '                          ',
  71.                                  '                          ',
  72.                                  '                          ',
  73.                                  '                          ',
  74.                                  '                          ',
  75.                                  '                          ',
  76.                                  '                          ',
  77.                                  '                          ',
  78.                                  '                          ',
  79.                                  '                          ');
  80.  
  81.    message_2: Array[0..24] Of String =('                         ',
  82.                                  ' TECH INFOS  :            ',
  83.                                  ' 320 LINES OF PASCAL CODE ',
  84.                                  ' BGRA COMPONENT           ',
  85.                                  ' 68000 LIKE TEXT FX CODE  ',
  86.                                  ' 2 DAYS OF WORK           ',
  87.                                  ' FULL 60 FPS              ',
  88.                                  ' AMD 8 CORES CPU          ',
  89.                                  ' 64 GIGABYTE OF RAM       ',
  90.                                  ' FREE PASACAL LAZARUS 3.2 ',
  91.                                  ' FPC 3.2.2                ',
  92.                                  ' THX TO THE TEAM LAZARUS  ',
  93.                                  '       ----------         ',
  94.                                  '                          ',
  95.                                  '                          ',
  96.                                  '                          ',
  97.                                  '                          ',
  98.                                  '                          ',
  99.                                  '                          ',
  100.                                  '                          ',
  101.                                  '                          ',
  102.                                  '                          ',
  103.                                  '                          ',
  104.                                  '                          ',
  105.                                  '                          ');
  106.  
  107.  
  108.   mess_id,mess_chr : integer;
  109.   mess_timer : integer;
  110.   char_pos : integer;
  111.   mess_page : integer;
  112.  
  113.  
  114.  
  115. implementation
  116.  
  117. {$R *.lfm}
  118.  
  119. { TForm1 }
  120.  
  121. procedure TForm1.FormCreate(Sender: TObject);
  122. var
  123.    i,j : integer;
  124. begin
  125.         Randomize;
  126.         j:= 0;
  127.         for i:=0 to NUM_STARS - 1 do
  128.         begin
  129.           j:= j + 1;
  130.           strz[j] := strz[j] + Round(random()* (900 div 2))-900 div 2 ;
  131.           strz[j] := strz[j] + Round(random()* (900 div 2))-900 div 2 ;
  132.           strz[j] := strz[j] + random()*1800;
  133.  
  134.         end;
  135.       rotate_dir := 0;
  136.       r_timer := 0;
  137.  
  138.     // audio stream
  139.      //MyAudio_File := 'jtg.wav';
  140.      //WavStream    := TMemoryStream.Create;
  141.      //WavStream.LoadFromFile(MyAudio_File);
  142.      //PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  143.  
  144.      logo      := TBGRABitmap.Create('logo.png');
  145.  
  146.      bitmap_font      := TBGRABitmap.Create('lffont2.png');
  147.      tx_scroll_bitmap := TBGRABitmap.Create(640,23); // 240
  148.      mess_bitmap := TBGRABitmap.Create(640,480); // 240
  149.  
  150.      radians := PI / 180;
  151.      fonts_width  :=16;
  152.      fonts_height := 22;
  153.      sxx := 600;  // start scroll pos x   right
  154.      charek :=' '; // void always !
  155.      offset := ' '; // the first char on s_text = ' ' = space
  156.      sine_height := 0; // no-sinus height
  157.      scroll_speed := 1;
  158.      pos_y := 0;
  159.  
  160.      //// Message
  161.      mess_timer :=0;
  162.      alfa    :=0;
  163.      mess_chr := 0;
  164.      mess_id :=0;  // message line index
  165.      char_pos :=0;
  166.      mess_page :=0;
  167.      alfa :=0;
  168.  
  169. end;
  170.  
  171. procedure TForm1.Timer1Timer(Sender: TObject);
  172. begin
  173.      inc(r_timer);
  174.      if(r_timer>300) then
  175.       begin
  176.       rotate_dir := 0+  Random(3);
  177.       r_timer :=0;
  178.       end;
  179.  
  180.      if(rotate_dir=0) then sin1  += 0.00;
  181.      if(rotate_dir=1) then sin1  += 0.01;
  182.      if(rotate_dir=2) then sin1  -= 0.01;
  183.  
  184.       inc(alfa);
  185.       if (alfa>=55) then alfa :=0;
  186.  
  187.  
  188.      BGRAVirtualScreen1.RedrawBitmap;
  189. end;
  190.  
  191. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  192. var
  193.   // st
  194.     i,j : integer;
  195.     col: TBGRAPixel;
  196.     grad: TBGRAGradientScanner;
  197.  
  198. begin
  199.       // font to display message !
  200.        mess_Bitmap.FontName:='AmigaDigital8';
  201.        mess_Bitmap.FontHeight:=36;
  202.        grad := TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(0,0,200+alfa),  gtLinear,PointF(0,0),PointF(0,35),True,True);
  203.  
  204.    for i := 0 to NUM_STARS - 1 do
  205.     begin
  206.      j := i * 3;
  207.  
  208.      sz := strz[j + 2];
  209.      if sz <= 0 then
  210.        strz[j + 2] := 1600
  211.        else
  212.       strz[j + 2] -= 10;
  213.  
  214.     tempx := strz[j+0] * Cos(sin1) - strz[j + 1] * Sin(sin1);
  215.     tempy := strz[j+0] * Sin(sin1 + 0.2) +  strz[j + 1] * Cos(sin1);
  216.     // stz stars z pos depth!
  217.     if sz >= 1200 then                         Col := BGRA(50,50,50)
  218.     else if (sz >= 1000) and (sz < 1200) then  Col := BGRA(75, 75, 75)
  219.     else if (sz >= 800) and (sz < 1000) then   Col := BGRA(100, 100, 100)
  220.     else if (sz >= 700) and (sz < 800) then    Col := BGRA(125, 125, 125)
  221.     else if (sz >= 600) and (sz < 700) then    Col := BGRA(150, 150, 150)
  222.     else if (sz >= 500) and (sz < 600) then    Col := BGRA(175, 175, 175)
  223.     else if (sz >= 400) and (sz < 500) then    Col := BGRA(200, 200, 200)
  224.     else if (sz >= 300) and (sz < 400) then    Col := BGRA(225, 225, 225)
  225.     else  Col := BGRA(255, 255, 255);
  226.  
  227.     sx := Round((tempx * 500) / (sz + 250) + 640 div 2);
  228.     sy := Round((tempy * 500) / (sz + 250) + 480 div 2 );
  229.     sz -= 1;
  230.  
  231.     if ((sx > 0) and (sx < 640)) and ((sy > 0) and (sy < 480)) then
  232.      Bitmap.Rectangle(Rect(sx, sy,sx+2, sy+2),col,dmSet);
  233.  
  234.     // end stars !!
  235.   end;
  236.      logo.AlphaFill(alfa,0,1);
  237.      bitmap.StretchPutImage(Rect(25,-35,25+600,-35+200),logo,dmDrawWithTransparency); // Logo
  238.      bitmap.StretchPutImage(Rect(0,420,640+1000,420+48),tx_scroll_bitmap,dmDrawWithTransparency); // scroll text simple
  239.  
  240.      // Message display
  241.      inc(mess_timer,2);
  242.      if (mess_timer >= 16) then
  243.       begin
  244.        if mess_page=0 then mess_Bitmap.TextOut(mess_chr*20,char_pos*22,message_1[mess_id][mess_chr],grad);
  245.        if mess_page=1 then mess_Bitmap.TextOut(mess_chr*20,char_pos*22,message_2[mess_id][mess_chr],grad);
  246.       mess_timer :=0;
  247.       mess_chr := mess_chr + 1;
  248.  
  249.        if mess_chr>=27 then
  250.         begin
  251.          mess_chr :=0;
  252.          mess_id := mess_id +1 ;
  253.           char_pos := char_pos +1;
  254.          if mess_id>=18 then
  255.           begin
  256.            char_pos := 0;
  257.            mess_id := 0;
  258.            mess_Bitmap.FillRect(0,0,640,480,BGRA(255,192,0,0),dmSet);
  259.            mess_page := mess_page + 1;
  260.            if mess_page>=2 then mess_page:=0;
  261.          end;
  262.         end;
  263.       end;
  264.  
  265.       Bitmap.StretchPutImage(Rect(20,90,740,90+520),mess_bitmap,dmDrawWithTransparency);
  266.       drawSineScroll;  // normal text scrolling
  267.  
  268.  
  269. end;
  270.  
  271.  
  272. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  273. var
  274.   p, cx, cy, l,r: Integer;
  275. begin
  276.   if (x > width) and (x > 0) then
  277.   begin
  278.     Result := 0;
  279.     Exit;
  280.   end;
  281.    // 16 x 22 pixel bitmap font scroller !! nothing else
  282.       p := Ord(charek) ;
  283.       r :=  (p - Ord(offset))  div 10 ;
  284.       cx := (p - Ord(offset) -r * 10 )  * fonts_width;
  285.       cy := 0+(r * fonts_height); // 0 if bitmap font pix is aligned or cy + fonts_height !
  286.  
  287.   for l := 0 to fonts_width-1  do
  288.   begin
  289.       // if (cx >= 0) and (x <= width) and (x + fonts_width >= 0) then
  290.     if (cx >= 0) and (x + l <= width) then
  291.     begin
  292.           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
  293.     end;
  294.   end;
  295.  
  296.   Result := 1;
  297. end;
  298.  
  299. procedure TForm1.drawSineScroll;
  300. var
  301.   last_char: Char;
  302.   x, i: Integer;
  303.   koda: Char;
  304.   xLimit: Integer;
  305. begin
  306.  
  307.   dec(sxx, scroll_speed);
  308.   x := sxx;
  309.   xLimit := width + fonts_width;
  310.  
  311.   for i := 1 to Length(s_text) do
  312.   begin
  313.     koda := s_text[i];
  314.     x := x + fonts_width-4;
  315.    if (x > -fonts_width) and (x < xLimit) then
  316.     begin
  317.       if drawFontChar(koda, x) = 0 then
  318.         Break;
  319.       last_char := koda;
  320.     end;
  321.   end;
  322.   if x < 0 then sxx := xLimit;
  323.  
  324. end;
  325.  
  326. // Libere et vire tout , Free all
  327. procedure TForm1.FormDestroy(Sender: TObject);
  328. begin
  329.   bitmap_font.free;
  330.   tx_scroll_bitmap.Free;
  331.   logo.free;
  332.   mess_bitmap.free;
  333. end;
  334.  
  335. end.
  336.  

« Last Edit: June 05, 2024, 05:04:51 pm by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

 

TinyPortal © 2005-2018