Соединение всех нечетных точек линией

LeX_K@R

Здравствуйте! Помогите, пожалуйста, разобраться с одним несложным заданием. Вот условие: "На форму поместить N точек (каждая точка помещается на форму по нажатию левой кнопки мыши и имеет номер 1..N). Вычислить расстояния между всеми парами точек с нечетными номерами. Начало работы алгоритма по нажатию правой кнопки мыши, результат подписать функцией TextOut в серединах отрезка, соединяющих пары точек." Точки я вывожу. Но максимум, что у меня получается - это соединить каждые последующее нечетные точки. А нужно соединить их все. Каким образом это можно осуществить?кто-нибудь поможет?)
9 ответов

LeX_K@R

Для определения всех нечётных точек, образующих пары с максимальным расстоянием между друг другом, можно действовать так:
uses Math;
 
type
  //Массив точек.
  TArrDot = array of TPoint;
 
  //Пара точек.
  TPairDot = record
    Dot1, Dot2 : TPoint;
  end;
 
  //Массив пар точек.
  TArrPairDot = array of TPairDot;
 
  //Вмето массива пар точек можно было бы использовать массив, содержащий пары индексов.
  //Каждый такой индекс будет являеться индексом элемента массива типа TArrDot.
 
var
  ArrDot : TArrDot;
  ArrPairDot : TArrPairDot;
 
//Вычисляет расстояние между двумя точками.
function GetLineLen(const aDot1, aDot2 : TPoint) : Extended;
begin
  Result := Sqrt( Sqr(aDot1.X - aDot2.X) + Sqr(aDot1.Y - aDot2.Y) );
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity = 100;
  //Точность сравнения расстояний между точками.
  EpsLen = 0.02;
var
  Dot1, Dot2 : TPoint;
  i, j, k : Integer;
  Len, LenMax : Extended;
begin
 
  //Предположим, что на данном этапе массив точек ArrDot уже сформирован.
 
  //Определяем максмальное расстояние между нечётными точками.
 
  LenMax := 0;
  for i := 0 to High(ArrDot) - 1 do begin
    //Пропускаем чётные точки.
    if (i + 1) mod 2 = 0 then Continue;
    //Перебор для данной нечётной точки пар с другими нечётными точками.
    for j := i + 1 to High(ArrDot) do begin
      //Пропускаем чётные точки.
      if (j + 1) mod 2 = 0 then Continue;
      //Ищем точки с максимальным расстоянием между друг другом.
      Len := GetLineLen(ArrDot[i], ArrDot[j]);
      if Len > LenMax then begin
        LenMax := Len;
        Dot1 := ArrDot[i];
        Dot2 := ArrDot[j];
      end;
    end;
  end;
 
  //Искомые точки: Dot1, Dot2. Расстояине между ними = LenMax.
 
  //Надо иметь в виду, что может быть несколько точек с максимальным
  //расстоянием. Если требуется отпределить все такие точки, тогда
  //надо прогнать цикл, подобный вышепредставленному, в котором производить
  //сверку расстояний с максимальным. Если расстояние равно максимальному,
  //то заносить пары таких точек в массив.
 
  k := 0;
  for i := 0 to High(ArrDot) - 1 do begin
    //Пропускаем чётные точки.
    if (i + 1) mod 2 = 0 then Continue;
    //Перебор для данной нечётной точки пар с другими нечётными точками.
    for j := i + 1 to High(ArrDot) do begin
      //Пропускаем чётные точки.
      if (j + 1) mod 2 = 0 then Continue;
      //Замеряем расстояние между точками.
      Len := GetLineLen(ArrDot[i], ArrDot[j]);
      //Если расстояние равно максимальному, то заносим такие точки в массив.
      if SameValue(Len, LenMax, EpsLen) then begin
        //Если требуется, увеличиваем длину массива.
        if k = Length(ArrPairDot) then SetLength(ArrPairDot, k + Capacity);
        //Добавляем пару точек в массив.
        ArrPairDot[k].Dot1 := ArrDot[i];
        ArrPairDot[k].Dot2 := ArrDot[j];
      end;
    end;
  end;
 
  //Корректируем длину массива пар точек в соответствии с количеством добавленных
  //в него элементов.
  if k < Length(ArrPairDot) then SetLength(ArrPairDot, k);
 
  //Теперь мы имеем массив ArrPairDot, который содержит пары нечётных точек с максимальным
  //расстоянием между друг другом.
 
