این سورس کامل درخت فیثاغورث که برای یکی از کاربران تازه وارد قرار داده بودم مثل اینکه ایشون زرنگ تشریف داشتن پس از برداشتن سورس تاپیک رو پاک کردن. توضیحات بیشتر در این تاپیک قرار دارد.http://www.barnamenevis.org/sh...=106906&page=2
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TPoints = Array of TPoint;
Tline = record
p1,p2 : TPoint;
end;
TForm1 = class(TForm)
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
p1,p2 : TPoint;
function NormDegre(Degre : integer):integer;
procedure DrawPoint(Pnts : TPoints);
procedure FillTringle(Pnts : TPoints);
function LineLen(p1,p2 : TPoint) : Integer;
function GetDegre(P1,p2 : TPoint):integer;
function InterSection(P1, p2: TPoint; Deg1, Deg2: Real): TPoint;
procedure DrawTree(p1,p2 : TPoint;counter : integer);
function Square1(p1,p2 : TPoint):TPoints;
function Tringle1(p1,p2 : TPoint):TPoints;
end;
var
Form1: TForm1;
implementation
uses Math, Types;
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
var p1,p2 : TPoint;
begin
p1 := Point(400,400);
p2 := Point(450,400);
DrawTree(p1,p2,1);
end;
function TForm1.InterSection(P1, p2: TPoint; Deg1, Deg2: Real): TPoint;
begin
Deg1 := Tan( DegToRad(Deg1));
Deg2 := Tan(DegToRad(Deg2));
Result.X := round( ((P1.Y - P2.Y)+(Deg2*p2.X- Deg1*P1.X))/(-Deg1+Deg2)) ;
Result.Y :=round( Deg2*(Result.X - P2.X)+P2.Y);
{
Result.X := round((-p1.Y+p2.Y+p1.X*Deg1-p2.X*Deg2)/(Deg1-Deg2));
Result.Y :=round( Deg1*(Result.X - P1.X)+P1.Y);
}
end;
function TForm1.GetDegre(P1, p2: TPoint): Integer;
begin
Result := round( RadToDeg( ArcTan2(p2.Y-p1.Y,p2.X-p1.X)));
if Result <0 then Result := 360 + Result;
end;
function TForm1.LineLen(p1, p2: TPoint):Integer ;
begin
if p2.X = p1.X then Result := abs(p2.Y-p1.Y)
else if p2.Y = p1.Y then Result := abs(p2.x-p1.x)
else Result := trunc( sqrt( sqr(p2.Y-p1.Y)+sqr(p2.X-p1.X)));
end;
procedure TForm1.DrawPoint(Pnts: TPoints);
var i , j : integer;
colors:array[0..2] of byte;
begin
Canvas.Pen.Color := clBlack;
Canvas.MoveTo(Pnts[0].x,Pnts[0].y);
for i := 1 to Length(Pnts)-1 do
Canvas.LineTo(Pnts[i].X,Pnts[i].Y);
Canvas.LineTo(Pnts[0].X,Pnts[0].Y);
if Length(Pnts)=3 then
begin
end;
end;
procedure TForm1.DrawTree(p1,p2 : TPoint;counter : integer);
var SqrPnts ,TringPnts : TPoints;
begin
if counter> 16 then Exit;
counter := counter+1;
SqrPnts := Square1(p1,p2);
DrawPoint(SqrPnts);
TringPnts := Tringle1(SqrPnts[3],SqrPnts[2]);
DrawPoint(TringPnts);
FillTringle(TringPnts);
DrawTree(TringPnts[2],TringPnts[1],counter+1);
DrawTree(TringPnts[0],TringPnts[2],counter+1);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
p1 := Point(-1,-1);
p2 := Point(-1,-1);
end;
function TForm1.NormDegre(Degre: Integer): integer;
begin
Result := Degre;
if Degre< 0 then Result := 360 + Degre
else if Degre> 360 then Result := Degre mod 360;
end;
function TForm1.Square1(p1, p2: TPoint):TPoints;
var G1,G2 : integer;
r : integer;
p3,p4 : TPoint;
begin
G1 := GetDegre(p1,p2);
G2 := GetDegre(p2,p1);
r := LineLen(p1,p2);
SetLength(Result,4);
Result[0] := p1;
Result[1] := p2;
Result[2].X := p2.X+ round( r*cos(DegToRad(NormDegre( g2+90 ))));
Result[2].Y := p2.Y+ round(r*sin(DegToRad(NormDegre( g2+90))));
Result[3].X :=p1.X+ round( r*cos(DegToRad(NormDegre( g1-90) )));
Result[3].Y := p1.Y+ round(r*sin(DegToRad(NormDegre( g1-90) )));
end;
function TForm1.Tringle1(p1, p2: TPoint): TPoints;
var g : Integer;
r , l ,r2 : Real;
begin
SetLength(Result,3);
Result[0] := p1;
Result[1] := p2;
g := GetDegre(p1,p2);
r := LineLen(p1,p2);
r2 := r /2;
l := r2/ sin(DegToRad(45)) ;
Result[2].X := round(p1.X +l*cos(DegToRad(NormDegre( g-45 ))));
Result[2].Y := round(p1.Y +l*sin(DegToRad(NormDegre( g-45 ))));
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if p1.X=-1 then p1 := Point(x,y)
else if p2.X=-1 then p2 := Point(x,y);
if (p1.X<>-1) and (p2.X<>-1) then
begin
Refresh;
DrawTree(p1,p2,1);
p1 := Point(-1,-1);
p2 := Point(-1,-1);
end;
end;
procedure TForm1.FillTringle(Pnts: TPoints);
var
g ,r : integer;
p ,q: TPoint;
tempB : TBrush;
begin
g := GetDegre(Pnts[0],Pnts[1]);
r := LineLen(Pnts[0],Pnts[1]) div 2;
p.X := Pnts[0].X+ round( r*cos(DegToRad(NormDegre( g ))));
p.Y := Pnts[0].Y+ round(r*sin(DegToRad(NormDegre( g))));
g := GetDegre(P,Pnts[2]);
r := LineLen(P,Pnts[2]) div 2;
q.X := P.X+ round( r*cos(DegToRad(NormDegre( g ))));
q.Y := P.Y+ round(r*sin(DegToRad(NormDegre( g))));
// tempB := Canvas.Brush;
// Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBlack;
Canvas.FloodFill(q.X,q.Y,clBlack,fsBorder);
// Canvas.Brush := tempB;
end;
end.
