Работа с TCanvas в Delphi под Android

Рисование на TCanvas в Delphi XE5 под Android как оказалось имеет некоторые особенности, которые по-началу ввели меня в легкое замешательство и которыми хотелось бы поделиться.

Нарисуем несколько параллельных линий.

Здесь хотелось бы отвлечься и заметить, что под Windows значение Stroke.Kind по умолчанию равно bkSolid, а под Android — bkNone. То есть, если явно не установить значение Stroke.Kind, то линии будут видны под Windows, но не под Android. Не знаю, чем такой подход может быть вызван.

procedure TForm2.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  I: Integer;
begin
  if Canvas.BeginScene then
    try
      Canvas.Stroke.Thickness := 1.5;
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
      Canvas.Fill.Color := TAlphaColorRec.Black;
      Canvas.Fill.Kind := TBrushKind.bkSolid;

      for I := 1 to 9 do
        Canvas.DrawLine(PointF(50 + I * 25, 0), PointF(50 + I * 25, ClientHeight), 1);
    finally
      Canvas.EndScene;
    end;
end;

Вот, что у меня получилось:

Очевидно, некоторые линии получились толще других. Тот же код под Windows работает идеально.

Причина этого в том, что в отличие от Windows, на Android логический пиксел не всегда совпадает с физическим. И линия, попавшая между физических пикселей «размывается» на соседние, чтобы быть видимой. Таким образом достигается компромисс между точностью и качеством отрисовки.

Если все же нужно нарисовать одинаковые линии, то можно их сдвинуть на половину толщины, чтобы гарантировать их попадание в физические пиксели.

Именно так решает проблему компонент TLine и его предок TShape:

function TShape.GetShapeRect: TRectF;
begin
  Result := LocalRect;
  if FStroke.Kind <> TBrushKind.bkNone then
    InflateRect(Result, -(FStroke.Thickness / 2), -(FStroke.Thickness / 2));
end;

procedure TLine.Paint;
begin
  case FLineType of
    TLineType.ltTop:
      Canvas.DrawLine(GetShapeRect.TopLeft, PointF(GetShapeRect.Right, GetShapeRect.Top),
        AbsoluteOpacity, FStroke);
    TLineType.ltLeft:
      Canvas.DrawLine(GetShapeRect.TopLeft, PointF(GetShapeRect.Left, GetShapeRect.Bottom),
        AbsoluteOpacity, FStroke);
  else
    Canvas.DrawLine(GetShapeRect.TopLeft, GetShapeRect.BottomRight, AbsoluteOpacity, FStroke);
  end;
end;

Изменив код соответствующим образом, можно добиться одинаковости линий:

procedure TForm2.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  I: Integer;
begin
  if Canvas.BeginScene then
    try
      Canvas.Stroke.Thickness := 1.5;
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
      Canvas.Fill.Color := TAlphaColorRec.Black;
      Canvas.Fill.Kind := TBrushKind.bkSolid;

      for I := 1 to 9 do
      begin
        Canvas.DrawLine(PointF(50 + I * 25 - (Canvas.Stroke.Thickness / 2), 0),
          PointF(50 + I * 25 - (Canvas.Stroke.Thickness / 2), ClientHeight), 1);
      end;
    finally
      Canvas.EndScene;
    end;
end;

Результат:

Намного симпатичнее :)

Делать такой сдвиг всегда автоматически нельзя: в таком случае неточность координат приведет к скачкам при анимации. Но все равно хотелось бы видеть какой-то флаг, позволяющий переложить выбор между красотой и точностью на FireMonkey. Довольно утомительно постоянно это делать самостоятельно.

update

Alysson Cunha предложил еще один подход к решению проблемы:

function TForm2.RoundLogicPointsToMatchPixel(const LogicPoints: Single;
  const AtLeastOnePixel: Boolean = False): Single;
var
  ws: IFMXWindowService;
  ScreenScale, Pixels: Single;
begin
  ws := TPlatformServices.Current.GetPlatformService(IFMXWindowService) as IFMXWindowService;
  ScreenScale := ws.GetWindowScale(Self);

  // Maybe you will want to use Ceil or Trunc instead of Round
  Pixels := Round(LogicPoints * ScreenScale);

  if (Pixels < 1) and (AtLeastOnePixel) then
    Pixels := 1.0;

  Result := Pixels / ScreenScale;
end;

procedure TForm2.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  I: Integer;
begin
  if Canvas.BeginScene then
    try
      Canvas.Stroke.Thickness := RoundLogicPointsToMatchPixel(1.0, True);
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
      Canvas.Fill.Color := TAlphaColorRec.Black;
      Canvas.Fill.Kind := TBrushKind.bkSolid;

      for I := 1 to 9 do
        Canvas.DrawLine(PointF(RoundLogicPointsToMatchPixel(50 + I * 25), 0),
          PointF(RoundLogicPointsToMatchPixel(50 + I * 25), ClientHeight), 1);
    finally
      Canvas.EndScene;
    end;
end;