Fast Canvas Library V1.052

[Lulu]

the effects are nice

[RAW]

There is also FastDIB or back in the days (D5) there was FastLIB (I guess WinAPI DIB + 32bit ASM).
Maybe people who like FastCanvasLIB are interested in things like that too....

Maybe there is more stuff out there in this category..

[Gigatron]

There is also FastDIB or back in the days (D5) there was FastLIB (I guess WinAPI DIB + 32bit ASM).
Maybe people who like FastCanvasLIB are interested in things like that too....

Maybe there is more stuff out there in this category..

Sure the same style, but this library is for oldschool demo effects

Here is the version 1.052 bugs are fixed hope so !
The library is included in the project.zip ; and a demo of barnsley's Fern Leaf based on Boleeman example;


Regards

[Gigatron]

Hi

Now it's time to use this library for making demo now !
3D wireFrame Sphere in action; https://www.youtube.com/watch?v=UE3EegXD0i4

// Sorry it's not Cube but Sphere, Cube is another project
project.zip is atached ;

When you Start project with this library use the following code.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, NativeFastCanvas,Windows, ExtCtrls;
9.  
10. type
11.   { TForm1 }
12.   TForm1 = class(TForm)
13.     Timer1: TTimer;
14.     procedure FormCreate(Sender: TObject);
15.     procedure FormDestroy(Sender: TObject);
16.     procedure Timer1Timer(Sender: TObject);
17.   private
18.     FastCanvas: TNativeFastCanvas;
19.  
20.   public
21.     procedure NativeFastCanvas1NativePaint(Sender: TObject; DC: HDC; Pixels: PFastPixel; Ww, Hh: Integer);
22.  
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. begin
36.  
37.   FastCanvas := TNativeFastCanvas.Create(Self);
38.   with FastCanvas do
39.   begin
40.     Parent := Self;
41.     Align := alClient;
42.     BackgroundColor := RGB(0, 0, 32);
43.     OnNativePaint := @NativeFastCanvas1NativePaint;
44.   end;
45.  
46. end;
47.  
48. procedure TForm1.NativeFastCanvas1NativePaint(Sender: TObject; DC: HDC;Pixels: PFastPixel; Ww, Hh: Integer);
49. begin
50.  
51.   FastCanvas.DC := DC;
52.   FastCanvas.DrawVectorText(80, 100, 'HELLO LAZARUS 4.0', 35, RGB(255, 255, 0));
53. end;
54.  
55. procedure TForm1.Timer1Timer(Sender: TObject);
56. begin
57.   FastCanvas.Invalidate;
58. end;
59.  
60. procedure TForm1.FormDestroy(Sender: TObject);
61. begin
62.   if Assigned(FastCanvas) then FastCanvas.Free;
63. end;
64.  
65. end.

[Gigatron]

Hi

