[Lazarus] Drawing angle boundaries

Leonardo M. Ramé l.rame at griensu.com
Fri Jun 24 14:17:33 CEST 2011


On 2011-06-24 10:32:57 +0100, Howard Page-Clark wrote:
> On 23/6/11 1:11, Leonardo M. Ramé wrote:
> >Hi, I need to draw the angle(s) formed by any given four points.
> >
> >As you can see in the attached image, there are two crossed lines and an
> >skewed-rotated ellipse that touches all four points, then between each
> >two points and the cross point I would like to draw the angle formed (in
> >the example filled in blue).
> >
> >Does anyone knows how can I do this?.
> 
> Try the attached unit, for which the .lpr is as follows:
> 
> program pAngleDrawing;
> 
> {$mode objfpc}{$H+}
> 
> uses
>   {$IFDEF UNIX}{$IFDEF UseCThreads}
>   cthreads,
>   {$ENDIF}{$ENDIF}
>   Interfaces, // this includes the LCL widgetset
>   Forms, uAngleDrawing;
> 
> {$R *.res}
> 
> begin
>   RequireDerivedFormResource := True;
>   Application.Initialize;
>   Application.CreateForm(TForm1, Form1);
>   Application.Run;
> end.
> 
> It's a bit buggy and has no error checking for impossible point values, but
> should give you some ideas (uAngleDrawing.lfm is just an empty form).
> 
> Howard

> unit uAngleDrawing;
> 
> {$mode objfpc}{$H+}
> 
> interface
> 
> uses
>   Classes, Forms, Graphics, Dialogs,
>   ExtCtrls;
> 
> type
> 
>   TPointArray = array[0..3] of TPoint;
> 
>   { Tquad }
> 
>   Tquad = class
>   private
>     FCanvas: TCanvas;
>     Fa, Fb, Fc, Fd, FIntersection: TPoint;
>     FcAD, FcBC: integer;
>     FmAD, FmBC: double;
>     function Yad(anX: integer): integer;
>     function Ybc(anX: integer): integer;
>     function InterSecAdBc: TPoint;
>   public
>     constructor Create(aCanvas: TCanvas; const dataPoints: array of TPoint);
>     procedure DrawAngleAB(col: TColor);
>     procedure DrawAngleBC(col: TColor);
>     procedure DrawAngleCD(col: TColor);
>     procedure DrawAngleDA(col: TColor);
>     property a: TPoint read Fa write Fa;
>     property b: TPoint read Fb write Fb;
>     property c: TPoint read Fc write Fc;
>     property d: TPoint read Fd write Fd;
>     property mAD: double read FmAD;
>     property mBC: double read FmBC;
>     property cAD: integer read FcAD;
>     property cBC: integer read FcBC;
>   end;
> 
>   { TForm1 }
> 
>   TForm1 = class(TForm)
>     procedure FormCreate(Sender: TObject);
>     procedure FormDestroy(Sender: TObject);
>   private
>     FQuad: Tquad;
>     FTimer: TTimer;
>   public
>     procedure DrawAngles(Sender: TObject);
>   end; 
> 
> const ARR: TPointArray = (
>            (x:6; y:7), (x:204; y:13), (x:23; y:245), (x:290; y:275) );
> 
> var
>   Form1: TForm1; 
> 
> implementation
> 
> uses math;
> 
> { TForm1 }
> 
> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   FQuad:= Tquad.Create(Self.Canvas, ARR);
>   FTimer := TTimer.Create(self);
>   FTimer.Interval:= 300;
>   FTimer.OnTimer:= @DrawAngles;
>   FTimer.Enabled:= True;
> end;
> 
> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>   FQuad.Free;
> end;
> 
> procedure TForm1.DrawAngles(Sender: TObject);
> begin
>   FQuad:= Tquad.Create(Self.Canvas, ARR);
>   Randomize;
>   FQuad.DrawAngleAB(Random(High(TColor)));
>   FQuad.DrawAngleBC(Random(High(TColor)));
>   FQuad.DrawAngleCD(Random(High(TColor)));
>   FQuad.DrawAngleDA(Random(High(TColor)));
> end;
> 
> {$R *.lfm}
> 
> { quad }
> 
> function Tquad.Yad(anX: integer): integer;
> begin
>   result := Round(FmAD*anX) + FcAD;
> end;
> 
> function Tquad.Ybc(anX: integer): integer;
> begin
>   result := Round(FmBC*anX) + FcBC;
> end;
> 
> function Tquad.InterSecAdBc: TPoint;
> var x, mi, ma, diff: integer;
> begin
>   result := Point(0,0);
>   mi := Min(b.x, c.x);
>   ma := Max(b.x, c.x);
>   if (ma = mi) then begin ShowMessage('Points must be distinct!'); Exit; end;
>   for diff := 0 to mi do
>   for x := mi to ma do
>    begin
>    if (Yad(x) - Ybc(x) = diff) then
>     begin
>       result.x:= x;
>       Result.y:= Ybc(x);
>       Exit;
>     end;
>    end;
>   ShowMessage('No exit from Intersection loop!');
> end;
> 
> constructor Tquad.Create(aCanvas: TCanvas; const dataPoints: array of TPoint);
> begin
>   inherited Create;
>   FCanvas := aCanvas;
>   Fa := dataPoints[0];
>   Fb := dataPoints[1];
>   Fc := dataPoints[2];
>   Fd := dataPoints[3];
> 
>   FmBC:= (b.y - c.y) / (b.x - c.x);
>   FcBC:= ((b.y + c.y) - Round(FmBC * (b.x + c.x))) div 2;
>   FmAD:= (a.y - d.y) / (a.x - d.x);
>   FcAD:= ((a.y + d.y) - Round(FmAD * (a.x + d.x))) div 2;
>   FIntersection := InterSecAdBc;
> end;
> 
> procedure Tquad.DrawAngleAB(col: TColor);
> begin
>  FCanvas.Pen.Color:= col;
>   FCanvas.MoveTo(a);
>   FCanvas.LineTo(FIntersection);
>   FCanvas.LineTo(b);
> end;
> 
> procedure Tquad.DrawAngleBC(col: TColor);
> begin
>   FCanvas.Pen.Color:= col;
>   FCanvas.MoveTo(b);
>   FCanvas.LineTo(FIntersection);
>   FCanvas.LineTo(c);
> end;
> 
> procedure Tquad.DrawAngleCD(col: TColor);
> begin
>   FCanvas.Pen.Color:= col;
>   FCanvas.MoveTo(c);
>   FCanvas.LineTo(FIntersection);
>   FCanvas.LineTo(d);
> end;
> 
> procedure Tquad.DrawAngleDA(col: TColor);
> begin
>   FCanvas.Pen.Color:= col;
>   FCanvas.MoveTo(d);
>   FCanvas.LineTo(FIntersection);
>   FCanvas.LineTo(a);
> end;
> 
> end.
> 

Thanks Howard, now I'll have to figure out how to draw the Arc between
angle extremes and the center point.

-- 
Leonardo M. Ramé
http://leonardorame.blogspot.com




More information about the Lazarus mailing list