установленный для ГКОЗ поселений

 

 

Код процедуры, реализующей данный алгоритм:

 

procedure FindLines;

Var

i,j,start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

begin

for start:= 0 to pList.Count-1 do

begin

Sum:=0;

tmpList.Clear;

 

for i:= 0 to pList.Count-1 do

begin

Pz:= pList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

end;

end;

end;

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

end;

end;

 

for i:= 0 to start-1 do

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

end;

end;

end;

 

pList.Clear;

for i:= 0 to oList.Count-1 do

begin

Pz:= oList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

pList.Add(P);

end;

 

Form1.Label3.Caption:= 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

end;

 

Данный алгоритм содержит несколько циклов: один глобальный цикл и два вложенных, которые в свою очередь включают в себя ещё по одному вложенному циклу. Параметром для внешнего глобального цикла является переменная start, которая делит данный список как бы на два сегмента. Потом внутренние циклы последовательно перебирают переменные в первом и втором сегментах. Данные переменные берутся в предположении, что они являются началом отрезка, а концы отрезков перебираются ещё одним циклом по всему списку. В итоге складывается картина того, что начала отрезков берутся в разных сегментах, размеры которых меняются в процессе прогона глобального цикла, а концы – из всего списка. Данный способ перебора элементов позволяет перебрать все отрезки, выбрать из них минимальные и найти их минимальные суммы. Суммирование в предварительную минимальную сумму для каждого набора отрезков происходит, если расстояние от данной точки (начала отрезка) до перебираемой точки (конца отрезка) меньше, чем расстояния от данной точки до всех остальных. В итоге мы получаем суммы длин наборов отрезков, из которых запоминаем в свою очередь минимальную сумму.

Ниже приведена общая блок-схема алгоритма:

 

 

 

 

4.Резюме.

4.1. Выводы.

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

К достоинствам программы можно отнести:

- простой интерфейс без излишних сложностей;

- процесс работы программы визуализируется;

К недостаткам можно отнести следующее:

- невозможность более детального анализа алгоритма;

4.2. Возможные модернизации.

1. Доработать программу и дать возможность пользователю более детального анализа алгоритма.

 

 

5. Литература.

1. Т. Кормен, Ч. Лейзерсон, Р. Ривест «Алгоритмы: построение и анализ».

2. В.В. Фаронов «Delphi – программирование на языке высокого уровня».

3. Ю.С. Избачков, В.Н. Петров «Информационные системы», второе издание

6. Приложение

6.1. Текст программы.

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, Menus, ToolWin, ExtCtrls, StdCtrls, ImgList, Grids,

ValEdit, ShellAPI;

 

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

Panel1: TPanel;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

Image1: TImage;

Button1: TButton;

Button2: TButton;

ImageList1: TImageList;

ToolButton3: TToolButton;

N3: TMenuItem;

N4: TMenuItem;

ScrollBox1: TScrollBox;

Image2: TImage;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Button3: TButton;

StringGrid1: TStringGrid;

Panel2: TPanel;