A more complex library is glCanvas in beta version using TOpenGLControl;
Some functions are not working yet but a nice demo is Ok !
All files are atached to run this demo;

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,OpenGLContext,
9.   glCanvas, gl,Math;
10.  
11. type
12.   { TForm1 }
13.   TForm1 = class(TForm)
14.     Timer1: TTimer;
15.     OpenGLControl1: TOpenGLControl;
16.     procedure FormCreate(Sender: TObject);
17.     procedure Timer1Timer(Sender: TObject);
18.     procedure OpenGLControl1Paint(Sender: TObject);
19.   private
20.     FTime: Single;
21.     FStars: array[0..99999] of TStar;
22.     Ftex: GLuint;
23.  
24.     procedure InitStarfield;
25.     procedure UpdateStarfield;
26.   public
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.  
32. implementation
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.FormCreate(Sender: TObject);
39. begin
40.   glInit(OpenGLControl1);
41.   if not OpenGLControl1.MakeCurrent then
42.     raise Exception.Create('Impossible de faire current OpenGL context.');
43.   FTime := 0;
44.     Ftex := LoadPNGToTexture('girl4.png');
45.   InitStarfield;
46.  
47. end;
48.  
49. procedure TForm1.InitStarfield;
50. var
51.   i: Integer;
52. begin
53.   for i := 0 to High(FStars) do
54.   begin
55.     FStars[i].x := (Random - 0.5) * 200;
56.     FStars[i].y := (Random - 0.5) * 200;
57.     FStars[i].z := Random * 10 + 0.1;
58.     FStars[i].brightness := Random + 3.5;
59.   end;
60. end;
61.  
62. procedure TForm1.UpdateStarfield;
63. var
64.   i: Integer;
65. begin
66.   for i := 0 to High(FStars) do
67.   begin
68.     FStars[i].z := FStars[i].z - 0.02;
69.     if FStars[i].z <= 0 then
70.     begin
71.       FStars[i].x := (Random - 0.5) * 200;
72.       FStars[i].y := (Random - 0.5) * 200;
73.       FStars[i].z := 10;
74.       FStars[i].brightness := Random + 3.5;
75.     end;
76.   end;
77. end;
78.  
79. procedure TForm1.Timer1Timer(Sender: TObject);
80. begin
81.   FTime := FTime + 0.008;
82.   UpdateStarfield;
83.   OpenGLControl1.Invalidate;
84. end;
85.  
86. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
87. var
88.   i: Integer;
89.   centerX, centerY: Single;
90.   color1: TglColor;
91.   offsetX, offsetY: Single;
92.     r, g, b: Single;
93. const
94.   MinVal = 0.1;
95.  
96. begin
97.   if not OpenGLControl1.MakeCurrent then Exit;
98.  
99.   centerX := OpenGLControl1.Width / 2;
100.   centerY := OpenGLControl1.Height / 2;
101.  
102.   glFillScreen(OpenGLControl1, 0.1, 0.1, 0.2, 1.0);
103.  
104.   offsetX := Sin(FTime * 4) * 300;  // oscillation horizontale
105.   offsetY := Cos(FTime * 3) * 30;
106.   r := Abs(sin(FTime * 1.1)) * (1 - MinVal) + MinVal; // entre 0.1 et 1.0
107.   g := Abs(sin(FTime * 1.3 + 2)) * (1 - MinVal) + MinVal;
108.   b := Abs(sin(FTime * 1.7 + 4)) * (1 - MinVal) + MinVal;
109.  
110.   glDrawTexture(centerX-100 + offsetX, centerY - 100 ,
111.                 256, 256, Ftex,
112.                 4.0, 4.0,
113.                 0,
114.                 r,g,b,
115.                 1.0);
116.  
117.   glStarfield(FStars, 0.1, OpenGLControl1.Width, OpenGLControl1.Height);
118.  
119.   for i := 0 to 17 do
120.   begin
121.     color1 := glColorHSV((FTime * 60 + i * 72) mod 360, 1, 1, 0.8);
122.     glCircle(
123.       centerX + cos(FTime + i * 0.35) * 400,
124.       centerY + sin(FTime + i * 0.35) * 400,
125.       40 + sin(FTime * 3)*10,
126.       15,
127.       color1.r, color1.g, color1.b, color1.a,
128.       True
129.     );
130.  
131.  
132.     glCircle(
133.       centerX + cos(-FTime + i * 0.35) * 300,
134.       centerY + sin(-FTime + i * 0.35) * 300,
135.       40 + sin(FTime * 3)*10,
136.       15,
137.       color1.r, color1.g, color1.b, color1.a,
138.       True
139.     );
140.  
141.  
142.   end;
143.  
144.   glRect(centerX - 100, centerY - 100, 200, 200, 1, 0, 0, 0.5, False, 4);
145.  
146.   color1 := glColorHSV((FTime * 120) mod 360, 1, 1, 1);
147.   glStar(centerX, centerY, 160, 5, FTime * 90, color1.r, color1.g, color1.b, color1.a, False, 6);
148.   glStar(centerX, centerY, 80, 8,  -FTime * 90, color1.r, color1.g, color1.b, color1.a, False, 4);
149.  
150.   for i := 0 to 2 do
151.   begin
152.     color1 := glColorHSV((FTime * 90 + i * 120) mod 360, 1, 1, 0.7);
153.     glTriangle(
154.       centerX + cos(FTime * 0.5 + i * 2.094) * 300,
155.       centerY + sin(FTime * 0.5 + i * 2.094) * 300,
156.       30,  // taille 15 -> 30
157.       FTime * 180,
158.       color1.r, color1.g, color1.b, color1.a,
159.       True
160.     );
161.   end;
162.  
163.   for i := 0 to 7 do
164.   begin
165.     color1 := glColorHSV((FTime * 60 + i * 90) mod 360, 1, 1, 0.4);
166.     glCircle(centerX, centerY, 120 + i * 50 + sin(FTime * 2) * 60, 6+(i*8),
167.              color1.r, color1.g, color1.b, color1.a, False, 1+i*2);
168.   end;
169.  
170.   for i := 0 to 7 do
171.   begin
172.     color1 := glColorHSV((FTime * 180 + i * 45) mod 360, 1, 1, 0.6);
173.     glLine(
174.       centerX,
175.       centerY,
176.       centerX + cos(FTime + i * 0.785) * 800,
177.       centerY + sin(FTime + i * 0.785) * 800,
178.       color1.r, color1.g, color1.b, color1.a,
179.       10 );
180.   end;
181.  
182.   OpenGLControl1.SwapBuffers;
183. end;
184.  
185. end.

