Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.06.2009, 15:50   #1
delacky
 
Регистрация: 10.06.2009
Сообщений: 4
По умолчанию лабороторная по делфи

нужно построить треугольник по точкам на плоскости, и внутри этого треугольника построить второй треугольник. что бы 2 треугольник не выходил за кроя первого треугольника. Помогите сетку закрыть....
delacky вне форума Ответить с цитированием
Старый 10.06.2009, 16:07   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Чего закрыть?
Так что ли?
Код:
procedure TForm1.FormPaint(Sender: TObject);
const a=200;b=100;    q=3;
var p2,p:array of TPoint; i,cx,cy:integer;ang:double;
begin
 cx:=Width div 2;
 cy:=Height div 2;
 ang:=0;
 setlength(p,q+1);  setlength(p2,q+1);
 //Canvas.MoveTo(cx,cy);
 for i:=0 to q-1 do begin
  p[i].X:=Round(cx+a*cos(ang));
  p[i].y:=Round(cy+a*sin(ang));
  p2[i].X:=Round(cx+b*cos(ang));
  p2[i].y:=Round(cy+b*sin(ang));
  ang:=ang+(2*pi/q);
 end;
  p[high(p)].X:=p[0].x;   p[high(p)].y:=p[0].y;
  p2[high(p2)].X:=p2[0].x;   p2[high(p2)].y:=p2[0].y;
 Canvas.Polyline(p);
 Canvas.Polyline(p2);
end;
I'm learning to live...

Последний раз редактировалось Stilet; 10.06.2009 в 16:17.
Stilet вне форума Ответить с цитированием
Старый 10.06.2009, 16:41   #3
delacky
 
Регистрация: 10.06.2009
Сообщений: 4
По умолчанию

может быть. у нас программирование всего пол года. а я со своими знаниями даже не смог запустить то что ты скинул! скинь плиз в личку или выложи полностью листинг!!
delacky вне форума Ответить с цитированием
Старый 10.06.2009, 16:46   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
delacky
Создай в Делфи Application. Далее в Инспекторе Обьектов на вкладке Events найди OnPaint, кликни по его полю дважды - откроется его код, туда мой пример и вставляй.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 10.06.2009, 16:53   #5
delacky
 
Регистрация: 10.06.2009
Сообщений: 4
По умолчанию

ага типа того:-) вот только как его с текстом задания подогнать!!!!
-----------------текст задания
Построить два треугольника с вершинами в заданном множестве точек на плоскости так, чтобы первый треугольник лежал строго внутри второго.
delacky вне форума Ответить с цитированием
Старый 10.06.2009, 17:13   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
чтобы первый треугольник лежал строго внутри второго.
Ну тут нужно перебирать в цикле эти множества, пока площадь одного треугольника не будет меньше площади другого, ИМХО.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 10.06.2009, 17:37   #7
delacky
 
Регистрация: 10.06.2009
Сообщений: 4
По умолчанию

вот есть наброски. но не знаю как можно сюда задать свой кординаты, или кнопку слученные кординаты и построение треугольника!!!
-----------------------------------------------------------------------
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.ClientR ect);
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.
delacky вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Код игры на Паскале и на Делфи сильно отличается? Как переписать код с Паскаля в Делфи? Mclaren Помощь студентам 2 27.04.2009 22:37
БД в делфи Neymexa Помощь студентам 29 29.01.2009 20:32
Делфи Neymexa Помощь студентам 6 20.01.2009 21:29
Из с++ в Делфи Andre1723 Общие вопросы Delphi 4 02.06.2008 17:50
Делфи ozhjog Свободное общение 4 20.05.2007 21:06