25 Şubat 2007

İki doğru arasındaki açıyı bulan program

Delphi'de hazırladığımız bir projenin küçük bir parçasının algoritmasını test etmek için hazırladığım bir program

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Math;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject;
      Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  noktasay: byte;
  x1,y1,x2,y2: integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  noktasay :=0;
end;

procedure TForm1.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ab,bc,ac,x3,y3 : integer;
  aci : real;
begin
  noktasay:=succ(noktasay);
  if (noktasay>3) then noktasay:=1;
  if (noktasay=1) then
  begin
    //Birinci nokta yani A noktası
    //Ekranı temizle
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(Canvas.ClipRect);
    x1:=x;
    y1:=y;
    form1.Canvas.MoveTo(x1,y1);
    label2.Caption:='A'+#13+inttostr(x1)+' '+inttostr(y1);
  end;
  if (noktasay=2) then
  begin
    //İkinci nokta yani B noktası
    x2:=x;
    y2:=y;
    form1.Canvas.LineTo(x2,y2);
    label3.Caption:='B'+#13+inttostr(x2)+' '+inttostr(y2);
  end;
  if (noktasay=3) then
  begin
    //Üçüncü nokta yani C noktası
    x3:=x;
    y3:=y;
    form1.Canvas.LineTo(x3,y3);
    label4.Caption:='C'+#13+inttostr(x3)+' '+inttostr(y3);
    //AB doğrusu ile BC doğrusu arasındaki açıyı bulmak için
    //kullandığımız formül
    ab:=sqr(x1-x2)+sqr(y1-y2);
    bc:=sqr(x2-x3)+sqr(y2-y3);
    ac:=sqr(x1-x3)+sqr(y1-y3);
    aci:=radtodeg(arccos((ab+bc-ac)/(2*sqrt(ab)*sqrt(bc))));
    label1.Caption:='Açı= '+ floattostr(aci);
  end;
end;

end.