Interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Grids, Menus,
ExtCtrls, Types, Math ;
type
{ TForm4 }
TForm4 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
MainMenu1: TMainMenu;
Memo1: TMemo;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect);
procedure StringGrid1KeyPress(Sender: TObject; var Key: char);
procedure StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer;
var CanSelect: Boolean);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer);
private
public
end;
var
Form4: TForm4;
count: integer; // число вершин до 10 шт!!!!
g : array of array of integer;
dist : array of integer;
done : array of boolean;
const maxlongint = 100; // Ввод ограничен до 99
Implementation
{$R *.lfm}
{ TForm4 }
procedure Floid(n : integer);
var
k,i,j:integer;
begin
for k:=0 to n - 1 do
for i:=0 to n - 1 do
for j:=0 to n - 1 do
g[i,j] := Min(g[i,j], g[i,k] + g[k,j]);
end;
procedure Dijkstra(s : longint; n : longint);
var
i, bliz, x :integer;
begin
setlength(dist,Length(dist)+n);
setlength(done,Length(done)+n);
for i:=0 to n - 1 do
begin
dist[i] := maxlongint;
done[i] := false;
end;
dist[s] := 0;
for i:=0 to n - 1 do
begin
bliz := -1;
for x:=0 to n - 1 do
if ((not done[x]) and ((bliz = -1) or (dist[x] < dist[bliz]))) then bliz := x;
if dist[bliz] = maxlongint then break;
done[bliz] := true;
for x:=0 to n - 1 do
if (g[bliz,x] <> maxlongint)
then begin
if (dist[bliz] + g[bliz,x] < dist[x]) then dist[x] := dist[bliz] + g[bliz,x];
end;
end;
end;
procedure TForm4.Button1Click(Sender: TObject); // Добавить вершину
begin
if count>10 then begin
showmessage ('Не больше 10 вершин!');
exit;
end;
count:= count + 1;
StringGrid1.RowCount:=count;
StringGrid1.ColCount:=count;
StringGrid1.Cells [0,count-1]:= inttostr(count-1);
StringGrid1.Cells [count-1,0]:= inttostr(count-1);
end;
procedure TForm4.Button2Click(Sender: TObject); // Удалить вершину
begin
if count=1 then begin
showmessage ('Больше нечего удалять!');
exit;
end;
count:= count - 1;
StringGrid1.RowCount:=count;
StringGrid1.ColCount:=count;
end;
procedure TForm4.Button3Click(Sender: TObject); // очистить таблицу
var
i,j:integer;
begin
if count = 1 then exit;
for i:=1 to count-1 do
for j:=1 to count-1 do
StringGrid1.Cells [i,j]:='';
end;
procedure TForm4.Button4Click(Sender: TObject); // Построить граф
var
i,j:integer;
begin
if count-1<2 then begin
showmessage('Слишком мало вершин!');
exit;
end;
g:=nil;
ComboBox1.clear;
ComboBox2.clear;
ComboBox3.clear;
memo1.clear;
for j:=0 to (count-2) do begin
setLength(g, Length(g)+1, Length(g)+1);
for i := 0 to Length(g)-1 do
begin
g[i, Length(g)-1] := maxlongint;
g[Length(g)-1, i] := maxlongint;
end;
end;
// ребра!
for i:=1 to count-1 do
for j:=1 to count-1 do
if (StringGrid1.Cells [i,j] <>'') and (StringGrid1.Cells [i,j] <> '0') then begin
g[j-1,i-1]:=strtoint(StringGrid1.Cells [i,j]) ;
Floid(Length(g));
end;
for i:=1 to count-1 do begin
ComboBox1.Items.Add(inttostr(i));
ComboBox2.Items.Add(inttostr(i));
ComboBox3.Items.Add(inttostr(i));
end;
end;
procedure TForm4.Button5Click(Sender: TObject); //Найти все расстаяния от заданной вершины до остальных
var
x,i:integer;
begin
Memo1.clear;
if Combobox1.text='' then exit;
x:=strtoint(Combobox1.text);
x:=x-1;
Dijkstra(x, Length(g));
Memo1.lines.Add('Все расстояния от вершины ' + inttostr(x+1) + ' :');
for i:=0 to Length(g) - 1 do
if (i <> x) then
begin
Memo1.lines.Add('От ' + inttostr(x+1) + ' до '+ inttostr(i+1));
if (dist[i] = maxlongint) then
Memo1.lines.Add('Не существует!') else
Memo1.lines.Add(': '+ inttostr(dist[i]));
end;
end;
procedure TForm4.Button6Click(Sender: TObject); // Найти растояние между 2 вершинами
var
s:string;
s2,s3:integer;
begin
memo1.clear;
if (Combobox2.text='') or (Combobox3.text = '') or (Combobox2.text=Combobox3.text) then begin
Memo1.lines.Add ('Ошибка!');
exit;
end;
s2:=strtoint(Combobox2.text)-1;
s3:=strtoint(Combobox3.text)-1;
if g[s2,s3] = maxlongint then
s:= 'не существует!' else
s:= inttostr(g[s2,s3]);
Memo1.lines.Add ('Расстояние между вершинами '+Combobox2.text+' и '+ Combobox3.text +': '+s);
end;
procedure TForm4.FormShow(Sender: TObject); // при открытии!!!
begin
count:=1; // есть только нулевая вершина
StringGrid1.RowCount:=count;
StringGrid1.ColCount:=count;
memo1.clear;
g:=nil;
ComboBox1.clear;
ComboBox2.clear;
ComboBox3.clear;
end;
procedure TForm4.MenuItem2Click(Sender: TObject); // Задание
begin
Showmessage('Задание. Представить ориентированный граф, состоящий из 7-10 вер'+
'шин, с помощью матрицы смежности. Указать вершину-источник, а затем'+
'решить следующие задачи.'+#13#10+
'1. Кратчайшие пути от вершины-источника до всех вершин орграфа на'+
'основе алгоритма Дейкстры.'+#13#10+
'2. Кратчайшие расстояния между каждой парой вершин орграфа на ос'+
'нове алгоритма Флойда.');
end;
procedure TForm4.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; // закрашиваем ячейки
aRect: TRect);
begin
StringGrid1.Canvas.Brush.Color:=clSilver;
if ((ACol=1)and(ARow=1)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=2)and(ARow=2)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=3)and(ARow=3)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=4)and(ARow=4)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=5)and(ARow=5)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=6)and(ARow=6)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=7)and(ARow=7)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=8)and(ARow=8)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=9)and(ARow=9)) then
StringGrid1.Canvas.FillRect(aRect);
if ((ACol=10)and(ARow=10)) then
StringGrid1.Canvas.FillRect(aRect);
end;
procedure TForm4.StringGrid1KeyPress(Sender: TObject; var Key: char); // ограничение ввода
begin
if not (Key in ['0'..'9', #8]) then Key := #0;
if length(StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row])=2 then key:=#0;
end;
procedure TForm4.StringGrid1SelectCell(Sender: TObject; aCol, aRow: Integer; // запрет на ввод
var CanSelect: Boolean);
begin
if (ACol = 1) and (ARow = 1) then CanSelect:= False;
if (ACol = 2) and (ARow = 2) then CanSelect:= False;
if (ACol = 3) and (ARow = 3) then CanSelect:= False;
if (ACol = 4) and (ARow = 4) then CanSelect:= False;
if (ACol = 10) and (ARow = 10) then CanSelect:= False;
if (ACol = 5) and (ARow = 5) then CanSelect:= False;
if (ACol = 6) and (ARow = 6) then CanSelect:= False;
if (ACol = 7) and (ARow = 7) then CanSelect:= False;
if (ACol = 8) and (ARow = 8) then CanSelect:= False;
if (ACol = 9) and (ARow = 9) then CanSelect:= False;
if StringGrid1.Cells [ACol,ARow] = '0' then CanSelect:= False;
end;
procedure TForm4.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer);
begin
if StringGrid1.Cells [ACol,ARow] <>'' then
StringGrid1.Cells [ARow,ACol] := '0';
end;
end.