在delphi中绘制弯曲的箭头

Question

我想在TCanvas上绘制一个弯曲的右箭头作为Microsoft Word中的形状。 有人知道一种工作方法吗？

Answer 1

绘制复杂数字的简单方法。如果需要抗锯齿，请使用GDIPlus或其他高级图形方法。

  procedure DrawCurveArrow(ACanvas: TCanvas; AColor: TColor;
    X0, Y0, Size: Integer);
  const
    Magic = 0.552; // constant to approximate circular arc with Bezier curve
  var
    Pt: array of TPoint;
    Flags: array of Byte;
    R, RMag: Integer;
  begin
    SetLength(Pt, 18);
    SetLength(Flags, 18);
    R := 5 * Size div 16;
    RMag := Round(R * Magic);

    Pt[0] := Point(X0 + 1, Y0); // to thicken tail a bit
    Flags[0] := PT_MOVETO;
    Pt[1] := Point(X0 + 1, Y0 - RMag);
    Flags[1] := PT_BEZIERTO;
    Pt[2] := Point(X0 + R - RMag, Y0 - R);
    Flags[2] := PT_BEZIERTO;
    Pt[3] := Point(X0 + R, Y0 - R);
    Flags[3] := PT_BEZIERTO;
    Pt[4] := Point(X0 + R + RMag, Y0 - R);
    Flags[4] := PT_BEZIERTO;
    Pt[5] := Point(X0 + 2 * R, Y0 - RMag);
    Flags[5] := PT_BEZIERTO;
    Pt[6] := Point(X0 + 2 * R, Y0);
    Flags[6] := PT_BEZIERTO;

    Pt[7] := Point(X0 + Size div 2, Y0);
    Flags[7] := PT_LINETO;
    Pt[8] := Point(X0 + Size * 3 div 4, Y0 + Size div 4);
    Flags[8] := PT_LINETO;
    Pt[9] := Point(X0 + Size, Y0);
    Flags[9] := PT_LINETO;
    Pt[10] := Point(X0 + 7 * Size div 8, Y0);
    Flags[10] := PT_LINETO;

    R := 7 * Size div 16;
    RMag := Round(R * Magic);
    Pt[11] := Point(X0 + 2 * R, Y0 - RMag);
    Flags[11] := PT_BEZIERTO;
    Pt[12] := Point(X0 + R + RMag, Y0 - R);
    Flags[12] := PT_BEZIERTO;
    Pt[13] := Point(X0 + R, Y0 - R);
    Flags[13] := PT_BEZIERTO;
    Pt[14] := Point(X0 + R - RMag, Y0 - R);
    Flags[14] := PT_BEZIERTO;
    Pt[15] := Point(X0, Y0 - RMag);
    Flags[15] := PT_BEZIERTO;
    Pt[16] := Point(X0, Y0);
    Flags[16] := PT_BEZIERTO;
    Pt[17] := Point(X0 + 1, Y0);
    Flags[17] := PT_LINETO or PT_CLOSEFIGURE;

    BeginPath(ACanvas.Handle);
    PolyDraw(ACanvas.Handle, Pt[0], Flags[0], Length(Pt));
    EndPath(ACanvas.Handle);
    ACanvas.Brush.Color := AColor;
    FillPath(ACanvas.Handle);
  end;

begin
  DrawCurveArrow(Canvas, clBlue, 100, 200, 300);

Answer 2

好吧，似乎MBo比我快，他的解决方案比我好。但无论如何我会回答我的问题。请注意，它以白色背景计数（MBo的解决方案与背景无关）。

procedure draw_arrow(canvas: TCanvas; x, y, size: Integer; color: TColor);
begin
  with canvas do
  begin
    Pen.Style:=psClear;
    Brush.Style:=bsSolid;
    Brush.Color:=color;
    Ellipse(x+1, y, x+size+1, y+size);
    Brush.Color:=clWhite;
    Ellipse(x, y+size div 6, x+Round(size/1.5), y+Round(size/1.2));
    Rectangle(x, y+size div 2, x+size+1, y+size);
    Brush.Color:=color;
    Polygon([Point(x+size div 2, y+size div 2), Point(x+size div 2+Round(size/1.5), y+size div 2), Point(x+size-size div 6, y+Round(size/1.2))]);
  end;
end;