[FMX]画个圈圈好过年：在 FMX 中绘制环形

FMX 的 Shape 现在不是很全，至少我想找一个圆环时没找到，所以自己用代码实现了一个，供大家参考：

procedure AddRing(AData: TPathData; const ACenter: TPointF;
  R1, R2, AStartAngle, ASweepAngle: Single);
var
  A, CA, SA, AEndAngle: Single;
begin
  A := AStartAngle * PI / 180;
  SA := sin(A);
  CA := cos(A);
  AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
  AData.AddArc(ACenter, PointF(R1, R1), AStartAngle, ASweepAngle);
  AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
  AData.LineTo(PointF(ACenter.X + R2 * CA, ACenter.Y + R2 * SA));
  AData.AddArc(ACenter, PointF(R2, R2), AStartAngle, ASweepAngle);
  A := (AStartAngle + ASweepAngle) * PI / 180;
  SA := sin(A);
  CA := cos(A);
  AData.LineTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
end;

函数的参数说明：

AData : 用来保存圆环路径信息
ACenter：中心点坐标
R1：内环半径
R2：外环半径
AStartAngle：环的起始角度
ASweepAngle：环的角度增量(夹角）

示例：

procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
var
  AData: TPathData;
begin
  AData := TPathData.Create;
  try
    AddRing(AData, PaintBox1.LocalRect.CenterPoint, 30, 100, 135, FAngle);
    Canvas.BeginScene();
    Canvas.Fill.Color := TAlphaColors.White;
    Canvas.Fill.Kind := TBrushKind.Solid;
    Canvas.Stroke.Kind := TBrushKind.Solid;
    Canvas.Stroke.Color := TAlphaColors.Red;
    Canvas.FillPath(AData, 1);
    if CheckBox1.IsChecked then
      Canvas.DrawPath(AData, 1);
    Canvas.EndScene;
  finally
    FreeAndNil(AData);
  end;
end;

登录