Показать сообщение отдельно
  #10  
Старый 10.06.2009, 17:04
ART ART вне форума
Продвинутый
 
Регистрация: 13.02.2006
Адрес: Магнитогорск
Сообщения: 669
Репутация: 14745
По умолчанию

Код:
unit Unit1;

interface

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

type
 TPnt = record
  x, y: real;
 end;

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function WherePoint(a, b, p: TPnt):integer;
var
 S: real;
begin
    S := (b.x - a.x) * (p.y - a.y) - (b.y - a.y) * (p.x - a.x);
    if S > 0 then WherePoint := 1  else
    if S < 0 then WherePoint := -1 else WherePoint := 0;
end;

(* функция определеяет относительное положение точки: внутри или нет *)
function PointInsideTreangle(a, b, c, p: TPnt):boolean;
var
 s1, s2, s3: integer;
begin
    Result := false;
    s1 := WherePoint(a, b, p);
    s2 := WherePoint(b, c, p);
    if s2 * s1 <= 0 then exit;
    s3 := WherePoint(c, a, p);
    if s3 * s2 <= 0 then exit;
    Result := true;
end;

function Min(a, b: real): real;
begin
 if a < b then Result := a else Result := b;
end;

function Max(a, b: real): real;
begin
 if a > b then Result := a else Result := b;
end;

function GetPnt(a, b, c: TPnt; MinX, MinY, MaxX, MaxY: real): TPnt;
var
 P: TPnt;
begin
  repeat
   P.x := MinX + Random(Round(MaxX - MinX));
   P.y := MinY + Random(Round(MaxY - MinY));
  until PointInsideTreangle(a, b, c, p) = true;
 Result := P;
end;

procedure DrawLine(P1, P2: TPnt; Canvas: TCanvas);
begin
 with Canvas do begin
  MoveTo(Round(P1.x), Round(P1.y));
  LineTo(Round(P2.x), Round(P2.y));
 end;
end;

procedure GenerateTriangle(a, b, c: TPnt);
var
 cnt: integer;
 MinX, MinY, MaxX, MaxY: real;
 P1, P2, P3: TPnt;
begin
Randomize;
 MinX := Min(Min(a.x, b.x), c.x);
 MinY := Min(Min(a.y, b.y), c.y);
 MaxX := Max(Max(a.x, b.x), c.x);
 MaxY := Max(Max(a.y, b.y), c.y);
  P1 := GetPnt(a, b, c, MinX, MinY, MaxX, MaxY);
  P2 := GetPnt(a, b, c, MinX, MinY, MaxX, MaxY);
  P3 := GetPnt(a, b, c, MinX, MinY, MaxX, MaxY);
 DrawLine(P1, P2, Form1.Canvas);
 DrawLine(P2, P3, Form1.Canvas);
 DrawLine(P3, P1, Form1.Canvas);
end;

procedure RndPnt(var p: TPnt);
begin
 Randomize;
 p.x := Random(Form1.ClientWidth);
 p.y := Random(Form1.ClientHeight);
end;

procedure Solve;
var
 a, b, c: TPnt;
begin
  Form1.Canvas.FillRect(Form1.ClientRect);
 RndPnt(a);
 RndPnt(b);
 RndPnt(c);
 DrawLine(a, b, Form1.Canvas);
 DrawLine(b, c, Form1.Canvas);
 DrawLine(c, a, Form1.Canvas);
 Application.ProcessMessages;
 GenerateTriangle(a, b, c);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
 Solve;
end;

end.

Ответить с цитированием