BGRA Shader Color Operation

[Gigatron]

Hi,

I didn't do much for the Lazarus community today. However, I did play around with the BGRA Shader, which modifies the red, green, and blue components, brightness, gamma, sturation, and contrast. Clicking the save button saves the shader result as a .png image.

Maybe you can do this with Bgra component directly, but i would like to use
shader to do some colors opération with texture image.
Image from NASA.

Have fun!

Code under 150 lines

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, BGRAOpenGL, BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen;
10.  
11. type
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     save_btn: TButton;
16.     s_red: TFloatSpinEdit;
17.     ShaderScreen1: TBGLVirtualScreen;
18.     FragMemo: TMemo;
19.     s_brigtness: TFloatSpinEdit;
20.     Timer1: TTimer;
21.     s_green: TFloatSpinEdit;
22.     s_gamma: TFloatSpinEdit;
23.     s_blue: TFloatSpinEdit;
24.     s_staturation: TFloatSpinEdit;
25.     s_contrast: TFloatSpinEdit;
26.     VertexMemo: TMemo;
27.  
28.     procedure save_btnClick(Sender: TObject);
29.     procedure ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
30.     procedure ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
31.     procedure ShaderScreen1UnloadTextures(Sender: TObject; BGLContext: TBGLContext);
32.     procedure FormCreate(Sender: TObject);
33.     procedure Timer1Timer(Sender: TObject);
34.     procedure InitShader;  // init and start shader
35.  
36.   private
37.  
38.   public
39.        gl_surface : IBGLTexture; shader3 : TBGLShader3D;
40.        final_image : TBGRACustomBitmap;   // to save .png
41.        ctx  : TBGLContext;
42.        fshader : string ; vshader : string; // fragment and vertex
43.   end;
44.  
45. var
46.    Form1: TForm1;
47.  
48. implementation
49.  
50. {$R *.lfm}
51.  
52. { TForm1 }
53.  
54. procedure TForm1.FormCreate(Sender: TObject);
55. begin
56.   fshader := FragMemo.text;
57.   vshader := VertexMemo.Text;
58. end;
59.  
60. procedure TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
61. begin
62.  
63.   if gl_surface <> nil then
64.      BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width, ShaderScreen1.Height, gl_surface);
65.  
66.   if shader3 <> nil then
67.   begin
68.     BGLContext.Canvas.Lighting.ActiveShader := shader3;
69.   end;
70. end;
71.  
72. procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext);
73. begin
74.    try
75.      gl_surface := BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256, or 512*512
76.     // Create shader
77.     shader3 := TBGLShader3D.Create(
78.       BGLContext.Canvas,
79.       vshader,   // Vertex shader
80.       fshader,   // Fragment shader
81.       'varying vec2 texCoord;',
82.       '130');    // Version GLSL
83.        ctx := BGLContext;
84.        initShader;   // ***** Start Shader
85.   except
86.     on E: Exception do
87.       raise exception.Create('Shader Error : ' + E.Message);
88.   end;
89. end;
90.  
91. procedure Tform1.InitShader;
92. begin
93.   try
94.     fshader := FragMemo.Text;
95.     vshader := VertexMemo.Text;
96.  
97.     if Assigned(shader3) then
98.     begin
99.       ctx.Canvas.Lighting.ActiveShader := nil;
100.       FreeAndNil(shader3);
101.     end;
102.  
103.     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader, 'varying vec2 texCoord;', '130');
104.     // if shader error,  exception raised by BGRAOpenGLD3 nice :);
105.  
106.     Timer1.Enabled := True; // timer1
107.   except
108.     on E: Exception do
109.       ShowMessage('Shader Error : ' + E.Message);
110.   end;
111. end;
112.  
113. procedure TForm1.ShaderScreen1UnloadTextures(Sender: TObject;
114.   BGLContext: TBGLContext);
115. begin
116.   gl_surface  := nil;
117.   FreeAndNil(shader3);
118.   BGLContext.Canvas.Lighting.ActiveShader := nil;
119. end;
120.  
121. procedure TForm1.Timer1Timer(Sender: TObject);
122. begin
123.   if shader3 <> nil then
124.   begin
125.     shader3.UniformPointF['resolution'].Value := Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));
126.  
127.     shader3.UniformSingle['rr'].Value := s_red.Value;
128.     shader3.UniformSingle['gg'].Value := s_green.Value;
129.     shader3.UniformSingle['bb'].Value := s_blue.Value;
130.     shader3.UniformSingle['brightness'].Value := s_brigtness.Value;
131.     shader3.UniformSingle['contrast'].Value   := s_contrast.Value;
132.     shader3.UniformSingle['gamma'].Value      := s_gamma.Value;;
133.     shader3.UniformSingle['saturation'].Value := s_staturation.Value;
134.  
135.     ShaderScreen1.Invalidate;
136.   end;
137. end;
138.  
139. procedure TForm1.save_btnClick(Sender: TObject);
140. begin
141.     final_image := shaderScreen1.Canvas.GetImage(0,0,ShaderScreen1.Width,ShaderScreen1.Height);
142.     final_image.SaveToFile('my_image.png'); // save the result to .png
143. end;
144.  
145. end.

[Gigatron]

Hi,

At now it's time to make a little component to implement pixel shader to your project with
minimal code. You just need a MemoText and Timer;
This component use BLGVirtual Screen from BGRA component of @circular;

Be careful if you don't know how to install a component, I don't want to be responsible for anything if you crash your PC and lose your data. Use at your own risk.

Install shadercomponent.lpk , then you can see the installed component in OpenGl palette place.

MemoText contain the Fragment Shader, no Need to write Vertex it's loaded by default.
You must load glsurface image like 'gl.png' included in projet.zip ;
The exemple shader is from Shadertoy (IQ);

https://www.shadertoy.com/new

I'm busy working now for someone who wants batch filters for 8bit images, that's one of the reasons why I made this component and for the Lazarus community of course. Thanks to @circular for its fantastic BGRA

And so on ... The minimal code under 60 lines:

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,ShaderComponent;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Timer1: TTimer;
16.     ShaderComponent1: TShaderComponent;
17.     Fragment_Memo: TMemo;
18.     procedure FormShow(Sender: TObject);
19.     procedure Timer1Timer(Sender: TObject);
20.   private
21.  
22.   public
23.  
24.   end;
25.  
26. var
27.   Form1: TForm1;
28.   g_timer : Single; // general timer to update uniform variable iTime;
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TForm1 }
35.  
36. procedure TForm1.FormShow(Sender: TObject);  // Need to wait a bit Shader is Ready
37. begin
38.     g_timer := 0.0;
39.     ShaderComponent1.SetBackgroundTexture('gl.png'); // shader surface needed !
40.     ShaderComponent1.SetFragmentShader(Fragment_Memo.Text);
41. end;
42.  
43. procedure TForm1.Timer1Timer(Sender: TObject);
44. begin
45.   if Assigned(ShaderComponent1.Shader) then  // Needed to wait shader is ready !
46.     shaderComponent1.Shader.UniformSingle['iTime'].Value:= g_timer; // write uniform iTime
47.  
48.     g_timer += 0.02;
49. end;
50.  
51. end.
52.  

[Boleeman]

Thanks Gigatron for that shadercomponent.

Always wanted to play around with Shadertoy but did not really know how.
That batch processor looks interesting.