Filling area between curves in Delphi / Firemonkey not working with low opacity

This is an edited version of my original post.

I’m drawing some graphs on a TPaintBox contained in a TRectangle, and filling the space between them with a gradient fill. It works fine until I try to reduce the opacity when strange things happen. Here's what it looks like in the iPhone simulator (it’s the same on a physical device) – the fill opacity is 0.1.

Note that there is no problem on Windows – just iOS and Android.

It's difficult to provide the code for this particular example, so here's a simplified program demonstrating the problem.

All it needs is a TRectangle named Rect on the form, with a TPaintBox named PB in the Rect, aligned to Client. The width and height of Rect are 300 and Position.X,Y (40,40) – these are not important, but it will be visible on an iPhone 14.

In .FormCreate, set the Opacity. The first image shows it with Opacity := 1; the second for Opacity := 0.4. It can be seen that Opacity := 1 works fine, but not Opacity := 0.4. I’ve not included noisy data, but it seems to get messier with noisy data.

Here is the complete code:

unit UFillCurvesDemo;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  System.Math.Vectors,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  Math;

type
  TForm1 = class(TForm)
    Rect: TRectangle;
    PB: TPaintBox;
    procedure PBPaint(Sender: TObject; Canvas: TCanvas);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    RectF: TRectF;
    CurvePolygons: array[1..2] of TPolygon;
    AreaPath: TPathData;
    xMn, xMx,
    yMn, yMx: double;
    NoCurves, NoPoints: integer;
    Opacity: double;
    procedure SetCurves;
    function Px(R: TRectF; xi: double): double;
    function Py(R: TRectF; xi: double): double;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  AreaPath := TPathData.Create;
  RectF := TRectF.Create(Rect.Position.X, Rect.Position.Y,
                         Rect.Position.X + Rect.Width,
                         Rect.Position.Y + Rect.Height);
  Opacity := 0.4;
  SetCurves;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  AreaPath.Free;
end;

procedure TForm1.SetCurves;
var
  cn, pt: integer;
  x, y: double;
begin
  NoCurves := 2;
  NoPoints := 100;
  xMn := 0;
  xMx := 5;
  yMn := -3;
  yMx := 5;
  for cn := 1 to 2 do
    SetLength(CurvePolygons[cn], NoPoints);
  for pt := 0 to NoPoints - 1 do
  begin
    x := ( 5 * pi() / 4 ) * pt / NoPoints;
    y := 3 + sin( 3 * x);
    CurvePolygons[1][pt] := PointF(pX(RectF, x), pY(RectF, y));
    x := ( 5 * pi() / 4 ) * pt / NoPoints;
    y := sin(2 * x + pi() / 4);
    CurvePolygons[2][pt] := PointF(pX(RectF, x), pY(RectF, y));
  end;

  AreaPath.MoveTo(CurvePolygons[1][0]);
  for pt := 1 to NoPoints - 1 do
    AreaPath.LineTo(CurvePolygons[1][pt]);
  for pt := NoPoints - 1 downto 0 do
    AreaPath.LineTo(CurvePolygons[2][pt]);

  Areapath.ClosePath;

end;

function TForm1.Px(R: TRectF; xi: double): double;
begin
  with R do
    result := ((xi - xMn) * Right + Left * (xMx - xi)) / (xMx - xMn);
end;

function TForm1.Py(R: TRectF; xi: double): double;
begin
  with R do
    result := ((yMx - xi) * Bottom + top * (xi - yMn)) / (yMx - yMn);
end;

procedure TForm1.PBPaint(Sender: TObject; Canvas: TCanvas);
var
  brush: TStrokeBrush;
  pt: integer;