end;
Если требуется соединить линиями все нечётные точки, то код рисования линий можно добавить в любой из циклов, например, сразу после части, где определяется максимальная длина, либо в другом цикле - там, где проверяется длина отрезка для пары точек. Линии надо проводить между точками ArrDot[i] и ArrDot[j].


LeX_K@R

после описания первой функции выдает ошибку: Statement not allowed in interface part. (после бегина)


LeX_K@R

после описания первой функции выдает ошибку: Statement not allowed in interface part. (после бегина)
Потому что этот код ты в разделе Interface поместил. Тот код, который я привёл - его надо полностью разместить в секции Implementation. --- На всякий случай поясню код:
  if SameValue(Len, LenMax, EpsLen) then
Он эквивалентен коду:
  if Abs(Len - LenMax) <= EpsLen then


LeX_K@R

Извини меня за мою глупость))) А как связать с этим кодом вывод чисел от 1 до н при нажатии клавиши мыши и последующее их соединение? Не понимаю саму суть этого кода...<Mawrat: Всё нормально. Не надо стесняться задавать вопросы.>


LeX_K@R

А как связать с этим кодом вывод чисел от 1 до н при нажатии клавиши мыши и последующее их соединение?
Сегодня вечером попозже напишу реализацию (или её часть).


LeX_K@R

Спасибо огромное)


LeX_K@R

Готово. Проект полностью работающий. Он выполняет все нужные расчёты и прорисовки. Остаётся добавить в него вывод надписи на канву со сведениями о максимально длинной линии. Обработка точек запускается либо по щелчку правой кнопки мыши в области рисования (как требуется в задании), либо по нажатию на кнопку "Обработать нечётные точки". Нечётные точки рисуются красным цветом, чётные - чёрным.
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    Image1: TImage;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ProcDots;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  Math;
 
type
  //Массив точек.
  TArrDot = array of TPoint;
 
  //Структура, содержащая сведения об имеющихся точках и их количестве.
  TDotInfo = record
    Count : Integer;
    Arr : TArrDot;
  end;
 
var
  //Сведения о точках.
  DotInfo : TDotInfo;
 
//Вычисляет расстояние между двумя точками.
function GetLineLen(const aDot1, aDot2 : TPoint) : Extended;
begin
  Result := Sqrt( Sqr(aDot1.X - aDot2.X) + Sqr(aDot1.Y - aDot2.Y) );
end;
 
//Прорисовка точки на канве.
procedure DrawDot(aCnv : TCanvas; const aDot : TPoint; const aColor : TColor);
var
  LastColor : TColor;
begin
  //Запоминаем текущий цвет кисти.
  LastColor := aCnv.Brush.Color;
  //Задаём цвет кисти.
  aCnv.Brush.Color := aColor;
  //Закрашиваем прямоугольную область в окрестности точки текущим цветом кисти.
  aCnv.FillRect( Rect(aDot.X - 2, aDot.Y - 2, aDot.X + 2, aDot.Y + 2) );
  //Возвращаем прежний цвет кисти.
  aCnv.Brush.Color := LastColor;
end;
 
//Прорисовка линии.
procedure DrawLine(aCnv : TCanvas; const aDot1, aDot2 : TPoint; const aColor : TColor);
var
  LastColor : TColor;
begin
  //Запоминаем текущий цвет пера.
  LastColor := aCnv.Pen.Color;
  //Задаём цвет пера.
  aCnv.Pen.Color := aColor;
  //Рисуем линию.
  aCnv.MoveTo(aDot1.X, aDot1.Y);
  aCnv.LineTo(aDot2.X, aDot2.Y);
  //Возвращаем прежний цвет пера.
  aCnv.Pen.Color := LastColor;
end;
 
//Очистка прямоугольной области на канве.
//Т. е. заливка этой области кистью белого цвета.
procedure ClearCanvas(aCnv : TCanvas; const aRect : TRect);
var
  LastColor : TColor;
begin
  LastColor := aCnv.Brush.Color;
  aCnv.Brush.Color := RGB(255, 255, 255);
  aCnv.FillRect(aRect);
  aCnv.Brush.Color := LastColor;
end;
 
//Обработчик события OnMouseDown для компонента Image1.
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  //Величина приращения длины массива.
  Capacity = 10;
