Howard Page-Clark wrote 210 lines
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.