[Gigatron]

Hi

Here is the next version of the Glcanvas v0.32 you can add glsl pixel shader ;  and a nice shader fx;
If you have not Amstrad CPC464 font replace it by Arial or some other font.

Have fun;

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, StdCtrls,
9.   OpenGLContext, glCanvas,gl;
10.  
11. type
12.  
13.   { TForm1 }
14.   TForm1 = class(TForm)
15.     Memo1: TMemo;
16.     Memo2: TMemo;
17.     OpenGLControl1: TOpenGLControl;
18.     Timer1: TTimer;
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormDestroy(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.     procedure OpenGLControl1Paint(Sender: TObject);
23.   private
24.     Stime: Single;
25.     Laztex, Shader1Tex, Shader2Tex: GLuint;
26.  
27.   public
28.   end;
29.  
30. var
31.   Form1: TForm1;
32.   scx : integer;
33.   FragmentShader1 :Pchar;
34.   FragmentShader2 :Pchar;// texte sinus
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. procedure TForm1.FormCreate(Sender: TObject);
41. begin
42.   glInit(OpenGLControl1);
43.   if not OpenGLControl1.MakeCurrent then
44.     raise Exception.Create('OpenGL context makeCurrent Error');
45.   STime := 1.0;
46.   scx := 0;
47.   Laztex := LoadPNGToTexture('tex/g5.png');
48.   FragmentShader1 := Pchar(Memo1.Text);
49.   FragmentShader2 := Pchar(Memo2.Text);
50.  
51.   Shader1Tex := glMakeShaderProgram('', FragmentShader1);
52.   if Shader1Tex = 0 then raise Exception.Create('Échec de compilation du shader');
53.  
54.   Shader2Tex := glMakeShaderProgram('', FragmentShader2);
55.   if Shader2Tex = 0 then raise Exception.Create('Échec de compilation du shader');
56.  
57.  
58. end;
59.  
60. procedure TForm1.Timer1Timer(Sender: TObject);
61. begin
62.   STime += 0.16;
63.   scx  := (scx+10) mod 9000;     // reset after 9000
64.   OpenGLControl1.Invalidate;
65. end;
66.  
67. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
68. var i : integer;
69.    copperCol1, copperCol2, copperCol3: TglColor;
70. begin
71.  if not OpenGLControl1.MakeCurrent then Exit;
72.  
73.  
74.    glFillScreen(OpenGLControl1, 0.0, 0.3, 0.6, 1.0);
75.  
76.    copperCol1  := glColorRGBA(0.0, 0.0, 0.0, 1.0);
77.    copperCol2  := glColorRGBA(1.0, 1.0, 1.0, 1.0);
78.    copperCol3  := glColorRGBA(0.0, 0.0, 0.0, 1.0);
79.  
80.    glCopperBarFill(0, -64, 1980, 256*5, copperCol1, copperCol2, copperCol3, 64, Stime*5);
81.  
82.    glDrawShaderText(1980-scx, 700, UpperCase(' ... Hello Shader ! This Is The New GL Canvas Gigatron 2025 ... ... Hello Shader ! This Is The New GL Canvas Gigatron 2025 ...'),
83.                'Amstrad CPC464', 32, [fsBold], 0.0, 1.0, 0.0, 1.0, Shader2Tex, Stime/3.0);
84.  
85.    if (Laztex <> 0) and (Shader1Tex <> 0) then
86.       glDrawTexturedShader(450, 0, 1024, 1024, Laztex, Shader1Tex, 1, 1, 1, 0.8, Stime/5.0);
87.  
88.    OpenGLControl1.SwapBuffers;
89. end;
90.  
91. procedure TForm1.FormDestroy(Sender: TObject);
92. begin
93.   if Shader1Tex <> 0 then glDeleteTextures(1, @Shader1Tex);
94.   if Shader2Tex <> 0 then glDeleteTextures(1, @Shader2Tex);
95. end;
96.  
97. end.
98.  

[Gigatron]

Hi

Another version of glCanvas v0.034 with 80 rotating cubes + rainbow text shader,

With minimal code except fragment shader on Memo1 text;

Regards

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, StdCtrls,
9.   Spin, OpenGLContext, glcanvas, gl;
10.  
11. type
12.   { TForm1 }
13.   TForm1 = class(TForm)
14.     FloatSpinEdit1: TFloatSpinEdit;
15.     Memo1: TMemo;
16.     OpenGLControl1: TOpenGLControl;
17.     Timer1: TTimer;
18.     procedure FormCreate(Sender: TObject);
19.     procedure OpenGLControl1Paint(Sender: TObject);
20.     procedure Timer1Timer(Sender: TObject);
21.   private
22.     rot: Single;
23.     Txt_Shader: GLuint;
24.   public
25.   end;
26.  
27. var
28.   Form1: TForm1;
29.   Txt_Fragment :Pchar;
30.   txt : string =' GL CUBE DEMO GIGATRON 2025 ';
31.  
32. implementation
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.Timer1Timer(Sender: TObject);
39. begin
40.   OpenGLControl1.Invalidate;
41. end;
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. begin
45.   glInit(OpenGLControl1); // need
46.   if not OpenGLControl1.MakeCurrent then raise Exception.Create('OpenGL context makeCurrent Error');
47.   rot := 0;
48.   Txt_Fragment := Pchar(Memo1.Text);
49.   Txt_Shader := glMakeShaderProgram('', Txt_Fragment);
50.   if Txt_Shader = 0 then raise Exception.Create('Échec de compilation du shader');
51. end;
52.  
53. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
54. var
55.   i, j: Integer;
56. begin
57.   if not OpenGLControl1.MakeCurrent then Exit; // need
58.   glFillScreen(OpenGLControl1, 0.0, 0.0, 0.0, 1.0); // need
59.  
60.   for i:=0 to 9 do
61.    for j:=0 to 7 do
62.    glFilled3DCube(OpenGLControl1, -80 +i*18, 75-j*18, 0,  10,  // x=3D Screen Spece 0= center
63.                                0 + round(j*36)/255, 1.0-round(j*64)/255, 0 +(round(i*28*2)/255) , 1.0,
64.                                rot, -rot, -rot, 0.0, 0.0, 1.0);
65.   // 2D
66.   glSetUniformFloat(Txt_Shader,'frequency',FloatSpinEdit1.Value); // uniform float; memo1 frag shader
67.   glDrawShaderText(400, 800, txt,'Arial', 42, [fsBold], 1.0, 1.0, 1.0, 1.0, Txt_Shader, rot/50);
68.  
69.   rot += 2.60;
70.  
71.   OpenGLControl1.SwapBuffers; // need
72. end;
73.  
74. end.

[Gigatron]

Hi

Here is the next version of glCanvas V0.036 with 3d Primitives.

Online YT demo : https://www.youtube.com/watch?v=IJ6gB9_uwdU

See you ;

[Gigatron]

Hi

Added some nice functions to Gl Canvas V0.037 and finished the demo.
This library is near 95 % usable and will be uploaded soon, if some 3D perspective corrections and
minor bugs fixed .

Online demo on YT : https://www.youtube.com/watch?v=RyXYP-4H-jk

Regards

[ADMGNS]

hello

good work.. and thanks a lot..

what about native support for other platforms, ie Linux support, maybe at next versions??

regs

[Gigatron]

hello

good work.. and thanks a lot..

what about native support for other platforms, ie Linux support, maybe at next versions??

regs

Hi
I don't have Linux, you'd have to try it out but i think it should work,
at least for some gl commands from the glCanvas library so it's worth checking.

Regards

[Gigatron]

Hi again

Finally here is the V0.037 with a lot of GL commands plus a nice demo with individual star rotation plus space rotation. I hope I didn't make any mistakes.. Use this library with caution even though I corrected quite a few errors. I don't want to be responsible for any data loss or other problems related to your computer. So be careful.

Attachements :
project1.zip with glcanvas V 0.037 + 3D Sprite Starfield : Left & Right key to Rotate 2D Space
star.png

[Gigatron]

Hi,

A little demo to starting use glcanvas.

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.  OpenGLContext, glcanvas, Gl;
10.  
11. type
12.  
13.  { TForm1 }
14.  
15.  TForm1 = class(TForm)
16.    OpenGLControl1: TOpenGLControl;
17.    Timer1: TTimer;
18.    procedure FormCreate(Sender: TObject);
19.    procedure OpenGLControl1Paint(Sender: TObject);
20.    procedure Timer1Timer(Sender: TObject);
21.  private
22.    tmr: Single;
23.  public
24.  end;
25.  
26. var
27.  Form1: TForm1;
28.  
29. implementation
30.  
31. {$R *.lfm}
32.  
33. procedure TForm1.FormCreate(Sender: TObject);
34. begin
35.  glInit(OpenGLControl1);
36. end;
37.  
38. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
39. var
40.  i : integer;
41. begin
42.   glFillScreen(OpenGLControl1, 0,0,0, 1.0); // Need
43.  
44.   for i:=0 to 10 do
45.   glCircle(350 + i *110 , 100,    50   ,     3+i*2      ,  1.0, 1.0, 1.0, 0.7, True);
46.   //        X           , Y           ,  Radius,   Segments   ,  color RGBA        ,Filled ?
47.  
48.   glLine(400, 200, 600, 250, 1.0, 0.0, 0.0, 1.0, 3.0);
49.   glLine3D(1200, 600, 0, 1400, 700, 0, 0.9, 0.1, 0.9, 1.0, 4.0);
50.  
51.   glRect(700, 200, 180, 100,     glColorRGBA(0.0, 1.0, 0.0, 1.0), False, 2.5);
52.   glRectFast(900, 200, 180, 100, glColorRGBA(0.0, 0.4, 1.0, 0.8));
53.  
54.   glCircle(500, 400, 70, 40, 1.0, 0.2, 1.0, 1.0, False, 2.5);
55.   glCircle(700, 400, 70, 40, 0.0, 1.0, 1.0, 0.7, True);
56.  
57.   glTriangle(900, 400, 90,   tmr, 1.0, 1.0, 0.0, 1.0, False, 2.5);
58.   glTriangle(1100, 400, 90, -tmr, 1.0, 0.5, 0.0, 0.8, True);
59.  
60.   glEllipse(500, 600, 100, 60, 40, 1.0, 0.7, 0.8, 1.0, False, 2.5);
61.   glEllipse(700, 600, 100, 60, 40, 0.8, 0.3, 0.9, 0.7, True);
62.  
63.   glStar(900, 600, 60, 5, tmr*2, 1.0, 0.8, 0.0, 1.0, False, 2.5);
64.   glStar(1100, 600, 50, 8, -tmr, 0.8, 0.2, 0.2, 0.9, True);
65.  
66.   glStar(900,  800, 80, 10, 18+tmr *  1.0, 0.6, 0.6, 0.6, 1.0, True);
67.   glStar(1020, 800, 80, 10, -tmr * 1.0, 0.8, 0.9, 0.8, 1.0, True);
68.  
69.   glQuad(1200, 200, 1350, 180, 1380, 300, 1230, 320, 0.6, 0.2, 0.8, 1.0, True);
70.   glQuad(1200, 400, 1350, 380, 1380, 500, 1230, 520, glColorRGBA(0.9, 0.2, 0.8, 1.0), True);
71.  
72.   OpenGLControl1.SwapBuffers; // Need !
73. end;
74.  
75. procedure TForm1.Timer1Timer(Sender: TObject);
76. begin
77.  tmr := tmr + 1.5;
78.  if tmr > 360.0 then tmr := tmr - 360.0;
79.  OpenGLControl1.Invalidate;
80. end;
81. end.

[ADMGNS]

hi again

yesterday i,d tried fastCanvas, but it was based on Windows graphis, ie DC. it doesnt work/compile on Linux as expected.

now, i,ve tried glCanvas, yes, it works: galaxy effect

let it easy..

[Gigatron]

Hi

Let's continue to make some interesting drawing with glcanvas 0.038.

Pseudo 3D based on Lou's Page to draw Out-Run Road from .js Code.
I included some function in glcanvas to reduce the code.

Base source : http://www.extentofthejam.com/pseudo/

Code and library in project1.zip

Have fun