double arrow

Implementation. var GraphForm: TGraphForm;

{$R *.DFM}

var
GraphForm: TGraphForm;

procedure TGraphForm.ButtonExitClick(Sender: TObject);
begin // Bыxoд из програмиы
Close;
end;

procedure TGraphForm.FcrmCreate (Sender: TObject);
begin // При создании формы надо проинициализировать таблицу
with StringGridRibs do
begin // Формирование заголовков столбцов таблицы ребер
Cells[0,0]:='N';
Cells[1,0]:='Начало';
Cells[2,0]:='Конец';
Cells[3,0]:='Вес';
Cells[0,1]:='1';
end;
end;

// Установить оптимальное количество ребер в таблице ребер
procedure TGraphForm.CbeckRows;
var i, maxRow: integer;
begin
with StringGridRibs do
begin

MaxRow:=0; // Вычисляем максимальный номер незаполненной строки
for i:=RowCount-1 downto 1 do
if (Cells[l,i]<>'') or (Cells [2,i]<>'')
or (Cells[3,i]<>'') then
begin
MaxRow:=i;
break;
end;
RowCount:=MaxRow+2;
for i:=l to RowCount-1 do
Cells[0,i]:=IntToStr(i); {Установить номера строк в первой колонке}
end;
end;

procedure TGraphForm.StringGridRibsSetEditText(Sender: TObject; ACcl, ARow: Integer; const Value: string);
Begin // в ячейке таблицы изменен текст
try // Проверка введенного текста
if Value='' then
if ACol=3 then
StrToFloat(Value); {В колонке №3 допустимы только вещественноые значения}
else
StrToInt(Value) {В колонке №3 допустимы только целые значения}
StatusBar.SimpleText:='';
except
on E: Exception do {Текст ошибки надо вывести в строку статуса}
StatusBar.SimpleText:=E.Message;
end;
CheckRcws; // Перевычислить количество строк в таблице
end;

procedure TGraphForm.ButtonInsertClick(Sender: TObject);
var i: integer;
begin // Нажата кнопка "Вставить peбрo"
with StringGridRibs do
begin
// Раздвигаем строчки
for i:=RowCount-1 downto Row+l do
begin
Cells[1,i]:=Cells[1,i-i];
Cells[2,i]:=Cells[2,i-l];
Cells[3,i]:=Cells[3,i-1];
end;
// Вставляем пустую
Cells[1,Row]:='';
Cells[2,Row]:='';
Cells[3,Row]:='';
end;
CheckRows; // Перевычислитъ количество строк в таблице
end;

procedure TGraphForm.ButtonDeleteCiick(Sender: TObject);
var i: integer;
begin // Нажата кнопка "Удалить ребро"
with StringSridRibs do
// Удаляем текущую строчку и остальные сдвигаем
for i:=Row to RowCount-2 do
begin
Cells[1,i]:=Cells[l,i+l];
Cells[2,i]:=Cells[2,i+l];
Cells[3,i]:=Cells[3,i+l];
end;
CheckRows; // Перевычислить количество строк в таблице
end;

procedure TGraphForm.ButtonDeleteAllClick (Sender: TObject);
var i: integer;
begin // Нажата кнопка "Удалить все"
with StringGridRibs do
for i:=1 to RowCount-1 do
begin // Очищаем всю таблицу
Cells[2,i]:='';
Се11з[3,i]:='';
end;
CheckRows; // Перевычислить количество строк в таблице
end;

