在delphi中绘制曲线箭头
我想在TCanvas处画一个右箭头,作为Microsoft Word中的形状。 有人知道工作方法吗在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
绘制复杂图形的简单方法。如果需要抗锯齿,请使用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;