BGRA Shader Color Operation
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-04-12 23:48

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,  Spin, BGRAOpenGL,
BGRABitmapTypes, BGRAOpenGL3D, BGLVirtualScreen; type  { TForm1 }  
TForm1 = class(TForm)    save_btn: TButton;    s_red: TFloatSpinEdit; 
  ShaderScreen1: TBGLVirtualScreen;    FragMemo: TMemo;   
s_brigtness: TFloatSpinEdit;    Timer1: TTimer;    s_green:
TFloatSpinEdit;    s_gamma: TFloatSpinEdit;    s_blue:
TFloatSpinEdit;    s_staturation: TFloatSpinEdit;    s_contrast:
TFloatSpinEdit;    VertexMemo: TMemo;     procedure
save_btnClick(Sender: TObject);    procedure
ShaderScreen1LoadTextures(Sender: TObject; BGLContext: TBGLContext); 
 procedure ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);    procedure ShaderScreen1UnloadTextures(Sender:
TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);    procedure
InitShader;  // init and start shader   private   public     
 gl_surface : IBGLTexture; shader3 : TBGLShader3D;       final_image :
TBGRACustomBitmap;   // to save .png       ctx  : TBGLContext;     
 fshader : string ; vshader : string; // fragment and vertex 
end; var   Form1: TForm1; implementation {$R *.lfm} { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin  fshader :=
FragMemo.text;  vshader := VertexMemo.Text;end; procedure
TForm1.ShaderScreen1Redraw(Sender: TObject; BGLContext:
TBGLContext);begin   if gl_surface <> nil then   
 BGLContext.Canvas.StretchPutImage(0, 0, ShaderScreen1.Width,
ShaderScreen1.Height, gl_surface);   if shader3 <> nil then  begin   
BGLContext.Canvas.Lighting.ActiveShader := shader3; 
end;end; procedure TForm1.ShaderScreen1LoadTextures(Sender: TObject;
BGLContext: TBGLContext);begin   try     gl_surface :=
BGLTexture(ResourceFile('gl.png')); // your image 128*128 or 256*256,
or 512*512    // Create shader    shader3 := TBGLShader3D.Create(    
BGLContext.Canvas,      vshader,   // Vertex shader      fshader,   //
Fragment shader      'varying vec2 texCoord;',      '130');    //
Version GLSL       ctx := BGLContext;       initShader;   // *****
Start Shader  except    on E: Exception do      raise
exception.Create('Shader Error : ' + E.Message);  end;end; procedure
Tform1.InitShader;begin  try    fshader := FragMemo.Text;    vshader
:= VertexMemo.Text;     if Assigned(shader3) then    begin     
ctx.Canvas.Lighting.ActiveShader := nil;      FreeAndNil(shader3);   
end;     shader3 := TBGLShader3D.Create(ctx.Canvas, vshader, fshader,
'varying vec2 texCoord;', '130');    // if shader error,  exception
raised by BGRAOpenGLD3 nice :);     Timer1.Enabled := True; // timer1 
except    on E: Exception do      ShowMessage('Shader Error : ' +
E.Message);  end;end; procedure
TForm1.ShaderScreen1UnloadTextures(Sender: TObject;  BGLContext:
TBGLContext);begin  gl_surface  := nil;  FreeAndNil(shader3); 
BGLContext.Canvas.Lighting.ActiveShader := nil;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin  if shader3 <> nil then 
begin    shader3.UniformPointF['resolution'].Value :=
Pointf(Round(ShaderScreen1.Width),Round(ShaderScreen1.Height));    
shader3.UniformSingle['rr'].Value := s_red.Value;   
shader3.UniformSingle['gg'].Value := s_green.Value;   
shader3.UniformSingle['bb'].Value := s_blue.Value;   
shader3.UniformSingle['brightness'].Value := s_brigtness.Value;   
shader3.UniformSingle['contrast'].Value   := s_contrast.Value;   
shader3.UniformSingle['gamma'].Value      := s_gamma.Value;;   
shader3.UniformSingle['saturation'].Value := s_staturation.Value;    
ShaderScreen1.Invalidate;  end;end; procedure
TForm1.save_btnClick(Sender: TObject);begin    final_image := shaderSc
reen1.Canvas.GetImage(0,0,ShaderScreen1.Width,ShaderScreen1.Height); 
 final_image.SaveToFile('my_image.png'); // save the result to
.pngend; end.

----------------------------------------------------------------------
Gigatron · 2025-05-27 13:12

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls,ShaderComponent; type   { TForm1 }   TForm1 = class(TForm)  
Timer1: TTimer;    ShaderComponent1: TShaderComponent;   
Fragment_Memo: TMemo;    procedure FormShow(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);  private   public   end; var 
Form1: TForm1;  g_timer : Single; // general timer to update uniform
variable iTime; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormShow(Sender: TObject);  // Need to wait a bit Shader is
Readybegin    g_timer := 0.0;   
ShaderComponent1.SetBackgroundTexture('gl.png'); // shader surface
needed !   
ShaderComponent1.SetFragmentShader(Fragment_Memo.Text);end; procedure
TForm1.Timer1Timer(Sender: TObject);begin  if
Assigned(ShaderComponent1.Shader) then  // Needed to wait shader is
ready !    shaderComponent1.Shader.UniformSingle['iTime'].Value:=
g_timer; // write uniform iTime     g_timer += 0.02;end; end.

----------------------------------------------------------------------
Boleeman · 2025-05-30 13:02

Thanks Gigatron for that shadercomponent.

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