Solved

WANTED: Code to clip an arc to a rectangle

Posted on 2001-09-02
19
522 Views
Last Modified: 2010-08-05
I want to find a piece of pascal/Delphi source which if given an arc (eg: center point, start angle and end angle, or center, start and end points) and a rectangle returns the parts of the arc which cross the rectangle.

I have a couple of examples in C, but they are quite messy and I would rather not convert them.

Cheers,

Raymond.
0
Comment
Question by:rwilson032697
  • 11
  • 8
19 Comments
 
LVL 10

Expert Comment

by:Jacco
ID: 6457940
Hi Raymond,

I need more info before I can try to make this function.

You mention 2 definitions for the arc:

1) center point, start angle, end angle
2) center, start, end point

These are different arcs. 1) is always circular and 2) can be elliptic. I don't know if you want elliptic too.

Secondly want the parts that "cross" the rectangle. Do you mean the parts inside the rectangle or outside. The result of the function will be an array of arcs?

If you give me some info I am willing to take on this math challenge.

Regards Jacco
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6458859
Jacco,

To answer your queries, the arcs are circular and what I want is the list of arcs which are clipped inside the rectangle (which is usually defined as a MinX/MinY, MaxX, MaxY real value coordinate pair).

As I mentioned in my Q, there are C samples of this code, I of course want a Delphi version and would prefer not to have to convert the C code :-) Finding an example in C is relatively simple via Google...

I suspect there is already a Delphi version somewhere and was hoping someone could point me to it...

Cheers,

Raymond.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6459683
Do you need it to be pixel oriented or implemented using real numbers.

Regards Jacco
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6459773
It needs to be oriented towards real numbers (ie: the real world :-)

Cheers,

Raymond.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6460872
So this would be the correct prototyp?

type
  TSection = record
    StartAngle: Single;
    EndAngle: Single;
  end;

  TSectionList: array of TSection;

procedure ClipArc(
  // arc definition
  aCenterX, aCenterY,
  aRadiusX, aRadiusY,
  aStartAngle, aEndAngle: Single;
  // cliprect
  aMinX, aMinY,
  aMaxX, aMaxY: Single
): TSectionList;
begin
  // implemetation
end;

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6461628
Hi Raymond,

Here are some preliminary results. (I worked on it for an hour or so). I still have to work out some things:

