Warning: file_get_contents(/data/phpspider/zhask/data//catemap/9/delphi/8.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
在delphi中绘制曲线箭头_Delphi_Delphi 2010_Shapes - Fatal编程技术网

在delphi中绘制曲线箭头

在delphi中绘制曲线箭头,delphi,delphi-2010,shapes,Delphi,Delphi 2010,Shapes,我想在TCanvas处画一个右箭头,作为Microsoft Word中的形状。 有人知道工作方法吗 绘制复杂图形的简单方法。如果需要抗锯齿,请使用GDIPlus或其他高级图形方式 procedure DrawCurveArrow(ACanvas: TCanvas; AColor: TColor; X0, Y0, Size: Integer); const Magic = 0.552; // constant to approximate circular arc with

我想在TCanvas处画一个右箭头,作为Microsoft Word中的形状。 有人知道工作方法吗


绘制复杂图形的简单方法。如果需要抗锯齿,请使用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);

嗯,看来MBo比我快,他的解决方案比我的好。但我还是会给出我的答案。请注意,它以白色背景计数(MBo的解决方案与背景无关)


画两个圆,矩形和三角形。这是一项简单的几何任务。@Ari0nhh您需要矩形做什么?白色背景?@dummzeuch要切掉更大的圆圈底部。你说的“在microsoft word中”是什么意思?我指的是microsoft word中弯曲的向右箭头状形状
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;