procedure TGraphForm.PageControlChange (Sender: TObject);
var min,max,i, j, r: integer; wsun, ww: double;
begin // Пользователь переключилсяя на другую закладку
if PageControl.ActivePage<>TabSheetInput then
with StringGridRibs do
try // Вычислить максимальный номер вершины
min:=MaxInt; max:=-MaxInt;
for i:=1 to RowCount-2 do
for j:=1 to 2 do
begin
r:=StrToInt(Cells[j,i]);
if r<min then min:=r;
if r>max then шаx:=r;
end;
if (min<O) or (max>=100) or (max<0) then
Abort; // Если нмера вершин слишком велики, то считаем, что это ошибка
// Формируем матрицу смежности
wsum:=0; S:=max+1; SetLength(w,0,0); SetLength(W,S,S);
for i:=1 to RowCount-2 do
begin
ww:=StrToFloat(Cells[3,i]);
if ww<=0 then
Abort;
W[StrToInt(Cells[1,i]),StrToInt(Cells[2,i])]:=ww;
if not CheckBoxOrientated.Checked then
// Если граф неориентированный, то делаем ребро
W[StrToInt(Cells[2,i]),StrToInt(Cells[1,i])]:=ww; //в обратную сторону
wsum:=wsum+ww; // Суммируем все веса рёбер
end;
except // Если Матряца введена неверно, то считаем, что матрица имеет нулевые размеры
wsum:=0; S:=0; SetLength(W,0,0);
end;

if PageControl.ActivePage=TabSheetInfo then
begin // Выдать информацию на странице "Характеристики"
LabelVertexCount.Caption:=IntToStr(S);
if S=0 then
LabelRibCount.Capticn:='0'
else
LabelRibCount.Caption:=IntToStr(StringGridRibs.RowCount-2);
LabelWeightSum.Capticn:=FloatToStr(wsum);
with StringGridAdjacency do
if S=0 then
begin // Граф не задан
ColCount:=2; RowCount:=2;
Cells[l,0]:=''; Cells[0,1]:=''; Cells[1,1]:='';
end
else
begin // Граф введен прэвильно, выводим матрицу смежности
ColCcunt:=S+1; RowCount:=S+1;
for i:=0 to S-1 do
begin // Выводим номера строк и столсцов
Cells[i+1,0]:=IntToStr(i);
Cells[0,i+l]:=IntToStr(i);
end;
for i:=1 to S do
for j:=l to S do // выводим матрицу
Cells[i,j]:=FloatToStr(w[j-1,i-1]);
end;
end;
end;

procedure TGraphForm.ButtonFindClick (Sender: TObject);
const MaxDouble = 10E100;
var VStart, VFinish, i, j: integer; V: array of double; F: boolean; ww: double;
begin // Нажата кнопка "Найти путь"
MemoResults.Lines.Clear;
if S=0 then
begin
MemoResults.Lines.Add('Матрица не задана. Поиск невозможен.');
exit;
end;
try // Получаем номер начальной вершины
VStart:=StrToInt(EditStart.Text);
if (VStart<0) or (VStart>=S) then
Abort;
except
MemoResults.Lines.Add('Неверный номер исходной вершины.');
exit;
end;
try // Получаем номер конечной вершины
VFinish:=StrToInt(EditFinish.Text);
if (VFinish<0) or (VFinish>=5) then
Abort;
except
MemoResults.Lines.Add('Неверный номер конечной вершины.');
exit;
end;
if VStart=VFinish then
begin
MemoResults.Lines.Add('Начальная и конечная вершины совпадают.');
exit;
end;
SetLength(V,S);
for i:=0 to S-l do
V[i]:=MaXDouble;
V[VFinish]:=0; // Поиск будем вести с кннца в начало
repeat
F:=True;
for i:=0 to S-l do
if V[i]<MaxDouble then
for j:=0 to S-l do
if (i<>j) and (M[j,i]>0) and (V[i]+W[j,i]<V[j]) then
begin
V[j]:=V[i]*W[j,i];
F:=False;
end;
until F; // Выполняем цикл, пока возмоажно улучшение пути
if V[VStart]>MaxDouble/2 then
MemoResults.Lines.Add('Путь не существует.')
else
begin
MemoResults.Lines.Add('кратчайший путь (длина '+FloatToStr(V[VStart])+'):');
while VFinish<>VStart do
begin
i:=0;
for j:=0 to S-1 do
if (j<>Vstart) and (w[WStart,j]>0) and (V[V3tart]=V[j]+W[VStart,j]) then
begin
break;
end;
MemoResults.Lines.Аdd('Ребро '+IntToStr(VStart + '-'+IntToStr(i));
V3tart:=i;
end;
end;
end;

end.


Понравилась статья? Добавь ее в закладку (CTRL+D) и не забудь поделиться с друзьями:  



Сейчас читают про: