Дискретная математика - теория графов (программа) - 2007 / Delphi / Diskr

unit Diskr;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ImgList, ComCtrls, StrUtils, Buttons;

type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
CheckBox1: TCheckBox;
StText1: TStaticText;
Memo1: TMemo;
GroupBox1: TGroupBox;
Button2: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
PaintBox1: TPaintBox;
Memo2: TMemo;
Button4: TButton;
Memo3: TMemo;
Button5: TButton;
PrBar1: TProgressBar;
ComboBox1: TComboBox;
BitBtn1: TBitBtn;
procedure Button1Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormActivate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Memo1Change(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure PaintBox1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
pboxdr: integer;
points:array [0..50,0..5] of integer;
lines1:array [0..50,0..50] of integer;
chkd:array [0..50] of boolean;
imax:integer;
sum: integer;
Function rec(var i:integer;chkd1:array of boolean;lv:shortint):string;
//Function rec(var i:integer):string;
implementation

{$R *.dfm}

procedure FRead();
var f,r,fl:integer;
var buf:PChar;
var fpath: string;
begin
fpath:=string(form1.edit1.Text);
Form1.sttext1.caption:='Загружен файл с графом. Начинаю чтение...';
f:=fileopen(fpath,fmOpenRead);
fl:=FileSeek(f,0,2);
FileSeek(f,0,0);
Buf:=PChar(AllocMem(fl + 1));
if f>0 then r:=fileread(f,buf^,fl) else begin
form1.edit1.Text:='Ошибка при чтении файла!';
exit;
end;
FileClose(f);
form1.Memo1.Lines.SetText(buf);
form1.sttext1.Caption:='Файл прочтен. ('+inttostr(r)+' bytes) Ожидаю комманды...';
FreeMem(Buf);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ord(key) = 13 then fread();
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sttext1.Caption:='Выбираем файл с данными о графе...';
If OpenDialog1.Execute then begin
Edit1.text:=OpenDialog1.Files.Strings[0];
FRead();
end
else
sttext1.caption:='Загрузка файла отменена. Ожидаю комманду...';
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
// edit1.Text:=Floattostr();
// edit2.Text:=FloatToStr();
form1.Top:=strtoint(floattostr(int(screen.Width/2-form1.Width/2)));
form1.Left:=strtoint(floattostr(int(screen.Height/2-form1.Height/2)));
//paintbox1.Canvas.Lock;
edit1.Text:='';
sttext1.Caption:='Ожидаю комманду...';
edit1.Text:='graph3.grph';
fread()
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,j,m,n,jmax:integer;
begin
sttext1.Caption:='Обработка данных о графе.....';
i:=0; imax:=0;
memo2.Lines.Clear;
while memo1.Lines[i] <> '' do begin
n:=1;
m:=Posex(',',memo1.Lines[i],n);
if midstr(memo1.lines[i],1,m-n) <> '' then
points[i+1,0]:=strtoint(midstr(memo1.lines[i],n,m-n)) else points[i+1,0]:=0;
n:=m+1;
{
m:=Posex(',',memo1.Lines[i],n);
if m>Posex(';',memo1.Lines[i],n) then m:=n;
if m=0 then m:=n;
if midstr(memo1.lines[i],n,m-n) <> '' then
points[i+1,1]:=strtoint(midstr(memo1.lines[i],n,m-n)) else points[i+1,1]:=0;
n:=m+1;
}
m:=Posex(';',memo1.Lines[i],n);
if m=0 then m:=n;
if midstr(memo1.lines[i],n,m-n) <> '' then
points[i+1,1]:=strtoint(midstr(memo1.lines[i],n,m-n)) else points[i+2,1]:=0;
n:=m+1;

j:=0;
jmax:=0;

while true do begin
m:=Posex(',',memo1.Lines[i],n);
if m <> 0 then if midstr(memo1.lines[i],n,m-n) <> '' then lines1[i+1,j]:=strtoint(midstr(memo1.lines[i],n,m-n)) else lines1[i+1,j]:=0 else
begin if midstr(memo1.lines[i],n,2) <> '' then lines1[i+1,j]:=strtoint(midstr(memo1.lines[i],n,2)) else lines1[i+1,j]:=0; break; end;
n:=m+1;
J:=j+1;
jmax:=j;
end;

memo2.Lines.Add(('Point '+inttostr(i+1)+': X = '+inttostr(points[i+1,0])+'; Y = '+inttostr(points[i+1,1])+'; L->P: '+inttostr(lines1[i+1,0])));

for j:=1 to jmax do memo2.lines[i]:=memo2.Lines[i]+', '+inttostr(lines1[i+1,j]);
imax:=i;
i:=i+1;
end;
sttext1.Caption:='Данные обработаны. Ожидаю Комманды...';

combobox1.Items.SetText('');
combobox1.Items.Add('Всех по очереди.');
for i:=0 to imax do combobox1.Items.Add('Точка '+inttostr(i+1));

if checkbox1.Checked then begin
//paintbox1.Canvas.Unlock;
//form1.Refresh;
paintbox1.Refresh;
sttext1.Caption:='Строю граф';
sttext1.Caption:=sttext1.Caption+'.';
sttext1.Caption:=sttext1.Caption+'.';
paintbox1.Canvas.Pen.Width:=2;
PaintBox1.Canvas.Pen.color:=clblack;
for i:=0 to imax do begin
sttext1.Caption:=sttext1.Caption+'.';
j:=0;
paintbox1.Canvas.MoveTo(points[i+1,0],points[i+1,1]);
while lines1[i+1,j] <> 0 do begin
//sleep(20);
paintbox1.Canvas.LineTo(points[lines1[i+1,j],0],points[lines1[i+1,j],1]);
paintbox1.Canvas.MoveTo(points[i+1,0],points[i+1,1]);
j:=j+1;
end;
// paintbox1.Canvas.MoveTo(points[i,0],points[i,1]);
// paintbox1.Canvas.LineTo(points[i,0],points[i,1]);
end;
prbar1.Position:=0;
prbar1.Max:=imax;
for i:=0 to imax do begin
prbar1.Position:=prbar1.Position+1;
paintbox1.Canvas.Pen.Width:=1;
paintbox1.Canvas.Brush.Color:=clbtnface;
//paintbox1.canvas.Ellipse(strtoint(floattostr(int(points[i+1,0]-points[i+1,2]))),strtoint(floattostr(int(points[i+1,1]-points[i+1,2]))),strtoint(floattostr(int(points[i+1,0]+points[i+1,2]))),strtoint(floattostr(int(points[i+1,1]+points[i+1,2]))));
paintbox1.Canvas.Pen.Color:=clBlack;
paintbox1.Canvas.Pen.Width:=14;
sttext1.Caption:=sttext1.Caption+'.';
paintbox1.Canvas.MoveTo(points[i+1,0],points[i+1,1]);
paintbox1.Canvas.LineTo(points[i+1,0],points[i+1,1]);
paintbox1.Canvas.Pen.Color:=clBlue;
paintbox1.Canvas.Pen.Width:=12;
sttext1.Caption:=sttext1.Caption+'.';
paintbox1.Canvas.MoveTo(points[i+1,0],points[i+1,1]);
paintbox1.Canvas.LineTo(points[i+1,0],points[i+1,1]);
paintbox1.Canvas.Pen.Color:=clBlack;
paintbox1.Canvas.Brush.Color:=clBlue;
paintbox1.Canvas.Font.Color:=clwhite;
paintbox1.Canvas.Font.size:=7;
paintbox1.Canvas.TextOut(points[i+1,0]-2,points[i+1,1]-5,''+inttostr(i+1)+'');
end;

//paintbox1.Canvas.Lock;
sttext1.Caption:='Граф построен. Ожидаю Комманды...';
end;


end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//paintbox1.Canvas.LineTo(x,y);
pboxdr:=0;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
paintbox1.Canvas.MoveTo(x,y);
pboxdr:=1;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if pboxdr = 1 then paintbox1.Canvas.LineTo(x,y);
end;


procedure TForm1.FormDblClick(Sender: TObject);
begin
button3.Click;
end;

procedure TForm1.Button4Click(Sender: TObject);
var FFnd:TextFile;
buf:PChar;
fpath: string;
begin
fpath:=string(form1.edit1.Text);
sttext1.caption:='Сохраняю граф....';
Buf:=PChar(memo1.Text);
AssignFile(FFnd,fpath);
FileMode:=1;
rewrite(FFnd);
Write(FFnd,Buf);
CloseFile(FFnd);
form1.Memo1.Lines.SetText(buf);
form1.sttext1.Caption:='Файл Сохранен. Ожидаю комманды...';
// FreeMem(Buf);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
ways: array [0..65000] of PChar;
sums: array [0..65000] of Integer;
i:integer;
chkd1:array [0..50] of boolean;
begin
for i:=0 to 50 do chkd[i]:=false;
for i:=0 to 50 do chkd1[i]:=false;
memo3.text:='';
if form1.combobox1.ItemIndex = -1 then begin
combobox1.ItemIndex:=1;
end;
i:=combobox1.ItemIndex;
button3.Click;
memo2.Lines.Add('Rec = '+#13#10+rec(i,chkd1,0));
//button5.Click;
//sttext1.Caption:=inttostr(sum)
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
button3.Click;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
button3.Click;
end;

procedure TForm1.PaintBox1Click(Sender: TObject);
begin
button3.Click;
end;

procedure TForm1.Button5Click(Sender: TObject);
var i,j:integer;
leng: array [0..50,0..50] of integer;
checked: array [0..50,0..50] of boolean;
begin
for i:=0 to 50 do
for j:=0 to 50 do leng[i,j]:=0;
for i:=0 to 50 do
for j:=0 to 50 do checked[i,j]:=false;

for i:=0 to Form1.memo3.Lines.Count do Form1.memo3.Lines[i]:='';
Form1.memo3.text:='';
i:=0;
while i<=imax do begin
i:=i+1;
j:=0;
while true do begin
if lines1[i,j] = 0 then break;
leng[i,j]:=strtoint(floattostr(int(sqrt(sqr(points[i,0]-points[lines1[i,j],0])+sqr(points[i,1]-points[lines1[i,j],1])))));
Form1.memo2.Lines[i-1]:=Form1.memo2.Lines[i-1]+' Расст: '+inttostr(leng[i,j]);
Form1.memo3.Lines.add(inttostr(i)+') Расст ('+inttostr(j)+') = '+inttostr(leng[i,j]));
j:=j+1;
end;
end;
Form1.memo3.Lines.add('----Полный путь:----');
sum:=0;
i:=1;
while i<=imax do begin
j:=0;
while true do begin
if lines1[i,j] = 0 then break;
checked[i,lines1[i,j]]:=true;
if checked[lines1[i,j],i] = false then sum:=sum+leng[i,j];
j:=j+1;
end;
i:=i+1;
end;
Form1.memo3.Lines.add('Sum = '+inttostr(sum));

end;


Function rec(var i:integer;chkd1:array of boolean;lv:shortint):string;
//Function rec(var i:integer):string;
var j,z:integer;
rez:string;
chkd2:array [0..50] of boolean;
begin
form1.PaintBox1.Canvas.MoveTo(points[i,0],points[i,1]);
// for j:=0 to 50 do chkd2[j]:=false;
chkd1[i]:=true;
for j:=0 to 50 do chkd2[j]:=chkd1[j];
j:=0;
while true do begin
Form1.memo3.Lines.add('i: '+inttostr(i)+' j: '+inttostr(j));
if lines1[i,j] = 0 then break
else begin
if (chkd1[lines1[i,j]] = false) then begin
//chkd2[lines1[i,j]]:=true;
if Form1.checkbox1.Checked then begin
form1.PaintBox1.Canvas.Pen.color:=clred;
form1.PaintBox1.Canvas.Pen.Width:=1;
form1.PaintBox1.Canvas.LineTo(points[lines1[i,j],0],points[lines1[i,j],1]);
end;//(Form1.checkbox1.Checked)
rez:=rez+rec(lines1[i,j],chkd2,lv+1);
end //if chkd[i] = false
else
if (lv = 3) and (lines1[i,j] = 1) then rez:=''+inttostr(lines1[i,j])+''#13#10+''+inttostr(lines1[i,j])+'->';//else if chkd[i] = false
end;//else if lines1[i,j] = 0
j:=j+1;
//rez:='['+inttostr(i)+']'+rez+#13#10;
end;//while true

if lv=0 then Result:=''+inttostr(i)+'->'+rez+''+inttostr(i)+''
else Result:=''+inttostr(i)+'->'+rez;
//Result:=inttostr(i)+'->'+rez;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
memo2.Text:='';
memo2.WordWrap:=true;
memo2.Lines.Add('Версия 1.0.41.219 В следующих версиях: возможность двигать точки мышкой. Создание точки одним кликом, подбор конфигурации грфа по заданным расстояниям между точками без указания их координать и многое другое :)');
memo2.Lines.Add('<<= Здесь пишется содержание файла. Чтобы менят график просто меняйте значения там. Чтобы сохранить изменения внизу есть кнопка "Сохранить".');
memo2.Lines.Add('Вот прямо тут пишется ход обработки файла, фактически это ни на что не влияет.');
memo2.Lines.Add('В соседнем окошке (=>>) пишутся промежуточные результаты. Изменять ручками тоже нет ни малейшего смысла.');
memo2.Lines.Add('Каждая тточка графа описывается вот так: координата_Х,координата_Y;связь_с_точкой2,связь_с_точкой3,и т.д.');
//memo2.WordWrap:=false;
end;

end.