Rotating Text

[Gigatron]

Hi,

Here is a simple animated rotating text it use Bgra canvas2d functions like javascript , the code is not yet optimized i will try to
improve it.

Have fun;

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

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
6.   BGRABitmap, BGRABitmapTypes, BGRACanvas2D,mmsystem;
7. type
8.   { TForm1 }
9.   TForm1 = class(TForm)
10.     Timer1: TTimer;
11.     procedure FormCreate(Sender: TObject);
12.     procedure FormDestroy(Sender: TObject);
13.     procedure FormResize(Sender: TObject);
14.     procedure Timer1Timer(Sender: TObject);
15.   private
16.     FBuffer: TBGRABitmap;
17.     txt: string;
18.     CIndex: Integer;
19.     RotAngle: Single;
20.     LastCharTm: QWord;
21.     procedure RenderToBuffer;
22.   public
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.  
28. implementation
29.  
30. {$R *.lfm}
31.  
32. { TForm1 }
33.  
34. procedure TForm1.FormCreate(Sender: TObject);
35. const sflag = snd_Loop or snd_Async;
36. begin
37.   Caption := 'Rotating TEXT V1.0 Gigatron';
38.   txt := 'LAZARUS FPC 2025 ';
39.   CIndex := 0;
40.   RotAngle := 0;
41.   LastCharTm := 0;
42.   FBuffer := TBGRABitmap.Create(Width, Height);
43.   playsound('mbis.wav',0, sflag);//mono
44. end;
45.  
46. procedure TForm1.FormDestroy(Sender: TObject);
47. begin
48.   FBuffer.Free;
49. end;
50.  
51. procedure TForm1.FormResize(Sender: TObject);
52. begin
53.   if Assigned(FBuffer) then
54.   begin
55.     FBuffer.SetSize(Width, Height);
56.   end;
57. end;
58.  
59. procedure TForm1.RenderToBuffer;
60. var
61.   centerX, centerY, radius: Integer;
62.   i: Integer;
63.   charAngle: Single;
64.   x, y: Integer;
65.   canvas2D: TBGRACanvas2D;
66. begin
67.  
68.   FBuffer.Fill(BGRA($77, $77, $77));
69.   centerX := Width div 2;
70.   centerY := Height div 2;
71.   radius := 220;
72.   canvas2D := FBuffer.Canvas2D;
73.   // canvas operation delta force !
74.   for i := 0 to CIndex - 1 do
75.   begin
76.     charAngle := (i * 2 * Pi / Length(txt)) + RotAngle;
77.  
78.     x := centerX + Round(radius * Cos(charAngle));
79.     y := centerY + Round(radius * Sin(charAngle));
80.  
81.     canvas2D.save;
82.     canvas2D.translate(x, y);
83.     canvas2D.rotate(charAngle + Pi/2);
84.     canvas2D.fillStyle(BGRA($ee,$ee,$ee));
85.     canvas2D.font := 'bold 64px Arial';
86.     canvas2D.fillText(txt[i+1], 0, 0);
87.     canvas2D.fillStyle(BGRA($ff,$00,$00));
88.     canvas2D.fillText(txt[i+1], 8, 0);
89.     canvas2D.restore;
90.   end;
91.  
92.   RotAngle := RotAngle + 0.04;
93. end;
94.  
95. procedure TForm1.Timer1Timer(Sender: TObject);
96. var
97.   cTime: QWord;
98. begin
99.   //cTime := GetTickCount64;
100.   //if (CIndex < Length(txt)) and (cTime - LastCharTm > 150) then  // typewrite time
101.   //begin
102.   //  Inc(CIndex);
103.   //  LastCharTm := cTime;
104.   //end;
105.   Cindex := Length(txt);
106.   RenderToBuffer;
107.   FBuffer.Draw(Canvas, 0, 0, true);
108. end;
109. end.

[Gigatron]