procedure ToolButton1Click(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ToolButton2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N3Click(Sender: TObject);

 

 

private

{ Private declarations }

public

{ Public declarations }

end;

 

PPnt = ^TPnt;

TPnt = record

X,Y: integer;

rColor: byte;

num: integer;

Linked: boolean;

end;

 

 

var

Form1: TForm1;

rColor: byte;

 

pList, tmpList, oList, rList: TList;

tCount, redCount, blueCount: integer;

cWidth, cHeight: integer;

minSum: double;

start_sh: integer;

i_1, j_1, i_2, j_2: integer;

 

i,j, start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

x,y: integer;

fl:Boolean;

i_col,ip1,ip2:integer;

 

implementation

 

{$R *.dfm}

 

procedure ClearGrid;

Var rRect: TRect;

begin

rRect.Left:= cWidth + 1;

rRect.Right:= Form1.Image2.Width;

rRect.Top:= 0;

rRect.Bottom:= Form1.Image2.Height;

 

Form1.Image2.Canvas.Brush.Color:= clWhite;

Form1.Image2.Canvas.FillRect(rREct);

end;

 

 

procedure FindLines;

Var

i,j,start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

begin

for start:= 0 to pList.Count-1 do

begin

Sum:=0;

tmpList.Clear;

 

for i:= 0 to pList.Count-1 do

begin

Pz:= pList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

end;

end;

 

for i:= 0 to start-1 do

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

end;

end;

end;

 

pList.Clear;

 

for i:= 0 to oList.Count-1 do

begin

Pz:= oList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

pList.Add(P);

end;

 

Form1.Label3.Caption:= 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

 

end;

 

procedure DrawGrid(vList: TList);

Var i,j: integer;

rREct: TRect;

p: PPnt;

begin

for j:=1 to vList.Count do

begin

 

Form1.Image2.Canvas.Pen.Color:= clBlack;

 

rRect.Left:= cWidth * j;

rRect.Top:= 0;

rRect.Right:= cWidth * (j+1);

rRect.Bottom:= cHeight;

 

 

Form1.Image2.Canvas.FillRect(rRect);

 

Form1.Image2.Canvas.Brush.Color:= clInactiveCaption;

Form1.Image2.Canvas.FillRect(rRect);

Form1.Image2.Canvas.Font.Style:= [fsBold];

Form1.Image2.Canvas.TextOut(j * cWidth + round(cWidth/2)-3, 1, IntToStr(j));

 

 

for i:=0 to 5 do

begin

Form1.Image2.Canvas.MoveTo(cWidth*j, i*cHeight);

Form1.Image2.Canvas.LineTo(cWidth*(j + 1), i*cHeight);

end;

 

for i:= j to j + 1 do

begin

Form1.Image2.Canvas.MoveTo(i*cWidth,0);

Form1.Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

 

Form1.Image2.Canvas.Font.Style:= [];

Form1.Image2.Canvas.Brush.Color:= clWhite;

 

p:= vList.Items[j-1];

 

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 8, cHeight + 1, IntToStr(p^.X));

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 8, 2*cHeight + 1, IntToStr(p^.Y));

 

 

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, IntToStr(p^.num));

 

 

if p^.rColor = 1 then

begin

rRect.Left:= cWidth * j + 1;

rRect.Top:= cHeight * 4 + 1;

rRect.Right:= cWidth * (j+1);

rRect.Bottom:= cHeight*5;

 

Form1.Image2.Canvas.Brush.Color:= clRed;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

if p^.rColor = 2 then

begin

rRect.Left:= cWidth * j + 1;

rRect.Top:= cHeight * 4 + 1;

rRect.Right:= cWidth * (j+1);

rRect.Bottom:= cHeight*5;

 

Form1.Image2.Canvas.Brush.Color:= clBlue;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

 

end;

 

end;

 

 

procedure DeletePoints(vList: TList);

Var p: PPnt;

begin

while vList.Count > 0 do

begin

P:= vList.Items[0];

Dispose(P);

vList.Delete(0);

end;

 

tCount:= 0;

RedCount:= 0;

BlueCount:= 0;

 

end;

 

procedure DrawPoints(vList: TList);

Var i,j: integer;

p, p2: PPnt;

begin

for i:= 0 to vList.Count-1 do

begin

 

p:= vList.Items[i];

 

if p^.rColor = 1 then

Form1.Image1.Canvas.Brush.Color:= clRed;

 

if p^.rColor = 2 then

Form1.Image1.Canvas.Brush.Color:= clBlue;

 

Form1.Image1.Canvas.Pen.Color:= clBlack;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

Form1.Image1.Canvas.Brush.Color:= clWhite;

Form1.Image1.Canvas.TextOut(p^.X-20, p^.Y-5, IntToStr(i+1));

 

for j:=i+1 to vList.Count - 1 do

begin

p2:= vList.Items[j];

if p^.num = p2^.num then

begin