- Doesn't work yet for counterclockwise
- Start en End point can be "in" or "on" rectangle (isn't handled yet)
- constructing the resulting array

I also have some doubts:

- StartAngle and EndAngle should be within 0 .. 2pi?
- Are you confortable with the routine using dynamic arrays?
- What optimization type do you require speed, code size or code elegance?
- I used radian angle maybe you want degrees

I gave you these preliminary results to see if I am not going the wrong way.

Regards Jacco

unit ScreenDrawArcs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ComCtrls;

type
  TFormDrawArcs = class(TForm)
    Image: TImage;
    BitBtnDrawArcs: TBitBtn;
    Memo1: TMemo;
    procedure BitBtnDrawArcsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    fCenterX, fCenterY: Integer;
    fRadiusX, fRadiusY: Integer;
    fStartAngle, fEndAngle: Single;
  public
    { Public declarations }
  end;

var
  FormDrawArcs: TFormDrawArcs;

implementation

uses Math;

{$R *.DFM}

procedure TFormDrawArcs.FormCreate(Sender: TObject);
begin
  fCenterX := 200;
  fCenterY := 200;
  fRadiusX := 190;
  fRadiusY :=  90;
  fStartAngle := 0 * Pi;
  fEndAngle   := 1.8 * Pi;
end;

procedure DrawAngleArc(
  aCanvas: TCanvas;
  aCenterX, aCenterY,
  aRadiusX, aRadiusY: Integer;
  aStartAngle, aEndAngle: Single;
  aClockWise: Boolean = False);
var
  lRect: TRect;
  x1, y1, x2, y2: Integer;
const
  r = 20;
  ArcDirections: array [Boolean] of Integer = (AD_COUNTERCLOCKWISE, AD_CLOCKWISE);
begin
  lRect.Left   := aCenterX - aRadiusX;
  lRect.Top    := aCenterY - aRadiusY;
  lRect.Right  := aCenterX + aRadiusX;
  lRect.Bottom := aCenterY + aRadiusY;
  x1 := aCenterX + Round(cos(aStartAngle) * aRadiusX);
  y1 := aCenterY + Round(sin(aStartAngle) * aRadiusY);
  x2 := aCenterX + Round(cos(aEndAngle) * aRadiusX);
  y2 := aCenterY + Round(sin(aEndAngle) * aRadiusY);
  aCanvas.Rectangle(lRect);
  SetArcDirection(aCanvas.Handle, ArcDirections[aClockWise]);
  with lRect do
    Arc(aCanvas.Handle, Left, Top, Right, Bottom, x1, y1, x2, y2);
end;

type
  TSection = record
    StartAngle: Single;
    EndAngle: Single;
  end;

  TSectionList = array of TSection;

function ClipArc(
  aCanvas: TCanvas;
  // arc definition
  aCenterX, aCenterY,
  aRadiusX, aRadiusY,
  aStartAngle, aEndAngle: Single;
  // cliprect
  aMinX, aMinY,
  aMaxX, aMaxY: Single;
  // direction
  aClockWise: Boolean = False
): TSectionList;
var
  lAngle: Single;
  lY, lX: Single;
  lAngles: array of Single;
  liStartIndex, liEndIndex: Integer;
  i, x, y: Integer;

  procedure AddAngle(aAngle: Single);
  var
    lLength: Integer;
  begin
    // normalize the angle to 0 .. 2 * PI
    if aAngle < 0 then
      aAngle := aAngle + 2 * Pi
    else
      aAngle := aAngle;
    // select only angles on arc
    if (aAngle >= aStartAngle) and
       (aAngle <= aEndAngle) then
    begin
      // add the angle
      lLength := Length(lAngles);
      SetLength(lAngles, lLength + 1);
      lAngles[lLength] := aAngle;
    end;
  end;

  procedure SortAngles(aClockWise: Boolean);
  var
    liCount: Integer;
    lbNoExchanges: Boolean;
    lsEx: Single;

    function Check(const S1, S2: Single): Boolean;
    begin
      if aClockWise then
        Result := S1 > S2
      else
        Result := S1 < S2;
    end;

  begin
    // bubble sort the angles (max 8)
    repeat
      lbNoExchanges := True;
      for liCount:=0 to Length(lAngles) - 2 do
      begin
        if Check(lAngles[liCount], lAngles[liCount + 1]) then
        begin
          lbNoExchanges := False;
          lsEx                 := lAngles[liCount    ];
          lAngles[liCount    ] := lAngles[liCount + 1];
          lAngles[liCount + 1] := lsEx;
        end;
      end;
    until lbNoExchanges;
  end;

  function AngleInRect(aAngle: Single): Boolean;
  var
    lX, lY: Single;
  const
    sTest = 0.0001;
  begin
    Result := False;
    lX := aCenterX + cos(lAngle) * aRadiusX;
    lY := aCenterY + sin(lAngle) * aRadiusY;
    if (lX >= aMinX) or (lX <= aMaxX) then
    begin
      if (lY >= aMinY) or (lY <= aMaxY) then
      begin
        // within OR on rectangle
        if (lY = aMinY) or (lY = aMaxY) or (lX = aMinX) or (lX = aMaxX) then
        begin
          // on rectangle

        end else
          Result := True;
      end;
    end;
  end;

begin
  SetLength(lAngles, 0);
  // do the left line (aMinX, aMinY) - (aMinX, aMaxY)
  if (aMinX >= (aCenterX - aRadiusX)) and
     (aMinX <= (aCenterX + aRadiusX)) then
  begin
    lAngle := ArcCos((aMinX - aCenterX) / aRadiusX);
    lY     := aCenterY + sin(lAngle) * aRadiusY;
    if (lY >=  aMinY) and (lY <= aMaxY) then
      AddAngle(lAngle);
    lAngle := - lAngle;
    lY     := aCenterY + sin(lAngle) * aRadiusY;
    if (lY >=  aMinY) and (lY <= aMaxY) then
      AddAngle(lAngle);
  end;
  // do the top line (aMinX, aMinY) - (aMaxX, aMinY)
  if (aMinY >= (aCenterY - aRadiusY)) and
     (aMinY <= (aCenterY + aRadiusY)) then
  begin
    lAngle := ArcSin((aMinY - aCenterY) / aRadiusY);
    lX     := aCenterX + cos(lAngle) * aRadiusX;
    if (lX >= aMinX) and (lX <= aMaxX) then
      AddAngle(lAngle);
    lAngle := Pi - lAngle;
    lX     := aCenterX + cos(lAngle) * aRadiusX;
    if (lX >= aMinX) and (lX <= aMaxX) then
      AddAngle(lAngle);
  end;
  // do the right line (aMaxX, aMinY) - (aMaxX, aMaxY)
  if (aMaxX >= (aCenterX - aRadiusX)) and
     (aMaxX <= (aCenterX + aRadiusX)) then
  begin
    lAngle := ArcCos((aMaxX - aCenterX) / aRadiusX);
    lY     := aCenterY + sin(lAngle) * aRadiusY;
    if (lY >=  aMinY) and (lY <= aMaxY) then
      AddAngle(lAngle);
    lAngle := - lAngle;
    lY     := aCenterY + sin(lAngle) * aRadiusY;
    if (lY >=  aMinY) and (lY <= aMaxY) then
      AddAngle(lAngle);
  end;
  // do the bottom line (aMinX, aMaxY) - (aMaxX, aMaxY)
  if (aMaxY >= (aCenterY - aRadiusY)) and
     (aMaxY <= (aCenterY + aRadiusY)) then
  begin
    lAngle := ArcSin((aMaxY - aCenterY) / aRadiusY);
    lX     := aCenterX + cos(lAngle) * aRadiusX;
    if (lX >= aMinX) and (lX <= aMaxX) then
      AddAngle(lAngle);
    lAngle := Pi - lAngle;
    lX     := aCenterX + cos(lAngle) * aRadiusX;
    if (lX >= aMinX) and (lX <= aMaxX) then
      AddAngle(lAngle);
  end;
  SortAngles(aClockWise);
  // displaying the results
  aCanvas.Pen.Color := clPurple;
  aCanvas.Rectangle(Round(aMinX), Round(aMinY), Round(aMaxX), Round(aMaxY));
  for i := 0 to Length(lAngles)-1 do
  begin
    // FormDrawArcs.Memo1.Lines.Add(FloatToStrF(lAngles[i], ffFixed, 15, 5));
    x := Round(aCenterX + cos(lAngles[i]) * aRadiusX);
    y := Round(aCenterY + sin(lAngles[i]) * aRadiusY);
    //aCanvas.Pixels[x, y] := clBlack;
    aCanvas.Pen.Color := clBlack;
    aCanvas.Brush.Style := bsClear;
    if not Odd(i) then
      DrawAngleArc(aCanvas, Round(aCenterX), Round(aCenterY), Round(aRadiusX), Round(aRadiusY), lAngles[i], lAngles[i+1], True);
  end;
end;

procedure TFormDrawArcs.BitBtnDrawArcsClick(Sender: TObject);
var
  Bitmap   :  TBitmap;
  BoundRect:  TRect;
  xMin     :  INTEGER;
  xMax     :  INTEGER;
  yMin     :  INTEGER;
  yMax     :  INTEGER;
  x2: Integer;
begin
  xMin := MulDiv(Image.Width,  5, 100);
  xMax := MulDiv(Image.Width, 95, 100);

  yMin := MulDiv(Image.Height, 10, 100);
  yMax := MulDiv(Image.Height, 90, 100);

  for x2 := 60 to 380 do
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Height := Image.Height;
      Bitmap.Width  := Image.Width;

      Bitmap.Canvas.Pen.Color := clSilver;

      DrawAngleArc(Bitmap.Canvas, fCenterX, fCenterY, fRadiusX, fRadiusY, fStartAngle, fEndAngle, True);
      ClipArc(
        Bitmap.Canvas, fCenterX, fCenterY, fRadiusX, fRadiusY, fStartAngle, fEndAngle,
        40, 130, x2, 255,
        True);
      Image.Picture.Graphic := Bitmap;
      Application.ProcessMessages;
      Sleep(10);
    finally
      Bitmap.Free
    end
  end;
end;

end.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6462404
Hi Raymond,

I've cleaned up the code. And most problems are gone now. There only seems to be one tiny thing when the corner of the rectangle is exactly on the arc.

I have optimized for readability and elegance (the routine is fast enough for most purposes).

There seems to be a problem with ClockWise handling on Win ME/95/98. You might have to toggle the boolean a bit. And always pass True.

Regards Jacco

function ClipArc(
 aCanvas: TCanvas;
 // arc definition
 aCenterX, aCenterY,
 aRadiusX, aRadiusY,
 aStartAngle, aEndAngle: Single;
 // cliprect
 aMinX, aMinY,
 aMaxX, aMaxY: Single;
 // direction
 aClockWise: Boolean = False
): TSectionList;
var
  lAngle: Single;
  lAngles: array of Single;
  i, x, y: Integer;

  procedure AddAngle(aAngle: Single);
  var
    lLength: Integer;
  begin
    // normalize the angle to 0 .. 2 * PI
    if aAngle < 0 then
      aAngle := aAngle + 2 * Pi
    else
      aAngle := aAngle;
    // select only angles on arc
    if (aAngle >= aStartAngle) and
       (aAngle <= aEndAngle) then
    begin
      // add the angle
      lLength := Length(lAngles);
      SetLength(lAngles, lLength + 1);
      lAngles[lLength] := aAngle;
    end;
  end;

  procedure AddAnglePair(aStartAngle, aEndAngle: Single);
  var
    lLength: Integer;
  begin
    lLength := Length(Result);
    SetLength(Result, lLength + 1);
    with Result[lLength] do
    begin
      StartAngle := aStartAngle;
      EndAngle   := aEndAngle;
    end;
  end;

  procedure SortAngles(aClockWise: Boolean);
  var
    liCount: Integer;
    lbNoExchanges: Boolean;
    lsEx: Single;

    function Check(const S1, S2: Single): Boolean;
    begin
      if aClockWise then
        Result := S1 < S2
      else
        Result := S1 > S2;
    end;

  begin
    // bubble sort the angles (max 8)
    repeat
      lbNoExchanges := True;
      for liCount:=0 to Length(lAngles) - 2 do
      begin
        if Check(lAngles[liCount], lAngles[liCount + 1]) then
        begin
          lbNoExchanges := False;
          lsEx                 := lAngles[liCount    ];
          lAngles[liCount    ] := lAngles[liCount + 1];
          lAngles[liCount + 1] := lsEx;
        end;
      end;
    until lbNoExchanges;
  end;

  function ValInRange(aProbe, aMin, aMax: Single): Boolean;
  begin
    Result := (aProbe >= aMin) and (aProbe <= aMax);
  end;

  function PtInRect(aX, aY: Single): Boolean;
  begin
    Result := ValInRange(aX, aMinX, aMaxX) and ValInRange(aY, aMinY, aMaxY);
  end;

  function CalcX(aAngle: Single): Single;
  begin
    Result := aCenterX + cos(aAngle) * aRadiusX;
  end;

  function CalcY(aAngle: Single): Single;
  begin
    Result := aCenterY + sin(aAngle) * aRadiusY;
  end;

  procedure IntersectVertical(aX: Single);
  begin
    if ValInRange(aX, aCenterX - aRadiusX, aCenterX + aRadiusX) then
    begin
      lAngle := ArcCos((aX - aCenterX) / aRadiusX);
      if ValInRange(CalcY(lAngle), aMinY, aMaxY) then
        AddAngle(lAngle);
      lAngle := - lAngle;
      if ValInRange(CalcY(lAngle), aMinY, aMaxY) then
        AddAngle(lAngle);
    end;
  end;

  procedure IntersectHorizontal(aY: Single);
  begin
    if ValInRange(aY, aCenterY - aRadiusY, aCenterY + aRadiusY) then
    begin
      lAngle := ArcSin((aY - aCenterY) / aRadiusY);
      if ValInRange(CalcX(lAngle), aMinX, aMaxX) then
        AddAngle(lAngle);
      lAngle := Pi - lAngle;
      if ValInRange(CalcX(lAngle), aMinX, aMaxX) then
        AddAngle(lAngle);
    end;
  end;

begin
  // initialization
  SetLength(lAngles, 0);
  SetLength(Result, 0);
  // process startangle
  if PtInRect(CalcX(aStartAngle), CalcY(aStartAngle)) then
    AddAngle(aStartAngle);
  // process endangle
  if PtInRect(CalcX(aEndAngle), CalcY(aEndAngle)) then
    AddAngle(aEndAngle);
  // intersect the four lines
  IntersectVertical  (aMinX);
  IntersectHorizontal(aMinY);
  IntersectVertical  (aMaxX);
  IntersectHorizontal(aMaxY);
  // sort
  SortAngles(aClockWise);
  // construct result
  for i := 0 to Length(lAngles)-1 do
    if not Odd(i) then
      AddAnglePair(lAngles[i], lAngles[i+1]);
end;
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6462673
Jacco,

You have been busy! To answer your queries:

1. Using 0..2Pi for the angles is fine (ie: radians is fine)

2. I am not really concerned with code size. I appreciate readability/understandability the most. As long as the routine is not 'slow' (what a terribly imprecise term :-) it will be fine. I do not expect serious efforts at speed optimisation.

3. Dynamic arrays are fine - if they become a problem they are easy to change. If you think about it there are a maximum of 10 angles you would need to store (up to 8 edge intersects plus the start/end points) so you could use a static array of 10 elements in those cases.

4. If the algorithm required the arc to be in a clockwise, or anticlockwise sense this would not be a serious problem. It is interesting that particular OSes seem to give you a problem with it.

5. In cases where the arc exactly intersects the point of the rectangle you could resonably say the arc does not intersect it (as the arc is essentially infinitely thin...)

A couple of queries:

1. Why does the cliparc function need a TCanvas?

2. If you use Double instead of Single for the real numbers you will have fewer boundary precision issues (and it will be faster to boot :-)

I hope to have a chance to try the code this afternoon...

Cheers,

Raymond.
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6462680
Oops, forgot to mention the prototype looks fine (but I'd use doubles instead of singles. You only get 7-8 dp with singles and it isn't enough in these situations...

Cheers,

Raymond.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 10

Accepted Solution

by:
Jacco earned 200 total points
ID: 6463147
Hi Raymond.

Here it is. I converted Singles to Doubles. Made it only counter clockwise. (Tested on Win ME). Removed the canvas from ClipArc. (DrawAngleArc is the reference arc routine I used).

The clockwise stuff is quit difficult...

I sure hope this is it for you! ;-)

Regards Jacco

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls, StdCtrls, Buttons, ComCtrls;

type
 TFormDrawArcs = class(TForm)
    Image: TImage;
   Button1: TButton;
    Memo: TMemo;
   procedure BitBtnDrawArcsClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
   fCenterX, fCenterY: Integer;
   fRadiusX, fRadiusY: Integer;
   fStartAngle, fEndAngle: Double;
   fMinX, fMaxX: Integer;
   fMinY, fMaxY: Integer;
 public
   { Public declarations }
 end;

var
 FormDrawArcs: TFormDrawArcs;

implementation

uses Math;

{$R *.DFM}

procedure DrawAngleArc(
  aCanvas: TCanvas;
  aCenterX, aCenterY,
  aRadiusX, aRadiusY: Integer;
  aStartAngle, aEndAngle: Double);
var
  lRect: TRect;
  x1, y1, x2, y2: Integer;
begin
  lRect.Left   := aCenterX - aRadiusX;
  lRect.Top    := aCenterY - aRadiusY;
  lRect.Right  := aCenterX + aRadiusX;
  lRect.Bottom := aCenterY + aRadiusY;
  x1 := aCenterX + Round(cos(aStartAngle) * aRadiusX);
  y1 := aCenterY + Round(sin(aStartAngle) * aRadiusY);
  x2 := aCenterX + Round(cos(aEndAngle) * aRadiusX);
  y2 := aCenterY + Round(sin(aEndAngle) * aRadiusY);
  // aCanvas.Rectangle(lRect);
  if (x1 = x2) and (y1 = y2) then
    Exit;
  with lRect do
    aCanvas.Arc( Left, Top, Right, Bottom, x1, y1, x2, y2);
end;

type
 TSection = record
   StartAngle: Double;
   EndAngle: Double;
 end;

 TSectionList = array of TSection;

function ClipArc(
  // arc definition
  aCenterX, aCenterY,
  aRadiusX, aRadiusY,
  aStartAngle, aEndAngle: Double;
  // cliprect
  aMinX, aMinY,
  aMaxX, aMaxY: Double;
  // direction
  aClockWise: Boolean = False
): TSectionList;
var
  lAngle: Double;
  lAngles: array of Double;
  i, x, y: Integer;

  procedure AddAngle(aAngle: Double);
  var
    lLength: Integer;
  begin
    // normalize the angle to 0 .. 2 * PI
    if aAngle < 0 then
      aAngle := aAngle + 2 * Pi;
    // select only angles on arc
    if (aAngle <= aStartAngle) and
       (aAngle >= aEndAngle) then
    begin
      // add the angle
      lLength := Length(lAngles);
      SetLength(lAngles, lLength + 1);
      lAngles[lLength] := aAngle;
    end;
  end;

  procedure AddAnglePair(aStartAngle, aEndAngle: Double);
  var
    lLength: Integer;
  begin
    lLength := Length(Result);
    SetLength(Result, lLength + 1);
    with Result[lLength] do
    begin
      StartAngle := aStartAngle;
      EndAngle   := aEndAngle;
    end;
  end;

  procedure SortAngles;
  var
    liCount: Integer;
    lbNoExchanges: Boolean;
    lsEx: Double;
  begin
    // bubble sort the angles (max 8)
    repeat
      lbNoExchanges := True;
      for liCount:=0 to Length(lAngles) - 2 do
      begin
        if lAngles[liCount] < lAngles[liCount + 1] then
        begin
          lbNoExchanges := False;
          lsEx                 := lAngles[liCount    ];
          lAngles[liCount    ] := lAngles[liCount + 1];
          lAngles[liCount + 1] := lsEx;
        end;
      end;
    until lbNoExchanges;
  end;

  function ValInRange(aProbe, aMin, aMax: Double): Boolean;
  begin
    Result := (aProbe >= aMin) and (aProbe <= aMax);
  end;

  function PtInRect(aX, aY: Double): Boolean;
  begin
    Result := ValInRange(aX, aMinX, aMaxX) and ValInRange(aY, aMinY, aMaxY);
  end;

  function CalcX(aAngle: Double): Double;
  begin
    Result := aCenterX + cos(aAngle) * aRadiusX;
  end;

  function CalcY(aAngle: Double): Double;
  begin
    Result := aCenterY + sin(aAngle) * aRadiusY;
  end;

  procedure IntersectVertical(aX: Double);
  begin
    if ValInRange(aX, aCenterX - aRadiusX, aCenterX + aRadiusX) then
    begin
      lAngle := ArcCos((aX - aCenterX) / aRadiusX);
      if ValInRange(CalcY(lAngle), aMinY, aMaxY) then
        AddAngle(lAngle);
      lAngle := - lAngle;
      if ValInRange(CalcY(lAngle), aMinY, aMaxY) then
        AddAngle(lAngle);
    end;
  end;

  procedure IntersectHorizontal(aY: Double);
  begin
    if ValInRange(aY, aCenterY - aRadiusY, aCenterY + aRadiusY) then
    begin
      lAngle := ArcSin((aY - aCenterY) / aRadiusY);
      if ValInRange(CalcX(lAngle), aMinX, aMaxX) then
        AddAngle(lAngle);
      lAngle := Pi - lAngle;
      if ValInRange(CalcX(lAngle), aMinX, aMaxX) then
        AddAngle(lAngle);
    end;
  end;

begin
  // initialization
  SetLength(lAngles, 0);
  SetLength(Result, 0);
  // process startangle
  if PtInRect(CalcX(aStartAngle), CalcY(aStartAngle)) then
    AddAngle(aStartAngle);
  // process endangle
  if PtInRect(CalcX(aEndAngle), CalcY(aEndAngle)) then
    AddAngle(aEndAngle);
  // intersect the four lines
  IntersectVertical  (aMinX);
  IntersectHorizontal(aMinY);
  IntersectVertical  (aMaxX);
  IntersectHorizontal(aMaxY);
  // sort
  SortAngles;
  // construct result
  for i :=  0 to Length(lAngles)-1 do
    if not Odd(i) then
      AddAnglePair(lAngles[i], lAngles[i+1]);
end;

procedure TFormDrawArcs.FormCreate(Sender: TObject);
begin
  fCenterX := 200;
  fCenterY := 200;
  fRadiusX := 190;
  fRadiusY :=  90;
  // because of counterclockwise nature start > end
  fStartAngle := 1.9 * Pi;
  fEndAngle   := 0.1 * Pi;
  // arc goes from 1.9 Pi downto 0.1 Pi
  fMinX := 40;
  fMaxX := 380;
  fMinY := 130;
  fMaxY := 255;
end;

var
  bDragging: Boolean = False;
  OfsX, OfsY: Integer;

procedure TFormDrawArcs.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  bDragging := True;
  OfsX := X;
  OfsY := Y;
end;

procedure TFormDrawArcs.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
 Bitmap   :  TBitmap;
 s: TSectionList;
 i: Integer;
begin
  if bDragging then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Height := Image.Height;
      Bitmap.Width  := Image.Width;
      fMinX := fMinX + X - OfsX;
      fMaxX := fMaxX + X - OfsX;
      fMinY := fMinY + Y - OfsY;
      fMaxY := fMaxY + Y - OfsY;
      OfsX := X;
      OfsY := Y;
      s := ClipArc(fCenterX, fCenterY, fRadiusX, fRadiusY, fStartAngle, fEndAngle,
        fMinX, fMinY, fMaxX, fMaxY, True);
      // displaying the results
      with Bitmap.Canvas do
      begin
        Pen.Color := clGreen;
        Rectangle(fMinX, fMinY, fMaxX, fMaxY);
        for i := 0 to Length(s)-1 do
        begin
          Pen.Color := clRed;
          Brush.Style := bsClear;
          DrawAngleArc(Bitmap.Canvas, fCenterX, fCenterY, fRadiusX, fRadiusY, s[i].StartAngle, s[i].EndAngle);
        end;
      end;
      Image.Picture.Graphic := Bitmap;
      Application.ProcessMessages;
    finally
      Bitmap.Free
    end
  end;
end;

procedure TFormDrawArcs.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDragging := False;
end;

procedure TFormDrawArcs.BitBtnDrawArcsClick(Sender: TObject);
var
 Bitmap   :  TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Height := Image.Height;
    Bitmap.Width  := Image.Width;
    Bitmap.Canvas.Pen.Color := clSilver;
    DrawAngleArc(Bitmap.Canvas, fCenterX, fCenterY, fRadiusX, fRadiusY, fStartAngle, fEndAngle);
    Image.Picture.Graphic := Bitmap;
  finally
    Bitmap.Free
  end
end;

end.
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6463195
Thanks Jacco. I bolted the previous version of the code in and it compiled just fine (didn't get a chance to run any real data through it yet though, might have to wait until Monday (its Friday night here)).

Looks like you have done a good job!

I'll let you know how it goes...

Cheers,

Raymond.
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469082
Jacco,

Could you include the DFM file (as text) for the form you code above uses. Would be nice to play with your test program :-)

Cheers,

Raymond.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6469088
Sure Raymond,

Here it is.

Regards Jacco

object FormDrawArcs: TFormDrawArcs
  Left = 192
  Top = 107
  Width = 696
  Height = 510
  Caption = 'FormDrawArcs'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Image: TImage
    Left = 16
    Top = 8
    Width = 649
    Height = 313
    OnMouseDown = ImageMouseDown
    OnMouseMove = ImageMouseMove
    OnMouseUp = ImageMouseUp
  end
  object Button1: TButton
    Left = 16
    Top = 368
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = BitBtnDrawArcsClick
  end
  object Memo: TMemo
    Left = 480
    Top = 328
    Width = 185
    Height = 153
    Lines.Strings = (
      'Memo')
    TabOrder = 1
  end
end
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469103
Hi again :-)

