ФВТ (КХТП) / Материалы для КХТП - 2002 / 3_course / 1semester / ТОЛ (Мешалкин) / Ишова / prim1

unit prim1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Grids, ComCtrls, Menus;

type
TForm1 = class(TForm)
Grid1: TStringGrid;
Edit1: TEdit;
Label1: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Memo1: TMemo;
Label2: TLabel;
Label3: TLabel;
RichEdit1: TRichEdit;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
PrintDialog1: TPrintDialog;
PrinterSetupDialog1: TPrinterSetupDialog;
FontDialog1: TFontDialog;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
SaveDialog1: TSaveDialog;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Grid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure N5Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
Function Multi(col,row:integer):integer;
private
{ Private declarations }
public
{ Public declarations }
end;

var
n:integer;
Form1: TForm1;

implementation

{$R *.DFM}

Function TForm1.Multi(col,row:integer):integer;
var str,temp:string;
ax:array of integer;
count,cx,bx,min:integer;
begin
str:=Grid1.Cells[col,row];
count:=0;
For cx:=1 to Length(str) do
begin
if str[cx]='-' then count:=count+1;
end;
if count=0 then SetLength(ax,1)
else SetLength(ax,count+1);
bx:=0;
For cx:=1 to Length(str) do
begin
if str[cx]<>'-' then temp:=temp+str[cx]
else
begin
ax[bx]:=StrToInt(temp);
bx:=bx+1;
temp:='';
end;
if cx=Length(str) then
begin
ax[bx]:=StrToInt(temp);
{ break;}
end;
end;

min:=10000;

For cx:=0 to count+1 do
begin
if ax[cx]<min then
begin
min:=ax[cx];
bx:=cx;
end;
end;

Multi:=min;
end;

{Процедура на нажатие кнопки "ОК"}
procedure TForm1.BitBtn1Click(Sender: TObject);
var ax,cx:integer;
begin
{Создание сетки нужного размера}
n:=StrToInt(Edit1.Text);
Grid1.ColCount:=n+1;
Grid1.RowCount:=n+1;
For ax:=1 to n do
Grid1.Cols[ax].Strings[0]:=IntToStr(ax);
For ax:=1 to n do
Grid1.Cols[0].Strings[ax]:=IntToStr(ax);
{Кнопку "Выполнить" делаем видимой}
BitBtn2.Enabled:=True;
end;

{Процедура на нажатие кнопки "Выполнить"}
procedure TForm1.BitBtn2Click(Sender: TObject);
var
cost:array of integer;
dest:array of integer;
ax,y,min,bx,z,cx:integer;
str:string;
{cost-массив весов; dest-массив вершин-стоков}
begin
For ax:=1 to n do
For cx:=1 to n do
if cx=ax then Grid1.Cells[ax,cx]:='0';
RichEdit1.Lines.Clear;
RichEdit1.Lines.Add('Исходный граф:');
RichEdit1.Lines.Add('');
For ax:=1 to n do
begin
str:=Grid1.Cells[ax,1];
For cx:=2 to n do
begin
str:=str+' ';
str:=str+Grid1.Cells[ax,cx]
end;
RichEdit1.Lines.Add(str);
end;
RichEdit1.Lines.Add('');
RichEdit1.Lines.Add('');
RichEdit1.Lines.Add('');
RichEdit1.Lines.Add('Минимальный остов графа:');
{Memo1 используется для вывода на экран результатов}
Memo1.Clear;
Memo1.Lines.Add('Ts: As:');
RichEdit1.Lines.Add('Ts: As:');
Memo1.Lines.Add('x1');
RichEdit1.Lines.Add('x1');

SetLength(cost,n+1);
SetLength(dest,n+1);

{Заносим в массивы начальные значения}
{------------- Шаг1 -------------}
For ax:=1 to n do
cost[ax]:=Multi(ax,1);
min:=100000;
For ax:=1 to n do
dest[ax]:=1;
{Нахождение ребра с минимальным весом}
{------------- Шаг2 -------------}
For ax:=2 to n do
if (cost[ax]>0) and (cost[ax]<min) then
begin
min:=cost[ax];
y:=ax;
end;
{Вывод на экран}
Memo1.Lines.Add('x'+IntToStr(y)+' x'+IntToStr(dest[y])+';'+IntToStr(cost[y]));
RichEdit1.Lines.Add('x'+IntToStr(y)+' x'+IntToStr(dest[y])+';'+IntToStr(cost[y]));

{Обновляем данные}
{------------- Шаг3 -------------}
For ax:=1 to n do
Grid1.Cells[1,ax]:=IntToStr(0);
For ax:=1 to n do
Grid1.Cells[y,ax]:=IntToStr(0);
cost[y]:=0;

bx:=2;

Repeat
{------------- Шаг4 -------------}
For ax:=2 to n do
if (Multi(ax,y)<>0) and ((cost[ax]=0) or (cost[ax]>Multi(ax,y))) then
begin
cost[ax]:=Multi(ax,y);
dest[ax]:=y;
end;
min:=100000;

{Нахождение ребра с минимальным весом}
For ax:=2 to n do
if (cost[ax]>0) and (cost[ax]<min) then
begin
min:=cost[ax];
z:=ax;
end;
{Вывод на экран}
Memo1.Lines.Add('x'+IntToStr(z)+' x'+IntToStr(dest[z])+';'+IntToStr(cost[z]));
RichEdit1.Lines.Add('x'+IntToStr(z)+' x'+IntToStr(dest[z])+';'+IntToStr(cost[z]));
{Обновляем данные}
For ax:=1 to n do
Grid1.Cells[z,ax]:=IntToStr(0);
cost[z]:=0;
y:=z;
bx:=bx+1;

Until bx=n;
end;

procedure TForm1.Grid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
begin
Grid1.Cells[ARow,Acol]:=Grid1.Cells[Acol,Arow];
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
if PrintDialog1.Execute then
RichEdit1.Print('Алгоритм Прима');
end;

procedure TForm1.N3Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
FontDialog1.Font:=Memo1.Font;
if FontDialog1.Execute then begin
Memo1.Font:=FontDialog1.Font;
RichEdit1.Font:=FontDialog1.Font;
end;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
if SaveDialog1.Execute then
RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
end;

end.