Form1.Image1.Canvas.MoveTo(p^.X, p^.Y);

if p^.rColor = 1 then Form1.Image1.Canvas.Pen.Color:= clRed;

if p^.rColor = 2 then Form1.Image1.Canvas.Pen.Color:= clBlue;

Form1.Image1.Canvas.LineTo(round((P^.X+P2^.X)/2),round((P^.Y+P2^.Y)/2));

if p2^.rColor = 1 then Form1.Image1.Canvas.Pen.Color:= clRed;

if p2^.rColor = 2 then Form1.Image1.Canvas.Pen.Color:= clBlue;

Form1.Image1.Canvas.LineTo(P2^.X,P2^.Y);

end;

end;

end;

end;

 

procedure AddDrawPoint(vList: TList; X,Y: integer);

Var p: PPnt;

begin

Inc(tCount);

Form1.Image1.Canvas.Pen.Color:= clBlack;

if rColor = 1 then

begin

 

Inc(RedCount);

 

Form1.Image1.Canvas.Brush.Color:= clRed;

Form1.Image1.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);

 

Form1.Image1.Canvas.Brush.Color:= clWhite;

Form1.Image1.Canvas.TextOut(X-20, Y-5, IntToStr(tCount));

 

New(p);

p^.X:= X;

p^.Y:= Y;

p^.rColor:= 1;

p^.Linked:= false;

p^.num:= tCount;

pList.Add(p);

end;

if rColor = 2 then

begin

Inc(BlueCount);

Form1.Image1.Canvas.Brush.Color:= clBlue;

Form1.Image1.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);

Form1.Image1.Canvas.Brush.Color:= clWhite;

Form1.Image1.Canvas.TextOut(X-20, Y-5, IntToStr(tCount));

New(p);

p^.X:= X;

p^.Y:= Y;

p^.rColor:= 2;

p^.Linked:= false;

p^.num:= tCount;

pList.Add(p);

end;

end;

 

procedure AddGridPoint(vList: TList);

Var rRect: TRect;

i: integer;

p: PPnt;

begin

 

if rColor = 0 then exit;

 

cWidth:= 50;

cHeight:= 15;

 

 

rRect.Left:= cWidth * vList.Count;

rRect.Top:= 0;

rRect.Right:= cWidth * (vList.Count+1);

rRect.Bottom:= cHeight;

 

 

Form1.Image2.Canvas.FillRect(rRect);

 

Form1.Image2.Canvas.Brush.Color:= clInactiveCaption;

Form1.Image2.Canvas.FillRect(rRect);

Form1.Image2.Canvas.Font.Style:= [fsBold];

Form1.Image2.Canvas.TextOut(vList.Count * cWidth + round(cWidth/2)-3, 1, IntToStr(vList.Count));

 

 

for i:=0 to 5 do

begin

Form1.Image2.Canvas.MoveTo(cWidth*vList.Count, i*cHeight);

Form1.Image2.Canvas.LineTo(cWidth*(vList.Count + 1), i*cHeight);

end;

 

for i:= pList.Count to pList.Count + 1 do

begin

Form1.Image2.Canvas.MoveTo(i*cWidth,0);

Form1.Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

 

Form1.Image2.Canvas.Font.Style:= [];

Form1.Image2.Canvas.Brush.Color:= clWhite;

 

p:= vList.Items[vList.Count-1];

 

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 8, cHeight + 1, IntToStr(p^.X));

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 8, 2*cHeight + 1, IntToStr(p^.Y));

 

//if p^.Linked

//then

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, IntToStr(p^.num));

//else

//Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, '-');

 

if p^.rColor = 1 then

begin

rRect.Left:= cWidth * vList.Count + 1;

rRect.Top:= cHeight * 4 + 1;

rRect.Right:= cWidth * (vList.Count+1);

rRect.Bottom:= cHeight*5;

 

Form1.Image2.Canvas.Brush.Color:= clRed;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

if p^.rColor = 2 then

begin

rRect.Left:= cWidth * vList.Count + 1;