begin
  Canvas.BeginScene;
  try
    // Gradient fill
    Canvas.Fill.Kind := TBrushKind.Gradient;
    Canvas.Fill.Gradient.Style := TGradientStyle.Linear;
    Canvas.Fill.Gradient.StartPosition.X := 0;
    Canvas.Fill.Gradient.StartPosition.Y := 0;
    Canvas.Fill.Gradient.StopPosition.X := 0;
    Canvas.Fill.Gradient.StopPosition.Y := 1;

    Canvas.Fill.Gradient.Points.Clear;

    Canvas.Fill.Gradient.Points.Add;
    Canvas.Fill.Gradient.Points[0].Color := TAlphaColors.Red;
    Canvas.Fill.Gradient.Points[0].Offset := 0.0;

    Canvas.Fill.Gradient.Points.Add;
    Canvas.Fill.Gradient.Points[1].Color := TAlphaColors.Blue;
    Canvas.Fill.Gradient.Points[1].Offset := 1.0;

    Canvas.FillPath(AreaPath, Opacity);

    // Draw curves
    brush := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Red);
    try
      brush.Thickness := 1;
      brush.Color := TAlphaColors.Red;
      for pt := 0 to NoPoints - 2 do
        Canvas.DrawLine(CurvePolygons[1][pt], CurvePolygons[1][pt + 1], 1, brush);

      brush.Color := TAlphaColors.Blue;
      for pt := 0 to NoPoints - 2 do
        Canvas.DrawLine(CurvePolygons[2][pt], CurvePolygons[2][pt + 1], 1, brush);
    finally
      brush.Free;
    end;
  finally
    Canvas.EndScene;
  end;
end;

end.

So, my basic question is, is it possible to have these fills with low opacity?

Once again, any help very gratefully appreciated. Ian

As I mentioned in my comment this seems to be a bug as it only happening on mobile platforms that use OpenGL for rendering instead of DirectX that is being used on Windows.

I have however made you an alternative solution.

I doubt it is very performance friendly as it is rendering one background polygon for each of the line segments. So it should be considered only as temporary workaround.

Here is the changed PBPaint method.

procedure TForm1.PBPaint(Sender: TObject; Canvas: TCanvas);
var
  brush: TStrokeBrush;
  GradientPolygon: TPolygon;
  pt: integer;
begin
  Canvas.BeginScene;
  try
    // Gradient fill
    Canvas.Fill.Kind := TBrushKind.Gradient;
    Canvas.Fill.Gradient.Style := TGradientStyle.Linear;
    Canvas.Fill.Gradient.StartPosition.X := 0;
    Canvas.Fill.Gradient.StartPosition.Y := 0;
    Canvas.Fill.Gradient.StopPosition.X := 0;
    Canvas.Fill.Gradient.StopPosition.Y := 1;

    Canvas.Fill.Gradient.Points.Clear;

    Canvas.Fill.Gradient.Points.Add;
    Canvas.Fill.Gradient.Points[0].Color := TAlphaColors.Red;
    Canvas.Fill.Gradient.Points[0].Offset := 0.0;

    Canvas.Fill.Gradient.Points.Add;
    Canvas.Fill.Gradient.Points[1].Color := TAlphaColors.Blue;
    Canvas.Fill.Gradient.Points[1].Offset := 1.0;

    //Canvas.FillPath(AreaPath, Opacity);

    // Draw curves
    brush := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Red);
    try
      brush.Thickness := 1;
      //Set size of gradient polygon to four points as this is all you need.
      SetLength(GradientPolygon,4);
      for pt := 0 to NoPoints - 2 do
      begin
        //Draw first line
        brush.Color := TAlphaColors.Red;
        Canvas.DrawLine(CurvePolygons[1][pt], CurvePolygons[1][pt + 1], 1, brush);

        //Draw second line
        brush.Color := TAlphaColors.Blue;
        Canvas.DrawLine(CurvePolygons[2][pt], CurvePolygons[2][pt + 1], 1, brush);

        //Draw bacgkround gradient as series of simple polygons
        //Not the most performant solution but it works.
        GradientPolygon[0] := CurvePolygons[1][pt];
        GradientPolygon[1] := CurvePolygons[1][pt + 1];
        GradientPolygon[2] := CurvePolygons[2][pt + 1];
        GradientPolygon[3] := CurvePolygons[2][pt];
        Canvas.FillPolygon(GradientPolygon, Opacity);
      end;

    finally
      brush.Free;
    end;
  finally
    Canvas.EndScene;
  end;
end;

You may also notice I have done a bit of optimisation of your code by moving line rendering code and new background rendering code into a single for loop (no more separate loops for each line).

Also as you can see from the image bellow the gradient is now consistent with the vertical distance between the two lines.