begin
  //Если нажата кнопка мыши, отличная от правой или левой - выходим.
  //Т. к. может быть нажата средняя кнопка мыши (часто совмещённая с колёсиком).
  if not ( Button in [mbLeft, mbRight] ) then Exit;
 
  //Если нажата правая кнопка мыши - запускаем обработку массива точек.
  //А затем выходим.
  if Button = mbRight then begin
    ProcDots;
    Exit;
  end;
 
  //Обработка левой нопки мыши.
 
  //Добавляем сведения о точке в массив.
 
  with DotInfo do begin
    //Если требуется, увеличиваем длину массива точек.
    if Count = Length(Arr) then begin
      SetLength(Arr, Count + Capacity);
    end;
    //Добавляем очередную точку в массив.
    Arr[Count].X := X;
    Arr[Count].Y := Y;
    //Корректируем сведения о количестве элементов в массиве.
    Inc(Count);
 
    //Прорисовываем точку на канве компонента Image1.
    if Odd(DotInfo.Count) then begin
      //Нечётные точки рисуем красным цветом.
      DrawDot(Image1.Canvas, Arr[Count - 1], RGB(255, 0, 0));
    end else begin
      //Чётные точки рисуем чёрным цветом.
      DrawDot(Image1.Canvas, Arr[Count - 1], RGB(0, 0, 0));
    end;
 
    //Добавляем сведения о добавленной точке в верхнюю строку журнала.
    if Odd(DotInfo.Count) then begin
      Memo1.Lines.Insert(
        0,
        'Нечётная точка: (' + IntToStr(X) + ', ' + IntToStr(Y) + ')'
      );
    end else begin
      Memo1.Lines.Insert(
        0,
        'Чётная точка: (' + IntToStr(X) + ', ' + IntToStr(Y) + ')'
      );
    end;
  end;
 
end;
 
//Обработка точек.
procedure TForm1.ProcDots;
const
  //Точность сравнения расстояний между точками.
  EpsLen = 0.02;
var
  i, j : Integer;
  Len, LenMax : Extended;
begin
  //Если в массиве нет точек - выходим.
  if DotInfo.Count = 0 then Exit;
 
  //Перерисовываем массив точек.
  //Это нужно для того, чтобы убрать линии от прежней обработки.
  
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
  for i := 0 to DotInfo.Count - 1 do begin
    if Odd(i + 1) then begin
      //Нечётные точки прорисовываем красным цветом.
      DrawDot(Image1.Canvas, DotInfo.Arr[i], RGB(255, 0, 0));
    end else begin
      //Чётные точки прорисовываем черным цветом.
      DrawDot(Image1.Canvas, DotInfo.Arr[i], RGB(0, 0, 0));
    end;
  end;
 
  //Определяем максмальное расстояние между нечётными точками.
 
  LenMax := 0;
  for i := 0 to DotInfo.Count - 1 - 1 do begin
    //Пропускаем чётные точки.
    if not Odd(i + 1) then Continue;
    //Перебор для данной нечётной точки пар с другими нечётными точками.
    for j := i + 1 to DotInfo.Count - 1 do begin
      //Пропускаем чётные точки.
      if not Odd(j + 1) then Continue;
      //Ищем точки с максимальным расстоянием между друг другом.
      Len := GetLineLen(DotInfo.Arr[i], DotInfo.Arr[j]);
      if Len > LenMax then LenMax := Len;
    end;
  end;
 
  //Находим все пары нечётных точек, расстояние между которыми максимальное.
  //Обрабатываем эти пары.
 
  for i := 0 to DotInfo.Count - 1 - 1 do begin
    //Пропускаем чётные точки.
    if not Odd(i + 1) then Continue;
 
    //Перебор для данной нечётной точки пар с другими нечётными точками.
    for j := i + 1 to DotInfo.Count - 1 do begin
      //Пропускаем чётные точки.
      if not Odd(j + 1) then Continue;
 
      //Выбираем те пары точек, расстояние между которыми максимальное.
      Len := GetLineLen(DotInfo.Arr[i], DotInfo.Arr[j]);
      if SameValue(Len, LenMax, EpsLen) then begin
 
        //Очередная подходящая пара точек найдена.
 
        //Обрабатываем пару.
 
        //Рисуем линию
        DrawLine(Image1.Canvas, DotInfo.Arr[i], DotInfo.Arr[j], RGB(0, 0, 255));
        //Прорисовываем оконечные точки.
        DrawDot(Image1.Canvas, DotInfo.Arr[i], RGB(255, 0, 0));
        DrawDot(Image1.Canvas, DotInfo.Arr[j], RGB(255, 0, 0));
 
        //Делаем ещё что-либо.
        //...
 
      end;
    end;
  end;
 