rRect.Top:= cHeight * 4 + 1;

rRect.Right:= cWidth * (vList.Count+1);

rRect.Bottom:= cHeight*5;

 

Form1.Image2.Canvas.Brush.Color:= clBlue;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

end;

 

procedure pointsDraw;

Var i: integer;

p: PPnt;

begin

 

Form1.Image1.Canvas.Brush.Color:= clWhite;

Form1.Image1.Canvas.FillRect(Form1.Image1.Canvas.ClipRect);

Form1.Image1.Canvas.Rectangle(Form1.Image1.Canvas.ClipRect);

for i:=0 to pList.Count - 1 do

begin

p:= pList.Items[i];

 

if p^.rColor = 1 then

begin

Form1.Image1.Canvas.Brush.Color:= clRed;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

end;

 

if p^.rColor = 2 then

begin

Form1.Image1.Canvas.Brush.Color:= clBlue;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

end;

 

 

end;

end;

 

 

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

Screen.Cursor:= crCross;

rColor:= 1;

end;

 

procedure TForm1.ToolButton3Click(Sender: TObject);

var i:Integer;

begin

if (fl=false) then //кнопка нажата первый раз. включено ручное черчение

begin

sum:=0;

i_col:=0;

fl:=true;

Screen.Cursor:= crCross;

rColor:= 0;

Button2.Enabled:=false;

Button3.Enabled:=false;

start:=1;

StringGrid1.RowCount:= 2; //отрисовка таблицы вывода результата

StringGrid1.ColCount:= round(pList.Count/2)+2;

StringGrid1.Cells[StringGrid1.ColCount-1,0]:= 'Сумма';

 

end

else //выход из режима черчения

begin //возврат связей в исходное состояние

for i:= 0 to pList.Count-1 do

PPnt(pList.Items[i])^.Linked:=false;

 

start:= 0;

Screen.Cursor:= crDefault;

fl:=false;

Button2.Enabled:=true;

Button3.Enabled:=true;

 

end;

 

end;

 

procedure TForm1.FormCreate(Sender: TObject);

Var

rRect: TRect;

i: integer;

begin //пераоночальное присваивание переменных

fl:=false;

start:= 0;

i_1:= start_sh;

j_1:= 0;

i_2:= 0;

j_2:= 0;

tCount:= 0;

redCount:= 0;

blueCount:= 0;

 

cWidth:= 50;

cHeight:= 15;

 

rRect.Left:= 0;

rRect.Top:= 0;

rRect.Right:= Image1.Width;

rRect.Bottom:= Image1.Height;

Image1.Canvas.FillRect(rRect);

Image1.Canvas.Rectangle(rREct);

 

 

rRect.Left:= 0;

rRect.Top:= 0;

rRect.Right:= Image2.Width;

rRect.Bottom:= Image2.Height;

Image2.Canvas.FillRect(rRect);

 

rRect.Right:= cWidth;

rRect.Bottom:= cHeight*5;

 

Image2.Canvas.Brush.Color:= clInactiveCaption;

Image2.Canvas.FillRect(rRect);

Image2.Canvas.Font.Style:= [fsBold];

 

for i:=0 to 5 do

begin

Image2.Canvas.MoveTo(0, i*cHeight);

Image2.Canvas.LineTo(cWidth, i*cHeight);

end;

 

for i:= 0 to 1 do

begin

Image2.Canvas.MoveTo(i*cWidth,0);

Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

Image2.Canvas.TextOut(round(cWidth/2)-2, cHeight + 1, 'X');

Image2.Canvas.TextOut(round(cWidth/2)-2, 2*cHeight + 1, 'Y');

Image2.Canvas.TextOut(round(cWidth/2)-14, 3*cHeight + 1, 'Связь');

Image2.Canvas.TextOut(round(cWidth/2)-14, 4*cHeight + 1, 'Цвет');

 

 

rColor:= 0;

 

pList:= TList.Create;

tmpList:= TList.Create;

