1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
| program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows, Math;
Type
TPoint = Record
X,Y : Extended;
End;
Procedure VvodCoor(Prompt:String;Var V:Extended);
Var
s : String;
i : Integer;
Begin
Repeat
Write(Prompt);
ReadLn(s);
Val(s,V,i);
If i=0 Then Break;
WriteLn('Значение набрано неправильно !!!');
Until False;
End;
Var
A,B,C,D : TPoint;
k1,b1,k2,b2,x,y : Extended;
s : String;
begin
//Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
//Если после переключения русские буквы показываются неверно,
//следует открыть системное меню консольного окна - щелчком мыши в левом
//верхнем углу окна консоли и выбрать:
//Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
SetConsoleOutputCp(1251);
SetConsoleCP(1251);
WriteLn('Введите координаты концов отрезка [A,B]');
VvodCoor('A.X > ',A.X);
VvodCoor('A.Y > ',A.Y);
VvodCoor('B.X > ',B.X);
VvodCoor('B.Y > ',B.Y);
WriteLn('Введите координаты концов отрезка [C,D]');
VvodCoor('C.X > ',C.X);
VvodCoor('C.Y > ',C.Y);
VvodCoor('D.X > ',D.X);
VvodCoor('D.Y > ',D.Y);
WriteLn;
//Подготовка...
If A.X>B.X Then
//Поменяем местами
Begin
k1:=A.X; k2:=A.Y;
A:=B;
B.X:=k1; B.Y:=k2;
s:='BA'; //Для корректной выдачи отрезков
End Else s:='AB';
If C.X>D.X Then
//Поменяем местами
Begin
k1:=C.X; k2:=C.Y;
C:=D;
D.X:=k1; D.Y:=k2;
s:=s+'DC';
End Else s:=s+'CD';
If (B.X-A.X)=0 Then
//Отрезок [A,B] параллелен оси OY
Begin
k1:=INFINITE; //Бесконечность
b1:=A.X;
End Else
Begin
//Коэффициент наклона прямой A-B
//к оси OX координат
k1:=(B.Y-A.Y)/(B.X-A.X);
//Смещение по оси OY
b1:=A.Y-k1*A.X;
End;
If (C.X-D.X)=0 Then
//Отрезок [C,D] параллелен оси OY
Begin
k2:=INFINITE; //Бесконечность
b2:=C.X;
End Else
Begin
//Коэффициент наклона прямой C-D
//к оси OX координат
k2:=(D.Y-C.Y)/(D.X-C.X);
//Смещение по оси OY
b2:=C.Y-k2*C.X;
End;
//Проверяем пересекаемость...
If k1=k2 Then
//Прямые, на которых лежат отрезки, параллельны
Begin
If b1=b2 Then
//Праллельные отрезки лежат на одной прямой
//Могут пересекаться
Begin
If ((A.X>=C.X) And (A.X<=D.X)) Then
WriteLn('Отрезки накладываются - отрезок [',s[1],',',s[4],']') Else
If ((B.X>=C.X) And (B.X<=D.X)) Then
WriteLn('Отрезки накладываются - отрезок [',s[3],',',s[2],']') Else
WriteLn('Отрезки не пересекаются...');
End Else
WriteLn('Отрезки не пересекаются...');
End Else
//Прямые, на которых лежат отрезки, пересекаются в одной точке
// y = k1*x + b1 => x * ( k1 - k2 ) = b2 - b1
// y = k2*x + b2 Решим СЛАУ =>
// x = ( b2 - b1 ) / ( k1 - k2 )
Begin
//Проверим, лежит ли точка на отрезке...
If k1=INFINITE Then
//Отрезок [A,B] параллелен оси OY
Begin
x:=b1; //Координата X точки пересечения прямых
y:=k2*x+b2; //Координата Y
End Else
If k2=INFINITE Then
//Отрезок [C,D] параллелен оси OY
Begin
x:=b2; //Координата X точки пересечения прямых
y:=k1*x+b1; //Координата Y
End Else
Begin
x:=(b2-b1)/(k1-k2); //Координата X точки пересечения прямых
y:=k1*x+b1; //Координата Y
End;
//Проверка лежит ли точка на обоих отрезках
If InRange(x, Min(A.X,B.X), Max(A.X,B.X)) And
InRange(y, Min(A.Y,B.Y), Max(A.Y,B.Y)) And
InRange(x, Min(C.X,D.X), Max(C.X,D.X)) And
InRange(y, Min(C.Y,D.Y), Max(C.Y,D.Y)) Then
WriteLn('Отрезки пересекаются в точке : [',x:5:2,y:5:2,']') Else
WriteLn('Отрезки не пересекаются...');
End;
ReadLn;
end. |
(
Сообщение было отмечено Hlor007 как решение