end;
 
//Кнопка "Обработать нечётные точки".
procedure TForm1.Button1Click(Sender: TObject);
begin
  ProcDots;
end;
 
//Обработчик события OnCreate формы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Очистка канвы компонента Image1.
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
end;
 
//Кнопка "Сброс".
procedure TForm1.Button2Click(Sender: TObject);
begin
  //Очистка канвы компонента Image1.
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
  //Очистка Мемо1.
  Memo1.Clear;
 
  //Удаление массива точек из памяти.
  Finalize(DotInfo.Arr);
  DotInfo.Count := 0;
end;
 
end.
По мере возникновения вопросов - спрашивай. --- Сделал не то - поиск максимального расстояния. А в задании этого нет... Надо соединить все нечётные точки. Позже переделаю.


LeX_K@R

Согласно заданию:
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ProcDots;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  Math;
 
type
  //Массив точек.
  TArrDot = array of TPoint;
 
  //Структура, содержащая сведения об имеющихся точках и их количестве.
  TDotInfo = record
    Count : Integer;
    Arr : TArrDot;
  end;
 
var
  //Сведения о точках.
  DotInfo : TDotInfo;
 
//Вычисляет расстояние между двумя точками.
function GetLineLen(const aDot1, aDot2 : TPoint) : Extended;
begin
  Result := Sqrt( Sqr(aDot1.X - aDot2.X) + Sqr(aDot1.Y - aDot2.Y) );
end;
 
//Очистка прямоугольной области на канве.
//Т. е. заливка этой области кистью белого цвета.
procedure ClearCanvas(aCnv : TCanvas; const aRect : TRect);
begin
  aCnv.Brush.Color := RGB(255, 255, 255);
  aCnv.FillRect(aRect);
end;
 
//Прорисовка точки на канве.
procedure DrawDot(aCnv : TCanvas; const aDot : TPoint; const aNum : Integer);
var
  Color, LastColor : TColor;
begin
  //Цвет для прорисовки точки и связанного с ней текста (её номера).
  if Odd(aNum) then begin
    //Для нечётных точек цвет красный.
    Color := RGB(255, 0, 0);
  end else begin
    //Для чётных точек цвет чёрный.
    Color := RGB(0, 0, 0);
  end;
 
  //Прорисовка точки.
 
  //Запоминаем текущий цвет кисти.
  LastColor := aCnv.Brush.Color;
  //Устанавливаем цвет кисти.
  aCnv.Brush.Color := Color;
  //Закрашиваем прямоугольную область в окрестности точки.
  aCnv.FillRect( Rect(aDot.X - 2, aDot.Y - 2, aDot.X + 2, aDot.Y + 2) );
  //Возвращаем прежний цвет кисти.
  aCnv.Brush.Color := LastColor;
 
  //Прорисовка номера точки.
 
  aCnv.Font.Color := Color;
  aCnv.TextOut(aDot.X, aDot.Y - ( - aCnv.Font.Height ) - 5, IntToStr(aNum));
  aCnv.Font.Color := LastColor;
end;
 
//Прорисовка линии.
procedure DrawLine(aCnv : TCanvas; const aDot1, aDot2 : TPoint; const aLen : Extended);
var
  LastPenColor, LastBrushColor, LastFontColor : TColor;
  LastPenWidth : Integer;
  XText, YText : Integer;