oList:= TList.Create;

rList:= TList.Create;

 

end;

 

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

Var p: PPnt;

p1, p2: PPnt;

i:Integer;

minn,mint:Real;

begin

if fl then

begin

minn:=-1; //переменная расстояния между точками. -1 означает что еще не вычислялась

 

if (i_col=1)then //поиск второй точки, максимально близкой к месту нажатия

begin

for i:= 0 to pList.Count-1 do //перебор всех точек

begin

p:= pList.Items[i]; //данные i-й точки

if (p^.Linked=false)and(p^.rColor<>PPnt(pList.Items[ip1])^.rColor) //если точка не связана и противоположного цвета тогда

then

begin

mint:=sqrt(sqr(P^.X - X) + sqr(P^.Y - Y)); //вычисление расстояния

if(minn<0)then //первоночальное присваивание

begin

ip2:=i; //запомнить позиции точки из списка

minn:=mint

end;

if(mint<minn)then //поиск очередного минимума

begin

ip2:=i;

minn:=mint

end;

end;

end;

inc(i_col); //переход к друнгомк режиму обработки

PPnt(pList.Items[ip2])^.Linked:=true;

end;

 

if (i_col=0)then //поиск первой точки, максимально близкой к месту нажатия

begin

for i:= 0 to pList.Count-1 do //поиск первой точки

begin

p:= pList.Items[i];

if (p^.Linked=false)

then

begin

mint:=sqrt(sqr(P^.X - X) + sqr(P^.Y - Y));

if(minn<0)then //первоночальное присваивание

begin

ip1:=i;

minn:=mint

end;

if(mint<minn)then

begin

ip1:=i;

minn:=mint

end;

end;

end;

inc(i_col);

PPnt(pList.Items[ip1])^.Linked:=true;

end;

 

if (i_col=2) then //2 точки отобраны?

begin //отрисовка линии

p1:= pList.Items[ip1];

p2:= pList.Items[ip2];

sum:=sum+sqrt(sqr(P1^.X - P2^.X) + sqr(P1^.Y -P2^.Y));

Form1.Image1.Canvas.MoveTo(p1^.X, p1^.Y);

if p1^.rColor = 1 then Form1.Image1.Canvas.Pen.Color:= clRed;

if p1^.rColor = 2 then Form1.Image1.Canvas.Pen.Color:= clBlue;

Form1.Image1.Canvas.LineTo(round((P1^.X+P2^.X)/2),round((P1^.Y+P2^.Y)/2));

if p2^.rColor = 1 then Form1.Image1.Canvas.Pen.Color:= clRed;

if p2^.rColor = 2 then Form1.Image1.Canvas.Pen.Color:= clBlue;

Form1.Image1.Canvas.LineTo(P2^.X,P2^.Y);

//отображение цифр в таблице

StringGrid1.Cells[start,1]:= IntToStr(P1^.num)+'-'+IntToStr(P2^.num);

StringGrid1.Cells[StringGrid1.ColCount-1,1]:= IntToStr(round(Sum));

inc(start);

i_col:=0;

end;

end

else

begin

AddDrawPoint(pList, X,Y);

AddGridPoint(pList);

 

Label1.Caption:= 'Красные точки: ' + IntToStr(redCount);

Label2.Caption:= 'Синие точки: ' + ' ' + IntToStr(blueCount);

 

if redCount = blueCount then Button2.Enabled:= true else Button2.Enabled:= false;

end;

end;

 

procedure TForm1.ToolButton2Click(Sender: TObject);

begin

rColor:= 2;

Screen.Cursor:= crCross;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

Var i: integer;

p: PPnt;

 

begin

Start:= 0;

start_sh:= 0;

i_1:= Start_sh;

i_2:= 0;

j_1:= 0;

j_2:= 0;

DeletePoints(pList);

 

Image1.Canvas.Pen.Color:= clBlack;

Image1.Canvas.Brush.Color:= clWhite;

Image1.Canvas.Rectangle(Image1.Canvas.ClipRect);

 

