2016-06-21 22 views
-2

Microsoft WordでTCanvasに曲線の右矢印をシェイプとして描画します。 誰かが作業方法を知っていますか?デルファイの曲線矢印を描く

enter image description here

+2

2つの円、長方形、三角形を描画します。これは単純な幾何学的な作業です。 – Ari0nhh

+0

@ Ari0nhh何のために矩形が必要ですか?白色の背景? – dummzeuch

+1

@dummzeuch大きな円の底を切り取る。 – Ari0nhh

答えて

5

複雑な図形を描画するための簡単な方法。アンチエイリアスが必要な場合は、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); 
3

さて、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; 
関連する問題