How to get smooth subpixel animation when animating TCircle widths?

When I animate the TCircle position, the animation is smooth and appears to occur in sub-pixel increments / decrements. However, when I animate the width (or / and height) of TCircle, the animation progresses in increments of pixels, making it much smoother.

This is especially striking when performing slow animations, when the positions (X and Y), Width and Height are simultaneously animated, creating a zooming effect. The left and upper parts of the circle smoothly change outward, and the right and lower parts are abrupt.

I can’t understand why this is happening. All suggestions are greatly appreciated.

(btw, this does not happen when Scale.X and Scale.Y are animated. Smooth, but I do not want the stroke thickness to scale, therefore, using width and height)

(using XE2)

TForm code for demo:

object Form6: TForm6
  Left = 0
  Top = 0
  Caption = 'Form6'
  ClientHeight = 821
  ClientWidth = 1108
  Visible = False
  StyleLookup = 'backgroundstyle'
  object cirPulse: TCircle
    Position.Point = '(352,192)'
    Width = 200.000000000000000000
    Height = 200.000000000000000000
    Fill.Kind = bkNone
    StrokeThickness = 10.000000000000000000
    object FloatAnimation1: TFloatAnimation
      Enabled = True
      Duration = 50.000000000000000000
      StartFromCurrent = True
      StopValue = 400.000000000000000000
      PropertyName = 'Width'
    end
    object FloatAnimation2: TFloatAnimation
      Enabled = True
      Duration = 50.000000000000000000
      StartFromCurrent = True
      StopValue = 400.000000000000000000
      PropertyName = 'Height'
    end
    object FloatAnimation3: TFloatAnimation
      Enabled = True
      Duration = 50.000000000000000000
      StartFromCurrent = True
      StopValue = 252.000000000000000000
      PropertyName = 'Position.X'
    end
    object FloatAnimation4: TFloatAnimation
      Enabled = True
      Duration = 50.000000000000000000
      StartFromCurrent = True
      StopValue = 92.000000000000000000
      PropertyName = 'Position.Y'
    end
  end
end
+4
source share
1 answer

I seem to have solved this problem, as far as I can tell so far by changing the following line in the FMX.Types module,

function FitRect(var R: TRectF; BoundsRect: TRectF): Single;

Edit

if ratio < 1 then
begin
  R := RectF(0, 0, RectWidth(R), RectHeight(R));
end
else
begin
  R := RectF(0, 0, round(RectWidth(R) / ratio), round(RectHeight(R) / ratio));
end;

at

if ratio < 1 then
begin
  R := RectF(0, 0, RectWidth(R), RectHeight(R));
end
else
begin
  R := RectF(0, 0, RectWidth(R) / ratio, RectHeight(R) / ratio);
end;

Therefore, getting rid of Round.

Not tested enough to detect side effects.

+5
source

All Articles