ClearGrid;

 

end;

 

 

procedure TForm1.Button2Click(Sender: TObject);

Var rRect: TRect;

i: integer;

begin

FindLines;

DrawPoints(pList);

 

ClearGrid;

DrawGrid(pList);

 

end;

 

procedure TForm1.Button3Click(Sender: TObject);

Var rRect: TRect;

begin

 

if Start = pList.Count then //перебор точек по нажатию кнопки "Шаг" завершено

begin

Label3.Caption:= 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

exit;

end;

 

Sum:=0;

tmpList.Clear;

 

 

for i:= 0 to pList.Count-1 do //передача всех точек во временный список

begin

Pz:= pList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do //

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

 

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

 

 

end;

end;

 

for i:= 0 to start-1 do

begin

P:= tmpList.Items[i];

if not P^.Linked then

begin

Min:= MaxInt;

for j:= 0 to tmpList.Count - 1 do

if i<>j then

begin

P2:= tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min:= sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin:= P2;

 

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked:= True;

PMin^.Linked:= True;

PMin^.Num:= P^.Num;

 

 

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

 

i_1:= 0;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz:= tmpList.Items[i];

New(P);

P^.X:=Pz.X;

P^.Y:=Pz.Y;

P^.rColor:=Pz.rColor;

P^.Linked:= Pz.Linked;

P^.Num:= Pz.Num;

oList.Add(P);

 

end;

end;

 

i_1:= 0;

StringGrid1.RowCount:= start+2;

StringGrid1.ColCount:= REdCount+2;

for i:= 0 to oList.Count-1 do

begin

p:= oList.Items[i];

 

if P^.num <> i+1 then

begin

Inc(i_1);

StringGrid1.Cells[i_1,start+1]:= IntToStr(i+1) + '-' + IntToStr(p^.num);

StringGrid1.Cells[StringGrid1.ColCount-1,start+1]:= FloatToStr(round(minSum));

StringGrid1.Cells[i_1,0]:= IntToStr(i_1);

StringGrid1.Cells[StringGrid1.ColCount-1,0]:= 'Сумма';

 

end;

end;

 

StringGrid1.Cells[0,start+1]:= IntToStr(start+1);

 

DrawGrid(oList);

Image1.Canvas.FillRect(Image1.Canvas.ClipRect);

DrawPoints(oList);

 

 

inc(start);

end;

 

procedure TForm1.N4Click(Sender: TObject);

begin

ShellExecute(Handle, 'open','index.chm',nil, Nil, SW_ShowNormal);

end;

 

procedure TForm1.N3Click(Sender: TObject);

begin

Form1.Close;

end;

 

end.

установленный для ГКОЗ поселений

 

