Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 538
  • Last Modified:

WANTED: Code to clip an arc to a rectangle

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
rwilson032697
Asked:
rwilson032697
  • 11
  • 8
1 Solution
 
JaccoCommented:
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
 
rwilson032697Author Commented:
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
 
JaccoCommented:
Do you need it to be pixel oriented or implemented using real numbers.

Regards Jacco
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
rwilson032697Author Commented:
It needs to be oriented towards real numbers (ie: the real world :-)

Cheers,

Raymond.
0
 
JaccoCommented:
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
 
JaccoCommented:
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
 
JaccoCommented:
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
 
rwilson032697Author Commented:
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
 
rwilson032697Author Commented:
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
 
JaccoCommented:
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
 
rwilson032697Author Commented:
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
 
rwilson032697Author Commented:
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
 
JaccoCommented:
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
 
rwilson032697Author Commented:
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
 
rwilson032697Author Commented:
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
 
rwilson032697Author Commented:
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
 
JaccoCommented:
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
 
rwilson032697Author Commented:
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
 
rwilson032697Author Commented:
Thanks again Jacco.

Cheers,

Raymond.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 11
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now