begin
  //Запоминаем параметры пера, кисти и шрифта.
  LastPenColor := aCnv.Pen.Color;
  LastPenWidth := aCnv.Pen.Width;
  LastBrushColor := aCnv.Brush.Color;
  LastFontColor := aCnv.Brush.Color;
 
  //Прорисовка линии.
 
  //Задаём параметры пера.
  aCnv.Pen.Width := 2;
  aCnv.Pen.Color := RGB(0, 200, 0);
  //Рисуем линию.
  aCnv.MoveTo(aDot1.X, aDot1.Y);
  aCnv.LineTo(aDot2.X, aDot2.Y);
 
  //Прорисовка надписи.
 
  //Цвет шрифта.
  aCnv.Font.Color := RGB(255, 255, 255);
  //Задний фон.
  aCnv.Brush.Color := RGB(100, 100, 255);
  //Координаты надписи
  XText := Min(aDot1.X, aDot2.X) + Abs(aDot1.X - aDot2.X) div 2;
  YText := Min(aDot1.Y, aDot2.Y) + Abs(aDot1.Y - aDot2.Y) div 2;
  //Прорисовка надписи на канве.
  aCnv.TextOut(
    XText, YText - ( - aCnv.Font.Height ),
    Format(' Len=%.3f ', [aLen])
  );
 
  //Возвращаем прежние параметры.
  aCnv.Pen.Color := LastPenColor;
  aCnv.Pen.Width := LastPenWidth;
  aCnv.Brush.Color := LastBrushColor;
  aCnv.Font.Color := LastFontColor;
end;
 
//Обработка точек.
procedure TForm1.ProcDots;
const
  //Точность сравнения расстояний между точками.
  EpsLen = 0.02;
var
  i, j : Integer;
  Len : Extended;
begin
  //Если в массиве нет точек - выходим.
  if DotInfo.Count = 0 then Exit;
 
  //Перерисовываем массив точек.
  //Это нужно для того, чтобы убрать линии от прежней обработки.
 
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
  for i := 0 to DotInfo.Count - 1 do begin
    DrawDot(Image1.Canvas, DotInfo.Arr[i], i + 1);
  end;
 
  //Находим все пары нечётных точек. И обрабатываем эти пары.
 
  for i := 0 to DotInfo.Count - 1 - 1 do begin
    //Пропускаем чётные точки.
    if not Odd(i + 1) then Continue;
 
    //Перебор для данной нечётной точки пар с другими нечётными точками.
    for j := i + 1 to DotInfo.Count - 1 do begin
      //Пропускаем чётные точки.
      if not Odd(j + 1) then Continue;
 
      //Вычисляем расстояние между точками.
      Len := GetLineLen(DotInfo.Arr[i], DotInfo.Arr[j]);
      //Рисуем линию
      DrawLine(Image1.Canvas, DotInfo.Arr[i], DotInfo.Arr[j], Len);
      //Прорисовываем оконечные точки.
      DrawDot(Image1.Canvas, DotInfo.Arr[i], i + 1);
      DrawDot(Image1.Canvas, DotInfo.Arr[j], j + 1);
    end;
  end;
 
end;
 
//Обработчик события OnCreate формы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Очистка канвы компонента Image1.
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
end;
 
//Обработчик события OnMouseDown для компонента Image1.
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  //Величина приращения длины массива.
  Capacity = 10;
begin
  //Если нажата кнопка мыши, отличная от правой или левой - выходим.
  //Т. к. может быть нажата средняя кнопка мыши (часто совмещённая с колёсиком).
  if not ( Button in [mbLeft, mbRight] ) then Exit;
 
  //Если нажата правая кнопка мыши - запускаем обработку массива точек.
  //А затем выходим.
  if Button = mbRight then begin
    ProcDots;
    Exit;
  end;
 
  //Обработка левой нопки мыши.
 
  //Добавляем сведения о точке в массив и рисуем точку на канве.
 
  with DotInfo do begin
    //Если требуется, увеличиваем длину массива точек.
    if Count = Length(Arr) then begin
      SetLength(Arr, Count + Capacity);
    end;
    //Добавляем очередную точку в массив.
    Arr[Count].X := X;
    Arr[Count].Y := Y;
    //Корректируем сведения о количестве элементов в массиве.
    Inc(Count);
 
    //Прорисовываем точку на канве компонента Image1.
    DrawDot(Image1.Canvas, Arr[Count - 1], Count);
  end;
end;
 
//Кнопка: "Обработать нечётные точки".
procedure TForm1.Button1Click(Sender: TObject);
begin
  ProcDots;
end;
 
//Кнопка: "Сброс".
procedure TForm1.Button2Click(Sender: TObject);
begin
  //Очистка канвы компонента Image1.
  ClearCanvas(Image1.Canvas, Image1.ClientRect);
 
  //Удаление массива точек из памяти.
  Finalize(DotInfo.Arr);
  DotInfo.Count := 0;
end;
 
end.


LeX_K@R

Большое человеческое спасибо!)