Вид функционального использования земель
1. Земли под жилыми домами многоэтажной и повышенной этажности застройки	Земельные участки жилых домов Земельные участки общежитий Прочие земли жилых зданий
2. Земли под домами индивидуальной жилой застройкой	Земельные участки индивидуальных жилых домов Земельные участки дач Земельные участки личных подсобных хозяйств
3. Земли дачных и садоводческих объединений граждан	Земельные участки садоводческих товариществ
4. Земли гаражей и автостоянок	Земельные участки гаражных кооперативов Земельные участки индивидуальных гаражей Земельные участки других объектов для хранения автомобилей
5. Земли под объектами торговли, общественного питания, бытового обслуживания, автозаправочными и газонаполнительными станциями, предприятиями автосервиса	Земельные участки магазинов Земельные участки универмагов Земельные участки гастрономов Земельные участки универсамов Земельные участки рынков Земельные участки ярмарок Земельные участки объектов мелкорозничной торговли (палатки) Земельные участки других объектов торговли Земельные участки ресторанов и кафе Земельные участки фабрик - кухонь Земельные участки других объектов общественного питания Земельные участки экскурсионных бюро Земельные участки казино, дискотек, ночных клубов и прочие Земельные участки автостоянок Земельные участки АЗС Земельные участки предприятий автосервиса Земельные участки Земельные участки бань и душевых павильонов Земельные участки химчисток и прачечных Земельные участки мастерских по ремонту часов, бытовой техники, ремонту и изготовлению мебели Земельные участки ателье Земельные участки пунктов проката Земельные участки парикмахерских Земельные участки приемных пунктов прачечных и химчисток Земельные участки похоронных бюро, поминальные залов Земельные участки других предприятий бытового обслуживания населения
6. Земли учреждений и организаций народного образования, земли под объектами здравоохранения и социального обеспечения физической культуры и спорта, культуры и искусства, религиозными объектами	Земельные участки детских дошкольных учреждений Земельные участки общеобразовательных школ Земельные участки учебно-производственных комбинатов Земельные участки ПТУ Земельные участки средних специальных учебных заведений Земельные участки вузов Земельные участки институтов повышения квалификации, усовершенствования Земельные участки школ-интернатов, детских домов Земельные участки лицеев Земельные участки гимназий Земельные участки колледжей Земельные участки военных училищ Земельные участки прочих учреждений народного образования Земельные участки больниц Земельные участки родильных домов Земельные участки поликлиник Земельные участки аптек Земельные участки раздаточных молочных кухонь Земельные участки санитарно -эпидемиологических станций (СЭС) Земельные участки подстанций скорой помощи Земельные участки домов –интернатов для инвалидов и престарелых Земельные участки диспансеров Земельные участки ветеринарных лечебниц Земельные участки амбулаторий Земельные участки станций переливания крови Земельные участки станций дезинфекции Земельные участки госпиталей Земельные участки медпунктов Земельные участки травматологических пунктов Земельные участки санаториев Земельные участки бальнеогрязелечебниц Земельные участки других учреждений здравоохранения и социального обеспечения Земельные участки детско-юношеских спортивных школ Земельные участки теннисных кортов Земельные участки гребных баз Земельные участки ипподромов (манежей) Земельные участки мотодромов Земельные участки картодромов Земельные участки катков Земельные участки велотреков Земельные участки стрельбищ Земельные участки тиров Земельные участки шахматно-шашечных клубов Земельные участки автомотоклубов Земельные участки школ служебного собаководства Земельные участки спортивных лагерей Земельные участки спортзалов, дворцов спорта Земельные участки стадионов Земельные участки бассейнов Земельные участки других учреждений физической культуры и спорта Земельные участки театров Земельные участки концертных залов Земельные участки цирков Земельные участки выставочных залов Земельные участки музеев Земельные участки кинотеатров Земельные участки библиотек и архивов Земельные участки клубов Земельные участки дворцов культуры Земельные участки консерваторий музыкальных школ и школ искусств Земельные участки художественных школ Земельные участки художественных галерей Земельные участки планетариев Земельные участки киностудий Земельные участки зоопарков Земельные участки других учреждений культуры и искусства Земельные участки монастырей и других религиозных объектов
7. Земли под промышленными объектами, объектами коммунального хозяйства, объектами материально-технического, продовольственного снабжения, сбыта и заготовок, под объектами транспорта (за исключением земельных участков под автозаправочными и газонаполнительными станциями, предприятиями автосервиса, гаражей и автостоянок), под объектами связи	Земельные участки учреждений отраслевого управления (включая органы управления силовых структур) Земельные участки фабрик, заводов и комбинатов Земельные участки электростанций Земельные участки типографий Земельные участки других промышленных предприятий Земельные участки ДЭЗов (РЭУ, ЖЭК) Земельные участки пунктов приема вторсырья Земельные участки пожарных депо Земельные участки контор механизированной обработки Земельные участки газораспределительные пункты Земельные участки районных котельных Земельные участки трансформаторных подстанций электросети Земельные участки центральных тепловые пункты Земельные участки водозаборных узлов Земельные участки кладбищ Земельные участки крематориев Земельные участки мусороперерабатывающих (мусоросжигающих предприятий) Земельные участки полигонов промышленных и бытовых отходов Земельные участки других учреждений коммунального хозяйства Земельные участки заготовительных пунктов и отделений Земельные участки баз и складов Земельные участки снабженческих контор и отделений Земельные участки элеваторов Земельные участки товарно-сырьевых бирж Земельные участки прочих предприятий материально-технического, продовольственного снабжения, сбыта и заготовок Земельные участки железных дорог Земельные участки железнодорожных вокзалов, станций Земельные участки железнодорожных депо Земельные участки мастерских по ремонту и обслуживанию ж/д транспорта Земельные участки автовокзалов Земельные участки мастерских по ремонту и обслуживанию междугородного автомобильного транспорта Земельные участки пассажирских пристаней, водных вокзалов Земельные участки грузовых пристаней Земельные участки мастерские по ремонту и обслуживанию водного транспорта Земельные участки аэродромов Земельные участки мастерских по ремонту и обслуживанию воздушного транспорта Земельные участки станций метро и открытых линий и депо Земельные участки трамвайных линий Земельные участки трамвайных депо Земельные участки автобаз, автокомбинатов Земельные участки мастерских по ремонту и обслуживанию городского транспорта Земельные участки автозаправочных, газонаполнительных станций Земельные участки предприятий по ремонту и содержанию шоссейных дорог общего пользования Земельные участки других предприятий транспорта Земельные участки отделений связи Земельные участки АТС Земельные участки опорных усилительных станций Земельные участки радиоцентров, телецентров, радиостанций, ретрансляторных станций и сооружений Земельные участки объектов космического обеспечения Земельные участки прочих предприятий связи
8. Земли под административно-управленческими и общественными объектами и земли предприятий, организаций, учреждений финансирования, кредитования, страхования и пенсионного обеспечения	Земельные участки издательств Земельные участки редакций и редакций Земельные участки юридических служб и судопроизводств и нотариата Земельные участки органов территориальной власти и управления Земельные участки посольств, консульств и представительств Земельные участки военкоматов Земельные участки отделений милиции и пунктов охраны порядка Земельные участки исправительных заведений Земельные участки загсов и дворцов бракосочетания Земельные участки прочих административно-управленческих и общественных организаций Земельные участки научно-исследовательских и проектно-конструкторских институтов Земельные участки вычислительных центров и других объектов информатики Земельные участки академических центров Земельные участки обсерваторий Земельные участки лабораторий и опытных заводов Земельные участки других объектов науки и научного обслуживания
9. Земли под военными объектами	Земельные участки войсковых частей Земельные участки других объектов обороны
10. Земли под объектами оздоровительного и рекреационного назначения	Земельные участки санаториев, домов отдыха, пансионатов, кемпингов, пионерских лагерей Земельные участки туристических баз, детских и спортивных лагерей Земельные участки других объектов оздоровительного и рекреационного назначения
11. Земли сельскохозяйственного использования	Земли акционерных обществ, колхозов, совхозов, крестьянско-фермерских хозяйств и прочие Земельные участки индивидуального огородничества, сенокошения, животноводства Земельные участки коллективного огородничества
12. Земли под лесами в поселениях (в том числе городскими лесами), под древесно-кустарниковой растительностью, не входящей в лесной фонд (в том числе лесопарками, парками, скверами, бульварами)	Земельные участки заповедников, национальных парков, ботанических садов Земельные участки других объектов природно-заповедного назначения Земельные участки лесопарков, национальных и природных парков Земельные участки улиц, площадей, переулков, проездов, набережных, бульвары, скверы и т.д. Прочие лесные земли
13. Земли под обособленными водными объектами	Земельные участки под поверхностными водными объектами Земельные участки под полосами отвода водоемов, каналов и коллекторов Земельные участки других водных объектов
14. Прочие земли поселений (в том числе геонимы в поселениях и земли – резерв)	Земельные участки улиц, проспектов, площадей, набережные, шоссе и т.д. Земельные участки земель резерва