The same text effect code but much more faster and smooth without canvas2d.
Used BGRA bitmap virtualscreen;

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

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
6.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen, mmsystem;
7. type
8.   { TForm1 }
9.   TForm1 = class(TForm)
10.     BGRAVirtualScreen1: TBGRAVirtualScreen;
11.     Timer1: TTimer;
12.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
13.     procedure FormCreate(Sender: TObject);
14.     procedure FormResize(Sender: TObject);
15.     procedure Timer1Timer(Sender: TObject);
16.   private
17.     txt: string;
18.     CIndex: Integer;
19.     RotAngle: Single;
20.     LastCharTm: QWord;
21.   public
22.   end;
23. var
24.   Form1: TForm1;
25. implementation
26. {$R *.lfm}
27. { TForm1 }
28. procedure TForm1.FormCreate(Sender: TObject);
29. const sflag = snd_Loop or snd_Async;
30. begin
31.   Caption := 'Rotating TEXT V1.0 Gigatron';
32.   txt := 'LAZARUS FPC 2025 ';
33.   CIndex := 0;
34.   RotAngle := 0;
35.   LastCharTm := 0;
36.   BGRAVirtualScreen1.Align := alClient;
37.   playsound('mbis.wav', 0, sflag);//mono
38. end;
39.  
40. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
41. var
42.   centerX, centerY, radius: Integer;
43.   i: Integer;
44.   charAngle: Single;
45.   x, y: Integer;
46. begin
47.  
48.   Bitmap.Fill(BGRA($77, $77, $77));
49.  
50.   centerX := BGRAVirtualScreen1.Width div 2;
51.   centerY := BGRAVirtualScreen1.Height div 2;
52.   radius := 220;
53.  
54.   bitmap.FontFullHeight := 72;
55.   bitmap.FontName :='Arial';
56.   bitmap.FontStyle := [fsBold];
57.  
58.   // BGRA operation delta force !
59.   for i := 0 to CIndex - 1 do
60.   begin
61.     charAngle := (i * 2 * Pi / Length(txt)) + RotAngle;
62.     x := centerX + Round(radius * Cos(charAngle));
63.     y := centerY + Round(radius * Sin(charAngle));
64.  
65.     bitmap.TextOutAngle(x,y-30, Round(charAngle),txt[i+1],BGRA(255,255,255));
66.     bitmap.TextOutAngle(x+4,y-30,Round(charAngle),txt[i+1],BGRA(255,0,0));
67.  
68.   end;
69. end;
70.  
71. procedure TForm1.FormResize(Sender: TObject);
72. begin
73.   BGRAVirtualScreen1.Invalidate;
74. end;
75.  
76. procedure TForm1.Timer1Timer(Sender: TObject);
77. var
78.   cTime: QWord;
79. begin
80.   cTime := GetTickCount64;
81.   if (CIndex < Length(txt)) and (cTime - LastCharTm > 150) then  // typewrite time
82.   begin
83.     Inc(CIndex);
84.     LastCharTm := cTime;
85.   end;
86.  
87.   RotAngle := RotAngle + 0.02;
88.   BGRAVirtualScreen1.RedrawBitmap;
89. end;
90. end.

[d2010]

Plase you do not calculate reiterator sine and cosine.
You make static array of single !! not double.
1)you add menuFile.-> File->Open
2)you add menufile->File->Save, as Csv File
3)You add submenu "Edit->Calculatorr SharpCalculator"

Code: [Select]

Type TFomat10FileRotate=
     cmdX:shortstring;
     cmdy:shortstring;
     FontFullHeight : integer;
     FontName :array[0..31] of char
     FontStyle : word
     cmdxyCount:integer;
     Bufx:array[word] of single
     Bufy:array[word] of single;
  End;
Var SharpCalc:TFomat10FileRotate;
Yom put outside TForm the SharpCalc;
You must be sure yon have only one, one, one , one variabile
SharpCalc on entire MyProject.lpi

Always You save All sine and cosine, after after the full-calc, You save  onto-array
SharpCalc:array[word] of integer;

Code: [Select]

Var SharpCalc:TFomat10FileRotate;
Implementation


[Gigatron]

Hi ,

@d2010 certainly answered on another post.

So, this time using rotating text to make Rotating Scroll Text , if you have long text.

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

