Delphi Windows Shader Programming In Delphi FireMonkey – Apply Color To The GPU Shader

[FireWind]

Windows Shader Programming In Delphi FireMonkey – Apply Color To The GPU Shader
February 15, 2021 By Muminjon

Для просмотра ссылки Войди или Зарегистрируйся And we learned how to create a material source using TCustomMaterial. Then we have applied that material to a 3D control. This post is based around a blog post by Embarcadero MVP Erik van Bilsen.

Now, we will add a color property to our 3D control to customize color. This can simply be achieved by adding a uniform input to the pixel shader for the color. So, on the Delphi side, Color property should be added to new material.

type
  TCustomColorMaterial = class(TCustomMaterial)
    ...
  private
    FColor: TAlphaColor;
    procedure SetColor(const AValue: TAlphaColor);
  protected
    procedure DoApply(const Context: TContext3D); override;
    procedure DoInitialize; override;
  public
    constructor Create; override;
 
    property Color: TAlphaColor read FColor write SetColor;
  end;
 
{ TCustomColorMaterial }
 
constructor TCustomColorMaterial.Create;
begin
  inherited;
  FColor := TAlphaColors.Blue;
end;
 
procedure TCustomColorMaterial.DoApply(const Context: TContext3D);
begin
  inherited;
  Context.SetShaderVariable('Color', FColor);
end;
 
procedure TCustomColorMaterial.DoInitialize;
begin
  inherited;
  ...
  FPixelShader := TShaderManager.RegisterShaderFromData('CustomColor.fps',
    TContextShaderKind.PixelShader, '', [
    TContextShaderSource.Create(FShaderArch, FPixelShaderData,
    [TContextShaderVariable.Create('Color',
     TContextShaderVariableKind.Vector, 0, FColorSize)])
  ]);
end;
 
procedure TCustomColorMaterial.SetColor(const AValue: TAlphaColor);
begin
  if (AValue <> FColor) then
  begin
    FColor := AValue;
    DoChange;
  end;
end;

• From this code we can observe that to pass the color to the GPU shader, we must override the DoApply function. In the DoApply function, you call SetShaderVariable method to pass the color to the shader.

Finally, you must update the material source by adding a new Color property. Here is the implementation

type
  TCustomColorMaterialSource = class(TMaterialSource)
  private
    function GetColor: TAlphaColor;
    procedure SetColor(const AValue: TAlphaColor);
  protected
    function CreateMaterial: TMaterial; override;
  published
    property Color: TAlphaColor read GetColor write SetColor;
  end;
 
{ TCustomColorMaterialSource }
 
function TCustomColorMaterialSource.CreateMaterial: TMaterial;
begin
  Result := TCustomColorMaterial.Create;
end;
 
function TCustomColorMaterialSource.GetColor: TAlphaColor;
begin
  Result := TCustomColorMaterial(Material).Color;
end;
 
procedure TCustomColorMaterialSource.SetColor(const AValue: TAlphaColor);
begin
  TCustomColorMaterial(Material).Color := AValue;
end;

And here is our result:
Для просмотра ссылки Войди или ЗарегистрируйсяДля просмотра ссылки Войди или Зарегистрируйся And stay tuned for the next part which we will add a texture to our 3D control.