Demo Scene Bitmap Font Scroller

[TRon]

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]

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.

 

[lainz]

In fact thanks to @circular, I only contribute in BGRAControls =)

[Gigatron]

Hi
I would like to note here , BGRA is really awesome !!

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

[Gigatron]

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.  

[Gigatron]

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

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.  

[TRon]

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]

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.  

[Gigatron]

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.