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.

--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus

Reply via email to