Ручное добавление точек

Обработчик нажатия на кнопку «Добавить» приведен ниже.

• 1. procedure TForm1. addClick (Sender: TObject);
• 2. var
• 3. x, y: Integer;
• 4. begin
• 5. add_point_str (point_x.Text, point_y.text);
• 6. update_list;
• 7. end;

Здесь происходит вызов процедуры добавления точки в список (add_point_str) и обновление списка точек.

Листинг процедуры add_point_str приведен ниже.

• 1. procedure add_point_str (_x, _y: string);
• 2. var
• 3. x, y: Integer;
• 4. begin
• 5. if not is_digit (_x) or not is_digit (_y)
• 6. then
• 7. begin
• 8. ShowMessage ('Ошибка ввода');
• 9. Exit;
• 10. end;
• 11. x := StrToInt (_x);
• 12. y := StrToInt (_y);
• 13. add_point_int (x, y);
• 14. end;

Здесь проверяется корректность введенных данных (строки 5−10), преобразование строковых координат в числовые и добавление в список процедурой add_point_int.

Поиск квадратов

Для поиска всех квадратов введем функцию, определяющую, возможность построения квадрата с вершинами в точках p1, p2, p3, p4.

• 1. function is_bar (p1, p2, p3, p4: tmypoint): Boolean;
• 2. var d1, d2, d3, d4: double;
• 3. begin
• 4. d1 := distance (p1, p2);
• 5. d2 := distance (p2, p3);
• 6. d3 := distance (p3, p4);
• 7. d4 := distance (p4, p1);
• 8. Result := (d1 = d2) and (d2 = d3) and (d3 = d4) and (d4 = d1) and (d1 0);
• 9. end;

Решение о возможности построить квадрат с координатами в точках p1, p2, p3, p4 принимается на основе следующего утверждения: расстояние между точками p1 и p2 совпадает с расстояниями между точками p2 и p3, p3 и p4, p4 и p1, и при этом это расстояние не равно 0, то возможно построить квадрат с вершинами в точках p1, p2, p3, p4, в противном случае такое построение невозможно.

Процедура distance выглядит следующим образом.

• 1. function distance (p1, p2: tmypoint): Double;
• 2. begin
• 3. Result := (Sqrt (Sqr (p2.x — p1. x) + Sqr (p2.y — p1. y)));
• 4. end;

Процедура, осуществляющая поиск квадратов, выглядит следующим образом.

• 1. procedure gen_bars ();
• 2. var
• 3. i1, i2, i3, i4, acnt: Integer;
• 4. begin
• 5. acnt := 0;
• 6. for i1 := 0 to cnt-1 do
• 7. for i2 := i1+1 to cnt-1 do
• 8. for i3 := i2+1 to cnt-1 do
• 9. for i4 := i3+1 to cnt-1 do
• 10. if is_bar (points[i1], points[i2], points[i3], points[i4])
• 11. then
• 12. begin
• 13. drawbar (points[i1], points[i2], points[i3], points[i4]);
• 14. inc (acnt);
• 15. end;
• 16. ShowMessage (IntToStr (acnt)+' квадратов найдено');
• 17. end;

В результате своей работы процедура выводит на экран число квадратов с вершинами в данных точках, а также рисует их на поле для вывода.

В строке 5 инициализируется значение счетчика квадратов.

В строках 6−9 организуется перебор всех возможных четверок точек.

В строке 10 проверяется, возможно ли построение квадрата с вершинами в текущих координатах.

В случае успешной проверки квадрат рисуется на поле для вывода (строка 13) и увеличивается счетчик квадратов (строка 14).

В строке 16 выводится ответ.

Обработчик нажатия на кнопку «Рассчитать» выглядит следующим образом.

• 1. procedure TForm1. btn1Click (Sender: TObject);
• 2. begin
• 3. gen_bars;
• 4. end;