1. unit Unit1;
2. {$mode objfpc}{$H+}
3.  
4. interface
5.  
6. uses
7.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
8.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen, mmsystem;
9.  
10. type   // structure chr !
11.   TChr = record
12.     Char: Char;
13.     Angle: Single;
14.     Rotations: Integer;
15.     Age: Integer;
16.   end;
17.  
18.   { TForm1 }
19.   TForm1 = class(TForm)
20.     BGRAVirtualScreen1: TBGRAVirtualScreen;
21.     Timer1: TTimer;
22.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
23.     procedure FormCreate(Sender: TObject);
24.     procedure FormResize(Sender: TObject);
25.     procedure Timer1Timer(Sender: TObject);
26.   private
27.     txt: string;
28.     ChrArray: array of TChr;
29.     CCharIndex: Integer;
30.     FrameCount: Integer;
31.   public
32.   end;
33.  
34. var
35.   Form1: TForm1;
36.  
37. implementation
38.  
39. {$R *.lfm}
40.  
41. { TForm1 }
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. const
45.   sflag = snd_Loop or snd_Async;
46. begin
47.   Caption := 'Rotating Scroll Text V1.0 Gigatron';
48.   txt := '    GIGATRON PRESENTS ROTATING SCROLL TEXT MADE WITH LAZARUS FPC ON 5.5.2025  GREETINGS TO SAVAGE & TRONIC DESIGN & PARANOIMIA-ITALY   ...... SEE YOU BYE ............................';
49.  
50.   CCharIndex := 0;
51.   FrameCount := 0;
52.   SetLength(ChrArray, 0);// reserve mem chrtab
53.   BGRAVirtualScreen1.Align := alClient;
54.   playsound('mbis.wav', 0, sflag); // mono
55. end;
56.  
57. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
58. var
59.   centerX, centerY, radius: Integer;
60.   i: Integer;
61.   x, y: Integer;
62. begin
63.   Bitmap.Fill(BGRA(0, 0, 0));
64.  
65.   centerX := BGRAVirtualScreen1.Width div 2;
66.   centerY := BGRAVirtualScreen1.Height div 2;
67.   radius := 250;
68.  
69.   bitmap.FontFullHeight := 72;
70.   bitmap.FontName := 'Arial';
71.   bitmap.FontStyle := [fsBold];
72.  
73.   for i := Length(ChrArray) - 1 downto 0 do
74.   begin
75.     // Calcul de la position
76.     x := centerX + Round(radius * Cos(ChrArray[i].Angle));
77.     y := centerY + Round(radius * Sin(ChrArray[i].Angle));
78.  
79.     bitmap.TextOut(x, y-30,   ChrArray[i].Char,   BGRA(255, 255, 255));
80.     bitmap.TextOut(x+4, y-30, ChrArray[i].Char,   BGRA(0, 0, 255));
81.   end;
82. end;
83.  
84. procedure TForm1.FormResize(Sender: TObject);
85. begin
86.   BGRAVirtualScreen1.Invalidate;
87. end;
88.  
89. procedure TForm1.Timer1Timer(Sender: TObject);
90. var
91.   i: Integer;
92.   angleStep: Single;
93.   newAngle: Single;
94.   posfree: Boolean;
95.   angleDiff: Single;
96.   charAppearSpeed: Integer;
97.   rotationSpeed: Single;
98.   totalChr: Integer;
99.   chrFullRotated: Single;
100. begin
101.  
102.   charAppearSpeed := 11;     // Frame chr space
103.   rotationSpeed := 1.2 * Pi / 180;
104.   totalchr := 60;         // max visible chr
105.   angleStep := (2 * Pi) / totalChr;
106.  
107.   // Add chr if
108.   if (FrameCount mod charAppearSpeed = 0) and (CCharIndex < Length(txt) * 2) then
109.   begin
110.  
111.     posfree := False;
112.     newAngle := 0; // Commence à l'angle 0
113.  
114.     for i := 0 to Length(ChrArray) - 1 do
115.     begin
116.       angleDiff := Abs(ChrArray[i].Angle - newAngle);
117.       if angleDiff < angleStep * 0.8 then // Marge de sécurité
118.       begin
119.         posfree := True;
120.         Break;
121.       end;
122.     end;
123.  
124.     if not posfree then
125.     begin
126.       SetLength(ChrArray, Length(ChrArray) + 1);
127.       ChrArray[Length(ChrArray) - 1].Char := txt[(CCharIndex mod Length(txt)) + 1];
128.       ChrArray[Length(ChrArray) - 1].Angle := newAngle;
129.       ChrArray[Length(ChrArray) - 1].Rotations := 0;
130.       ChrArray[Length(ChrArray) - 1].Age := 0;
131.  
132.       Inc(CCharIndex);
133.     end;
134.   end;
135.  
136.   for i := Length(ChrArray) - 1 downto 0 do
137.   begin
138.     ChrArray[i].Angle := ChrArray[i].Angle - rotationSpeed;
139.     ChrArray[i].Age := ChrArray[i].Age + 1;
140.  
141.     chrFullRotated := 2 * Pi - (40 * Pi / 180);
142.  
143.     if Abs(ChrArray[i].Angle) >= chrFullRotated then
144.     begin
145.  
146.       if i < Length(ChrArray) - 1 then
147.         ChrArray[i] := ChrArray[Length(ChrArray) - 1];
148.       SetLength(ChrArray, Length(ChrArray) - 1);
149.       Continue;
150.     end;
151.  
152.     if ChrArray[i].Angle <= -2 * Pi then
153.     begin
154.       ChrArray[i].Angle := ChrArray[i].Angle + 2 * Pi;
155.       ChrArray[i].Rotations := ChrArray[i].Rotations + 1;
156.     end;
157.   end;
158.  
159.   // Restart scroll txt
160.   if (CCharIndex >= Length(txt)) and (Length(ChrArray) = 0) then
161.     CCharIndex := 0;
162.  
163.   Inc(FrameCount);
164.   BGRAVirtualScreen1.RedrawBitmap;
165. end;
166.  
167. end.

[cdbc]

Hi
Nope, d2010 is just trolling to waste your time!
Sorry, completely forgot, your text is looking good =^
Regards Benny