[DUG] Arc's

Stephen Barker Steve at webdata.co.nz
Tue Jan 18 22:35:03 NZDT 2011


Hi,
 
Try this:
 
procedure DrawCurve;
var
  p1, p2, p3 : TPoint;
  mp1, mp2 : TPoint;  // chord midpoints
  c : TPoint;  // centre of circle
  rad : double; // radius of circle
  r1, r2 : TPoint; // bounding rectangle (square)
  m1, m2 : double; // slope of 2 chords
  x : double; // temp
  angrot, angp1p2, angp2p3 : double;
begin
    SetPenAndBrush;
    DrawingCanvas.Pen.Style := psDash;  // only works if pen width = 1
 
    p1 := MakePoint(Data.tbEntity.FieldByName('Pt1x').AsFloat*Option.Factor,
Data.tbEntity.FieldByName('Pt1y').AsFloat*Option.Factor);
    p2 := MakePoint(Data.tbEntity.FieldByName('Pt2x').AsFloat*Option.Factor,
Data.tbEntity.FieldByName('Pt2y').AsFloat*Option.Factor);
    p3 := MakePoint(Data.tbEntity.FieldByName('Pt3x').AsFloat*Option.Factor,
Data.tbEntity.FieldByName('Pt3y').AsFloat*Option.Factor);
    if ((p1.x = 0) and (p1.y = 0)) and ((p2.x = 0) and (p2.y = 0)) and
((p3.x = 0) and (p3.y = 0)) then begin
      exit;
    end;
    // sanity check - 3 different points
    if ((p1.x = p2.x) and (p1.y = p2.y)) or ((p1.x = p3.x) and (p1.y =
p3.y)) or ((p3.x = p2.x) and (p3.y = p2.y)) then begin
      ErrorMsg('All 3 points on a curve must be different.');
      Data.tbEntity.delete;
      exit;
    end;
 
    // determine direction of curve rotation
    try
      angp1p2 := math.arctan2((p2.y-p1.y), (p2.X-p1.X));
      angp2p3 := math.arctan2((p3.y-p2.y), (p3.X-p2.X));
      angrot := angp2p3 - angp1p2;
    except
      angrot := 0;  // straight line
    end;
    // normalise the angle to between -pi..pi
    if angrot > pi then
      angrot := angrot - 2*pi
    else if angrot < (-pi) then
      angrot := angrot + 2*pi;
    if abs(angrot) < 0.05 then begin
      // Cannot draw a curve through points in a straight line.
      // draw a straight line instead
      DrawingCanvas.MoveTo(p1.x, p1.y);
      DrawingCanvas.LineTo(p3.x, p3.y);
      exit;
    end;
    if angrot > 0 then begin
      // clockwise, so reverse start and end points
      mp1.x := p1.x;
      mp1.y := p1.y;
      p1.x := p3.x;
      p1.y := p3.y;
      p3.x := mp1.x;
      p3.y := mp1.y;
    end;
 
    // chord midpoint between p1 and p2
    mp1.X := (p1.X + p2.X) div 2;
    mp1.Y := (p1.Y + p2.Y) div 2;
    // chord midpoint between p2 and p3
    mp2.X := (p3.X + p2.X) div 2;
    mp2.Y := (p3.Y + p2.Y) div 2;
    // slope of lines 1 and 2
    try
      m1 := 1.0*(p2.y-p1.y)/(p2.x-p1.x);
    except
      m1 := maxint;  // for now (vertical line)
    end;
    try
      m2 := 1.0*(p3.y-p2.y)/(p3.x-p2.x);
    except
      m2 := maxint;  // for now (vertical line)
    end;
    // don't let these slopes quite get to zero
    if (m1 < 0.01) and (m1 > 0) then m1 := 0.01;
    if (m1 > -0.01) and (m1 < 0) then m1 := -0.01;
    if (m2 < 0.01) and (m2 > 0) then m2 := 0.01;
    if (m2 > -0.01) and (m2 < 0) then m2 := -0.01;
 
    // slopes of perpendicular lines, pointing to centre of circle
    try
      m1 := -1/m1;
    except
      m1 := maxint*iif(p3.Y<p2.Y,-1,1);
    end;
    try
      m2 := -1/m2;
    except
      m2 := maxint*iif(p1.Y<p2.Y,-1,1);
    end;
    // x of circle centre
    try
      x := (mp2.y-mp1.y-(m2*mp2.x)+(m1*mp1.x))/(m1-m2);
    except
      // divide by zero, lines are parallel, should never happen but just in
case:
      // draw a straight line instead
      DrawingCanvas.MoveTo(p1.x, p1.y);
      DrawingCanvas.LineTo(p3.x, p3.y);
      exit;
    end;
    // y of circle centre
    c.y := round(mp1.y+m1*(x-mp1.x));
    c.X := round(x);
    // radius
    rad := sqrt(sqr(p2.X-c.x)+sqr(p2.Y-c.Y));
    // bounding square and circle
    r1.x := c.X - round(rad);
    r2.x := c.X + round(rad);
    r1.y := c.y - round(rad);
    r2.y := c.y + round(rad);
 
    DrawingCanvas.Arc(r1.X, r1.y, r2.x, r2.y, p1.x,p1.y,p3.x,p3.y);
 
end;

 
HTH,
Steve


  _____  

From: Marshland Engineering [mailto:marshland at marshland.co.nz] 
Sent: Tuesday, 18 January 2011 9:03 p.m.
To: delphi at delphi.org.nz
Subject: [DUG] Arc's


Is there an easy way of drawing an arc ?  I have center, start and end
co-ordinates as XY. 
 
>From what I can see, I need to look at least 16 combinations to work out the
perimeter size depending in which quadrant the start and ends are in.  
 
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
 
Use Arc to draw an elliptically curved line with the current Pen. The arc
traverses the perimeter of an ellipse that is bounded by the points (X1,Y1)
and (X2,Y2). The arc is drawn following the perimeter of the ellipse,
counterclockwise, from the starting point to the ending point. The starting
point is defined by the intersection of the ellipse and a line defined by
the center of the ellipse and (X3,Y3). The ending point is defined by the
intersection of the ellipse and a line defined by the center of the ellipse
and (X4, Y4).

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://listserver.123.net.nz/pipermail/delphi/attachments/20110118/3cb33f13/attachment.html 


More information about the Delphi mailing list