Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 19.01.2015, 16:56   #1 (permalink)
winowl
Новичок
 
Регистрация: 14.01.2015
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Помогите соединить в одно целое. Есть 4 часа времени

Составить программу, которая использует модуль. В модуле разработать подпрограммы для работы с декартовой плоскостью: принадлежность точки прямой, отрезку, многоугольнику. И добавте, пожалуйста, принадлежность прямой

Код:
Program geom3;
Const _Eps: Real = 1e-3; {точность вычислений}
var x1,y1,x2,y2,x,y:real;
Function RealEq(Const a, b:Real):Boolean; {строгоравно}
begin
RealEq := Abs(a-b)<= _Eps
End; {RealEq}

Function RealMoreEq(Const a, b:Real):Boolean; {большеилиравно}
begin
RealMoreEq := a - b >= _Eps
End; {RealMoreEq}

Function EqPoint(x1,y1,x2,y2:real):Boolean;
{Совпадают ли две точки на плоскости}
begin
EqPoint:=RealEq(x1,x2)and RealEq(y1,y2)
end; {EqPoint}
Function AtOtres(x1,y1,x2,y2,x,y:real):Boolean;
{Проверка принадлежности точки P отрезку P1P2}
Begin
  If EqPoint( x1,y1,x2,y2)
    Then  AtOtres:=  EqPoint( x1,y1,x,y)
{точки P1 и P2 совпадают, результат определяется совпадением точек P1 и P}
Else
AtOtres := RealEq((x-x1)*(y2-y1)- (y-y1)*(x2-x1),0)and (RealMoreEq(x,x1)and
RealMoreEq( x2,x)Or RealMoreEq(x,x2)and RealMoreEq( x1,x))
end;  {AtOtres}

begin {main}
writeln('Введитекоординатыточек: x1,y1,x2,y2,x,y');
  readln( x1,y1,x2,y2,x,y);
  if  AtOtres(x1,y1,x2,y2,x,y)
    then writeln('Да.')
    else writeln('Нет.' );
end.  {main}
 
program geom5;
Const n=9; {Количествоточек+1}
_Eps: Real=1e-4; {точность вычислений}
type b=record
          x,y:real;
       end;
     myArray= array[1..n] of b;
var
    input:text;
    x,y:real;
    i:integer;
    a:myArray;

procedure zapmas;
begin
  assign(input,'input.pas');
  reset(input);
  for i:=1 to n-1 do
    read(input, a[i].x,a[i].y);
  readln(input, x,y);
  close(input);
end;

function RealLess(Const a, b: Real): Boolean; {строгоменьше}
begin
  RealLess := b-a> _Eps
end; {RealLess}

function VektorMulti(ax,ay,bx,by:real): real;
{Векторноепроизведениевекторов}
...
end;
Function LinesCross(x1,y1,x2,y2,x3,y3,x4,y4:real): boolean;
{Пересекаютсялиотрезки?}
...
end;

function InsidePoint(a:myArray):Boolean;
{Проверка принадлежности точки многоугольнику}
var i,k,nom: integer;
maxx:real;
begin
  k:=0;
  maxx:=a[1].x;
  nom:=1;
  for i:=2 to n-1 do
       if maxx < a[i].x then begin maxx:=a[i].x;nom:=i;end;
  a[n].x:=a[1].x;   a[n].y:=a[1].y;
  for i:=1 to n-1 do
    if LinesCross(a[i].x,a[i].y,a[i+1].x,a[i+1].y,x,y,a[nom].x+1,a[nom].y)
      then k:=k+1;
  if k mod 2 <> 0
    then  InsidePoint:= true
    else  InsidePoint:= false;
end;

begin {main}
  zapMas;
  if InsidePoint(a)
then  writeln('Точка внутри многоугольника.')
    else  writeln('Точка вне многоугольнка.)
end.
winowl вне форума   Ответить с цитированием

Старый 19.01.2015, 16:56
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Проблему решать гораздо проще, если набраться информации из подобных постов

Помогите, пожалуйста, соединить две программы в Паскале
Помогите сделать реле времени
Помогите соединить, пожалуйста
Помогите правильно соединить детали
Что-то сажает батарейку за 3 часа
Целое натуральное, рекурсия, Паскаль

Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 16:21.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.