Threw some real data at the arc clipper and discovered a problem (though easily fixed). The loop that adds arc sections to the list should look like this:

 // construct result
 for i := 0 to Length(lAngles)-2 do
   if not Odd(i) then
     AddAnglePair(lAngles[i], lAngles[i+1]);

(Note the -2 instead of -1) This should have exploded the first time it tried to clip an arc to your rectangle and got some clipped sections!

Cheers,

Raymond.
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469143
Jacco,

Just ran your program, and it appears to run fine, with no range check errors, which is quite strange!

Can you tell me what went wrong when the arc was anticlockwise?

Cheers,

Raymond.


0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469157
Just tried running your program with the angles set up in an anti-clockwise direction and it does do odd things, doesn't it!?

It's easy enough to swap the start and end angles on entry to the function so I will do that :-)

Cheers,

Raymond.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6469205
The problems I had with clock vs anticlockwise are that Windows 95/98/ME do not support them. Secondly the ordering of the angle is different then. If there is an arc starting at 0.2 ending at 0.5 the arc windows draws goes backwards from 0.2 through the whole circle so its harder to find out what angle do and what angle do notr intersect.

Since you said you did'nt need the feature I didn't put much effort in it solving that problem.

I guess you are not using the GDI arc funtion to draw the arcs. During the testing I saw some pretty weird things. I doesn't all seem to work like it is documented.

Regards Jacco
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469234
Ah yes - the wonders of compatibility between different windows OSes (and XP will only make it worse :-)

We draw arcs ourselves to avoid icky GSI API naties so you are right, this is not a problem for us.

Actually, making any necessary changes to the list of start/end angles that come out is simple so if I really need the function to 'honour' the original sense of the arc in its clipped arcs this is no problem.

I still don't understand why your sample program doesn't object to the index out of bound exception???

This all looks pretty good so here come your points!

Cheers,

Raymond.
0
 
LVL 12

Author Comment

by:rwilson032697
ID: 6469235
Thanks again Jacco.

Cheers,

Raymond.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Suggested Solutions

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now