Добавил:
Tushkan
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Программа для построения и анализа графов / Unit1
.pasunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids, Spin, URoute,
Uostov, IniFiles, jpeg, Utype, Uconnectivity, spSkinShellCtrls, Menus,
SkinMenus, spDialogs, SkinData, DynamicSkinForm, SkinCtrls, SkinBoxCtrls,
Mask, spColorCtrls, SkinGrids, SkinTabs, Ufund,
SkinExCtrls, UGraph, math, AppEvnts;
type
TForm1 = class(TForm)
spSkinPageControl1: TspSkinPageControl;
spSkinTabSheet2: TspSkinTabSheet;
Tab1: TspSkinTabSheet;
SGSm: TspSkinStringGrid;
spSkinLabel2: TspSkinLabel;
SgIn: TspSkinStringGrid;
spSkinLabel3: TspSkinLabel;
LBRoute: TspSkinListBox;
BtnStartSearchRoute: TspSkinButton;
NptVes: TspSkinInputDialog;
EdtKolMar: TspSkinSpinEdit;
spSkinLabel5: TspSkinLabel;
MnuV: TspSkinPopupMenu;
MnuE: TspSkinPopupMenu;
mnuRec: TspSkinPopupMenu;
mnuDeV: TMenuItem;
mnuCommentV: TMenuItem;
mnuIconV: TMenuItem;
mnuDelE: TMenuItem;
MnuVesE: TMenuItem;
MnuClear: TMenuItem;
MnuCreateV: TMenuItem;
spSkinTabSheet3: TspSkinTabSheet;
spSkinTabSheet4: TspSkinTabSheet;
btnclika3: TspSkinButton;
btnklika4: TspSkinButton;
btnklika5: TspSkinButton;
btnklika6: TspSkinButton;
btpPetersen: TspSkinButton;
spSkinTabSheet1: TspSkinTabSheet;
btnColorV: TspSkinColorButton;
btnMoveV: TspSkinColorButton;
btnDragV: TspSkinColorButton;
btncolorE: TspSkinColorButton;
btnmoveE: TspSkinColorButton;
btncolorRect: TspSkinColorButton;
btncolorDelv: TspSkinColorButton;
btncolordelE: TspSkinColorButton;
btncolorselV: TspSkinColorButton;
btncolorselE: TspSkinColorButton;
spSkinLabel7: TspSkinLabel;
spSkinLabel8: TspSkinLabel;
EdtRad: TspSkinSpinEdit;
EdtDelta: TspSkinSpinEdit;
spSkinLabel9: TspSkinLabel;
spSkinLabel10: TspSkinLabel;
spSkinLabel11: TspSkinLabel;
spSkinLabel12: TspSkinLabel;
spSkinLabel14: TspSkinLabel;
spSkinLabel15: TspSkinLabel;
chkNameE: TspSkinCheckRadioBox;
chkOptVes: TspSkinCheckRadioBox;
chkNov: TspSkinCheckRadioBox;
spSkinLabel16: TspSkinLabel;
spSkinLabel17: TspSkinLabel;
spSkinLabel4: TspSkinLabel;
edtskin: TspSkinEdit;
btnselectskin: TspSkinButton;
btnReloadoptions: TspSkinButton;
btnDefaultOptions: TspSkinButton;
btnSaveOptions: TspSkinButton;
spSkinLabel18: TspSkinLabel;
spSkinLabel19: TspSkinLabel;
spSkinLabel20: TspSkinLabel;
spSkinTabSheet5: TspSkinTabSheet;
LbOstov: TspSkinListBox;
btnSearchOstov: TspSkinButton;
LblOstovCount: TspSkinLabel;
LBMinOstov: TspSkinListBox;
lblMinOstov: TspSkinLabel;
spSkinLabel22: TspSkinLabel;
spnSizeFont: TspSkinSpinEdit;
spOpenSkinDialog1: TspOpenSkinDialog;
edtFileOpt: TspSkinEdit;
btnOpenOpt: TspSkinButton;
dlgFileOpen: TspSkinOpenDialog;
dlgFilesave: TspSkinSaveDialog;
spSkinLabel23: TspSkinLabel;
lbtmpOpenGraph: TspSkinListBox;
dlgSavePicture: TspSkinSavePictureDialog;
mnuSaveGraph: TMenuItem;
N2: TMenuItem;
lblRoutecount: TspSkinLabel;
dlgSelDir: TspSkinSelectDirectoryDialog;
spSkinTabSheet6: TspSkinTabSheet;
spSkinLabel24: TspSkinLabel;
lbSvaznost: TspSkinListBox;
lblSvyazCount: TspSkinLabel;
btnKlika3x3: TspSkinButton;
popupRoute: TPopupMenu;
MnuSaveRoute: TMenuItem;
mnuSaveImgRoute: TMenuItem;
popupOstov: TPopupMenu;
mnuSaveOstov: TMenuItem;
mnuSaveImgOstov: TMenuItem;
lblRouteInfo: TspSkinLabel;
lblOstovinfo: TspSkinLabel;
spSkinTabSheet7: TspSkinTabSheet;
lbfundcycle: TspSkinListBox;
lblCikl: TspSkinLabel;
SGCikl: TspSkinStringGrid;
lblKocikl: TspSkinLabel;
sgkocikl: TspSkinStringGrid;
lbfundKocycle: TspSkinListBox;
spSkinTabSheet8: TspSkinTabSheet;
spSkinLabel28: TspSkinLabel;
spSkinLabel25: TspSkinLabel;
spSkinLabel27: TspSkinLabel;
BtnMinPath: TspSkinButton;
LbMinPath: TspSkinListBox;
mnuPotok: TMenuItem;
spSkinTabSheet9: TspSkinTabSheet;
spSkinLabel13: TspSkinLabel;
spSkinLabel21: TspSkinLabel;
cmbIst: TspSkinComboBox;
cmbStok: TspSkinComboBox;
spSkinTabSheet10: TspSkinTabSheet;
spSkinLabel1: TspSkinLabel;
ChkOrgraph: TspSkinCheckRadioBox;
edtKolV: TspSkinNumericEdit;
ChkVzves: TspSkinCheckRadioBox;
edtkole: TspSkinNumericEdit;
spSkinLabel6: TspSkinLabel;
chkSet: TspSkinCheckRadioBox;
spSkinTabSheet11: TspSkinTabSheet;
LbNazav: TspSkinListBox;
lbDomin: TspSkinListBox;
spSkinLabel26: TspSkinLabel;
spSkinLabel29: TspSkinLabel;
spSkinLabel31: TspSkinLabel;
LbNezavMax: TspSkinListBox;
spSkinLabel32: TspSkinLabel;
LBDominMin: TspSkinListBox;
lbKliki: TspSkinListBox;
spSkinLabel30: TspSkinLabel;
lblPlanar: TspSkinLabel;
spSkinLabel33: TspSkinLabel;
lbDvusvyaz: TspSkinListBox;
cmbendv: TspSkinComboBox;
cmbstartv: TspSkinComboBox;
spSkinListView1: TspSkinListView;
spSkinLabel34: TspSkinLabel;
LBMinRazrez: TspSkinListBox;
BtnWeb: TspSkinButton;
spSkinLabel35: TspSkinLabel;
btnColoring: TspSkinButton;
btnCreatereb: TspSkinButton;
spDynamicSkinForm1: TspDynamicSkinForm;
spSkinData1: TspSkinData;
spCompressedStoredSkin1: TspCompressedStoredSkin;
imgGraph: TImage;
spSkinPanel1: TspSkinPanel;
lblOdnorod: TspSkinLabel;
lblClicka: TspSkinLabel;
lblSvyaz1: TspSkinLabel;
lblsvyazcount2: TspSkinLabel;
spSkinLabel36: TspSkinLabel;
BtnOpenGraph: TspSkinMenuButton;
PopupOpenGraph: TspSkinPopupMenu;
mnuOpeninc: TMenuItem;
mnuOpenSm: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
mnuOpenGraph: TMenuItem;
spSkinButton1: TspSkinButton;
procedure mnuCreateVClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure imgGraphMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuDeVClick(Sender: TObject);
procedure mnuCommentVClick(Sender: TObject);
procedure imgGraphMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgGraphMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure chkOptVesClick(Sender: TObject);
procedure chkNameEClick(Sender: TObject);
procedure chkNovClick(Sender: TObject);
procedure ChkVzvesClick(Sender: TObject);
procedure ChkOrgraphClick(Sender: TObject);
procedure btncolorRectChangeColor(Sender: TObject);
procedure spSkinUpDown1Change(Sender: TObject);
procedure mnuDelEClick(Sender: TObject);
procedure MnuVesEClick(Sender: TObject);
procedure MnuClearClick(Sender: TObject);
procedure BtnStartSearchRouteClick(Sender: TObject);
procedure LBRouteMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure LBRouteListBoxKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure btnclika3Click(Sender: TObject);
procedure btnklika4Click(Sender: TObject);
procedure btnklika5Click(Sender: TObject);
procedure btnklika6Click(Sender: TObject);
procedure btnSearchOstovClick(Sender: TObject);
procedure LbOstovMouseLeave(Sender: TObject);
procedure btpPetersenClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnDefaultOptionsClick(Sender: TObject);
procedure arrcolSet;
procedure btnReloadoptionsClick(Sender: TObject);
procedure btnselectskinClick(Sender: TObject);
procedure btnOpenOptClick(Sender: TObject);
procedure edtFileOptKeyPress(Sender: TObject; var Key: Char);
procedure btnSaveOptionsClick(Sender: TObject);
procedure btnSaveGraphClick(Sender: TObject);
procedure lbtmpOpenGraphListBoxDblClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure btnsaveimgrouteClick(Sender: TObject);
procedure btnsaveallimgrouteClick(Sender: TObject);
procedure btnsaverouteClick(Sender: TObject);
procedure btnSaveallrouteClick(Sender: TObject);
procedure btnKlika3x3Click(Sender: TObject);
procedure lbtmpOpenGraphListBoxMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure LBRouteListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuGetRouteClick(Sender: TObject);
procedure btnSaveOstovClick(Sender: TObject);
procedure btnSaveallostovClick(Sender: TObject);
procedure btnSaveimgOstovClick(Sender: TObject);
procedure btnSaveallimgostovClick(Sender: TObject);
procedure btnSaveMinOstovClick(Sender: TObject);
procedure btnSaveIMGMinOstovClick(Sender: TObject);
procedure mnuGetOstovClick(Sender: TObject);
procedure LbOstovListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Hold(flag: boolean = true);
procedure BtnMinPathClick(Sender: TObject);
procedure spSkinPageControl1Change(Sender: TObject);
procedure spSkinLabel1Click(Sender: TObject);
procedure chkSetClick(Sender: TObject);
procedure mnuPotokClick(Sender: TObject);
procedure BtnWebClick(Sender: TObject);
procedure spSkinPageControl1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure spSkinPageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
procedure btnColoringClick(Sender: TObject);
procedure sprebMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure btnCreaterebClick(Sender: TObject);
procedure edtves(sender: tobject);
procedure action(sender: tobject = nil);
procedure spDynamicSkinForm1ChangeSkinData(Sender: TObject);
procedure lbtmpOpenGraphMouseLeave(Sender: TObject);
procedure btpPetersenMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnclika3MousecaMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnklika4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnklika5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnklika6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure btnKlika3x3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lbtmpOpenGraphDrawItem(Cnvs: TCanvas; Index, ItemWidth,
ItemHeight: Integer; TxtRect: TRect; State: TOwnerDrawState);
procedure mnuSaveImgOstovClick(Sender: TObject);
procedure mnuOpenGraphClick(Sender: TObject);
procedure mnuOpenincClick(Sender: TObject);
procedure mnuOpenSmClick(Sender: TObject);
procedure spSkinButton1Click(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
tab: integer;
CtrlReb: array of array[1..4] of tobject;
implementation
uses ShellAPI;
{$R *.dfm}
procedure TForm1.btnselectskinClick(Sender: TObject);
begin
try
spOpenSkinDialog1.Execute;
if copy(spOpenSkinDialog1.FileName, length(spOpenSkinDialog1.FileName) - 3,
4) = '.skn' then begin
spCompressedStoredSkin1.LoadFromCompressFile(spOpenSkinDialog1.FileName);
spCompressedStoredSkin1.FileName:=spOpenSkinDialog1.FileName;
end else if copy(spOpenSkinDialog1.FileName, length(spOpenSkinDialog1.FileName)
- 3, 4) = '.ini' then begin
spCompressedStoredSkin1.LoadFromIniFile(spOpenSkinDialog1.FileName);
spCompressedStoredSkin1.FileName:=spOpenSkinDialog1.FileName;
end;
finally
spSkinData1.CompressedStoredSkin:=spCompressedStoredSkin1;
edtskin.Text := ExtractFileName(spOpenSkinDialog1.FileName);
// if edtskin.Text = '' then
// edtskin.Text := spCompressedStoredSkin1.FileName;
self.Refresh;
end;
end;
procedure TForm1.btnSaveallimgostovClick(Sender: TObject);
{var i: integer;
canv: tbitmap;
jpeg: TJPEGImage;
}begin
//if (not G_SaveAllIMGostov)and (length(g.TsOstov) >0) then
// // RERoute.Lines.Strings[2]:='Не возможно сохранить пока идет поиск'
// begin
// // RERoute.Lines.Strings[2]:='Сохранение ' + inttostr(g.TsOstov..Count) + ' изображений';
// G_SaveAllIMGostov:=true;
// btnsaveallimgostov.Caption:='Остановить сохранение';
// if dlgSelDir.Execute then begin
// canv:=TBitmap.Create;
// canv.Width := 300;
// canv.Height :=300;
// jpeg:=TJPEGImage.Create;
// for i := 0 to length(g.TsOstov)-1 do
// if G_SaveAllRoute then
// try
// ProcessMessages;
// G.draw(canv.Canvas);
// TGraph(g.TsOstov[i]^).draw(canv.Canvas, true);
// jpeg.Assign(canv);
// jpeg.savetofile(dlgSelDir.Directory+'\'+inttostr(i)+'.bmp');
// // RERoute.Lines.Strings[2]:='Сохранено ' + inttostr(i+1)+' из ' + inttostr(g.TsOstov..Count);
// except
// end
// else
// break;
// canv.Free;
// jpeg.Free
// end;
// btnsaveallimgostov.Caption:='Сохранить все изображения';
// G_SaveAllIMGostov:=false;
// end
// else begin
// btnsaveallimgostov.Caption:='Сохранить все изображения';
// G_SaveAllIMGostov:=false;
// end;
end;
procedure TForm1.btnclika3Click(Sender: TObject);
begin
g.create(3);
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnclika3MousecaMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var gt: tgraph;
begin
gt:=tgraph.Create(3);
gt.Draw(imggraph.canvas);
gt.delete;
gt.Free;
end;
procedure TForm1.btnColoringClick(Sender: TObject);
var chromaticnumber:integer;
begin
if g.Coloring(chromaticnumber)=1 then
begin
spSkinLabel35.Caption:='Полученное хроматическое число: '+inttostr(chromaticnumber);
g.draw(imgGraph.Canvas);
end;
end;
procedure TForm1.btncolorRectChangeColor(Sender: TObject);
begin
arrcolSet;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnCreaterebClick(Sender: TObject);
var a, i: integer;
begin
a:=high(g.e);
for i := 1 to a do
g.Create(g.e[i].p2, g.e[i].p1);
g.draw(imgGraph.Canvas);
action;
end;
procedure TForm1.btnDefaultOptionsClick(Sender: TObject);
begin
chkNov.Checked:=true;
chkNameE.Checked:=true;
chkOptVes.Checked:=false;
btnColorV.ColorValue:=clBlack;
btnMoveV.ColorValue:=clGreen;
btnDragV.ColorValue:=clPurple;
btncolorDelv.ColorValue:=clred;
btncolorE.ColorValue:=clblack;
btnmoveE.ColorValue:=clgreen;
btncolordelE.ColorValue:=clred;
btncolorRect.ColorValue:=clblack;
EdtDelta.Value:=3;
EdtRad.Value:=10;
spnSizeFont.Value:=12;
btncolorselV.ColorValue:=clTeal;
btncolorselE.ColorValue:=clteal;
edtskin.Text := ExtractFileName(spCompressedStoredSkin1.FileName);
arrcolset;
end;
procedure TForm1.btnKlika3x3Click(Sender: TObject);
var i, j: integer;
begin
g:=Tgraph.Create;
g.comment:='Клика 3,3';
g.Orgraph:=ChkOrgraph.Checked;
g.vzves:=ChkVzves.Checked;
try
for i := 1 to 3 do
g.Create(round(g.col.he/6), round(g.col.he*(1/6+(i-1)/3)));
for i := 1 to 3 do
g.Create(round(g.col.he*5/6), round( g.col.he*(1/6+(i-1)/3)));
for j := 1 to 3 do
for i := 1 to 3 do
g.Create(g.V[j], g.V[i+3]);
except
end;
for i := 1 to high(g.V) do
g.V[i].status:=g.col.colorV;
for i := 1 to high(g.E) do
g.e[i].status:=g.col.colorE;
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnKlika3x3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var i, j: integer;
gt: tgraph;
begin
gt:=Tgraph.Create;
gt.comment:='Клика 3,3';
gt.Orgraph:=ChkOrgraph.Checked;
gt.vzves:=ChkVzves.Checked;
try
for i := 1 to 3 do
gt.Create(round(gt.col.he/6), round(gt.col.he*(1/6+(i-1)/3)));
for i := 1 to 3 do
gt.Create(round(gt.col.he*5/6), round( gt.col.he*(1/6+(i-1)/3)));
for j := 1 to 3 do
for i := 1 to 3 do
gt.Create(gt.V[j], gt.V[i+3]);
except
end;
for i := 1 to high(gt.V) do
gt.V[i].status:=gt.col.colorV;
for i := 1 to high(gt.E) do
gt.e[i].status:=gt.col.colorE;
gt.draw(imgGraph.Canvas);
gt.delete;
gt.Free;
end;
procedure TForm1.btnklika6Click(Sender: TObject);
begin
g.create(6);
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnklika6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var gt: tgraph;
begin
gt:=tgraph.Create(6);
gt.Draw(imggraph.canvas);
gt.delete;
gt.Free;
end;
procedure TForm1.btnklika4Click(Sender: TObject);
begin
g.create(4);
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnklika4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var gt: tgraph;
begin
gt:=tgraph.Create(4);
gt.Draw(imggraph.canvas);
gt.delete;
gt.Free;
end;
procedure TForm1.btnklika5Click(Sender: TObject);
begin
g.create(5);
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btnklika5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var gt: tgraph;
begin
gt:=tgraph.Create(5);
gt.Draw(imggraph.canvas);
gt.delete;
gt.Free;
end;
procedure TForm1.BtnMinPathClick(Sender: TObject);
var len:integer;
gp:tgraph;
begin
try
LbMinPath.Items.Clear;
case g.SearchMinPath(gp,tv(cmbstartv.Items.Objects[cmbstartv.ItemIndex]),tv(cmbendv.Items.Objects[cmbendv.ItemIndex]),len) of
1:LbMinPath.Items.AddObject('Мин путь длины '+IntToStr(len),gp);
-1:LbMinPath.Items.AddObject('Не подходящий граф',nil);
-2:LbMinPath.Items.AddObject('Отсутствует путь',nil);
end;
finally
end
end;
procedure TForm1.btnOpenOptClick(Sender: TObject);
begin
dlgFileOpen.Filter:='INI File|*.ini';
if dlgFileOpen.Execute then begin
g.col^.filesave:=dlgFileOpen.FileName;
btnReloadoptionsClick(nil);
arrcolset;
edtFileOpt.Text:=g.col^.filesave;
end else
edtFileOpt.Text:='Default';
end;
procedure TForm1.btnReloadoptionsClick(Sender: TObject);
var fileopt: TIniFile;
str:string;
begin
edtFileOpt.Text:= G_Arrcol.filesave;
fileopt:=TIniFile.Create(G_Arrcol.filesave);
chkNov.Checked:=fileOpt.ReadBool('chk', 'chkNov', true);
chkNameE.Checked:=fileOpt.ReadBool('chk', 'chkNamee', true);
chkOptVes.Checked:=fileOpt.ReadBool('chk', 'chkOptVes', false);
btnColorV.ColorValue:=fileOpt.ReadInteger('color', 'ColorV', clBlack);
btnMoveV.ColorValue:=fileOpt.ReadInteger('color', 'MoveV', clgreen);
btnDragV.ColorValue:=fileOpt.ReadInteger('color', 'DragV', clPurple);
btncolorDelv.ColorValue:=fileOpt.ReadInteger('color', 'DelV', clred);
btncolorE.ColorValue:=fileOpt.ReadInteger('color', 'colorE', clBlack);
btnmoveE.ColorValue:=fileOpt.ReadInteger('color', 'movee', clGreen);
btncolordelE.ColorValue:=fileOpt.ReadInteger('color', 'delE', clred);
btncolorRect.ColorValue:=fileOpt.ReadInteger('color', 'rect', clBlack);
EdtDelta.Value:=fileOpt.ReadInteger('num', 'delta', 3);
EdtRad.Value:=fileOpt.ReadInteger('num', 'rad', 10);
spnSizeFont.Value:=fileOpt.ReadInteger('num', 'sizefont', 18);
btncolorselV.ColorValue:=fileOpt.ReadInteger('color', 'selv', clteal);
btncolorselE.ColorValue:=fileOpt.ReadInteger('color', 'sele', clteal);
str:= fileOpt.readString('skin', 'file', '');
try
if copy(str, length(str) - 3, 4) = '.skn' then begin
spCompressedStoredSkin1.LoadFromCompressFile(str);
end else if copy(str, length(str) - 3, 4) = '.ini' then begin
spCompressedStoredSkin1.LoadFromIniFile(str);
end;
spCompressedStoredSkin1.FileName:=str;
spSkinData1.CompressedStoredSkin:=spCompressedStoredSkin1;
edtskin.Text := ExtractFileName(str);
self.Refresh;
except
end;
fileOpt.Free;
end;
procedure TForm1.btnsaveallimgrouteClick(Sender: TObject);
{var i: integer;
canv: tbitmap;
jpeg: TJPEGImage;
}begin
//if (not G_SaveAllIMGRoute)and (length(g.TsRoute) >0) then begin
// lblRouteInfo.Caption:='Сохранение ' + inttostr(length(g.TsRoute)) + ' изображений';
// G_SaveAllIMGRoute:=true;
// btnsaveallimgroute.Caption:='Остановить сохранение';
// if dlgSelDir.Execute then begin
// canv:=TBitmap.Create;
// canv.Width := 300;
// canv.Height :=300;
// jpeg:=TJPEGImage.Create;
// for i := 0 to length(g.TsRoute)-1 do
// if G_SaveAllimgRoute then
// try
// ProcessMessages;
// G.draw(canv.Canvas);
// TGRAph(g.TsRoute[i]^).draw(canv.Canvas, true);
// jpeg.Assign(canv);
// jpeg.savetofile(dlgSelDir.Directory+'\'+inttostr(i)+'.bmp');
// lblRouteInfo.Caption:='Сохранено ' + inttostr(i+1)+' из ' + inttostr(length(g.TsRoute));
// except
// end
// else
// break;
// canv.Free;
// jpeg.Free
// end;
// btnsaveallimgroute.Caption:='Сохранить все изображения';
// G_SaveAllimgRoute:=false;
// end
// else begin
// btnsaveallimgroute.Caption:='Сохранить все изображения';
// G_SaveAllimgRoute:=false;
// end;
//
end;
procedure TForm1.btnSaveallostovClick(Sender: TObject);
{var gt: tgraph;
j: integer;
}begin
// if (not G_SaveAllOstov) and (length(g.TsOstov) >0) then begin
// G_SaveAllOstov:=true;
// btnsaveallOstov.Caption:='Остановить сохранение';
// lblOstovinfo.Caption:='Сохранение ' + inttostr(length(g.TsOstov)) + ' графов';
// if dlgSelDir.Execute then begin
// for j := 0 to length(g.TsOstov)-1 do begin
// ProcessMessages;
// if G_SaveAllOstov then begin
// gt:=tgraph(g.TsOstov[j]^);
// gt.SaveTofile(dlgSelDir.Directory+'\'+inttostr(j+1)+'.bin');
// lblOstovinfo.Caption:='Сохранено ' + inttostr(j+1 ) + ' из '+inttostr(length(g.TsOstov));
// end else
// break;
// end;
// end;
// btnsaveallOstov.Caption:='Сохранить все остовы ';
// G_SaveAllOstov:=false;
// end;
end;
procedure TForm1.btnSaveallrouteClick(Sender: TObject);
{var gt: tgraph;
j: integer;
}begin
// if (not G_SaveAllRoute) and (length(g.TsRoute) >0) then begin
// lblRouteInfo.Caption:='Сохранение ' + inttostr(length(g.TsRoute)) + ' графов';
// G_SaveAllRoute:=true;
// btnsaveallroute.Caption:='Остановить сохранение';
// if dlgSelDir.Execute then begin
// for j := 0 to length(g.TsRoute)-1 do begin
// ProcessMessages;
// if G_SaveAllRoute then begin
// try
// gt:=tgraph(g.TsRoute[j]^);
// gt.SaveTofile(dlgSelDir.Directory+'\'+inttostr(j+1)+'.bin');
// lblRouteInfo.Caption:='Сохранено '+ inttostr(j+1) + ' маршрутов';
// except
// end
// end else
// break;
// end;
// end;
// btnsaveallroute.Caption:='Сохранить все маршруты';
// G_SaveAllRoute:=false;
// end else begin
// btnsaveallroute.Caption:='Сохранить все маршруты';
// G_SaveAllRoute:=false;
// end;
end;
procedure TForm1.btnSaveGraphClick(Sender: TObject);
begin
dlgFilesave.Filter:='Graph File|*.bin';
if dlgFilesave.Execute then begin
g.SaveTofile(dlgFilesave.FileName);
if (lbtmpOpenGraph.Items.IndexOf(dlgFilesave.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFilesave.FileName);
end;
end;
end;
procedure TForm1.btnSaveIMGMinOstovClick(Sender: TObject);
var canv:TBitmap;
jpeg: TJPEGImage;
begin
jpeg:=nil;
canv:=nil;
try
if LbMINOstov.ItemIndex <> -1 then
if dlgSavePicture.Execute then begin
jpeg:=TJPEGImage.Create;
jpeg:=nil;
canv:=TBitmap.Create;
canv.Width := 300;
canv.Height :=300;
g.draw(canv.Canvas);
tgraph(LbMINOstov.Items.Objects[LbMINOstov.ItemIndex]).draw(canv.Canvas,true);
jpeg.Assign(canv);
jpeg.savetofile(dlgSavePicture.FileName);
end;
finally
canv.Free;
jpeg.Free;
end;
end;
procedure TForm1.btnSaveimgOstovClick(Sender: TObject);
var canv:TBitmap;
jpeg: TJPEGImage;
begin
jpeg:=nil;
canv:=nil;
try
if LbOstov.ItemIndex <> -1 then
if dlgSavePicture.Execute then begin
jpeg:=TJPEGImage.Create;
jpeg:=nil;
canv:=TBitmap.Create;
canv.Width := 300;
canv.Height :=300;
g.draw(canv.Canvas);
tgraph(LbOstov.Items.Objects[LbOstov.ItemIndex]).draw(canv.Canvas,true);
jpeg.Assign(canv);
jpeg.savetofile(dlgSavePicture.FileName);
end;
finally
canv.Free;
jpeg.Free;
end;
end;
procedure TForm1.btnsaveimgrouteClick(Sender: TObject);
begin
if lbroute.ItemIndex <> -1 then
if dlgSavePicture.Execute then
g.saveimage(dlgSavePicture.FileName,tgraph(lbroute.Items.Objects[lbroute.ItemIndex]));
end;
procedure TForm1.btnSaveMinOstovClick(Sender: TObject);
begin
if LBMinOstov.ItemIndex <> -1 then begin
try
g:=tgraph(LBMinOstov.Items.Objects[LBMinOstov.ItemIndex]);
dlgFilesave.Filter:='Graph File|*.bin';
if dlgFilesave.Execute then begin
g.SaveTofile(dlgFilesave.FileName);
if (lbtmpOpenGraph.Items.IndexOf(dlgFilesave.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFilesave.FileName);
end;
end;
except
end;
end;
end;
procedure TForm1.btnSaveOptionsClick(Sender: TObject);
var fileOpt: tinifile;
begin
dlgFilesave.Filter:='INI File|*.ini';
if dlgFilesave.Execute then begin
g.col^.filesave:=dlgFilesave.FileName;
edtFileOpt.Text:=g.col^.filesave;
fileopt:=TIniFile.Create(g.col^.filesave);
fileOpt.WriteBool('chk', 'chkNov', chkNov.Checked);
fileOpt.WriteBool('chk', 'chkNamee', chkNameE.Checked);
fileOpt.WriteBool('chk', 'chkOptVes',chkOptVes.Checked);
fileOpt.writeInteger('color', 'ColorV', btnColorV.ColorValue);
fileOpt.writeInteger('color', 'MoveV', btnMoveV.ColorValue);
fileOpt.writeInteger('color', 'DragV', btnDragV.ColorValue);
fileOpt.writeInteger('color', 'DelV', btncolorDelv.ColorValue);
fileOpt.writeInteger('color', 'colorE', btncolorE.ColorValue);
fileOpt.writeInteger('color', 'movee', btnmoveE.ColorValue);
fileOpt.writeInteger('color', 'delE', btncolordelE.ColorValue);
fileOpt.writeInteger('color', 'rect', btncolorRect.ColorValue);
fileOpt.writeInteger('num', 'delta', round(EdtDelta.Value));
fileOpt.writeInteger('num', 'rad', round(EdtRad.Value));
fileOpt.writeInteger('num', 'sizefont', round(spnSizeFont.Value));
fileOpt.writeInteger('color', 'selv', btncolorselV.ColorValue);
fileOpt.writeInteger('color', 'sele', btncolorselE.ColorValue);
//if spCompressedStoredSkin1.FileName <> '' then
fileOpt.WriteString('skin', 'file', spCompressedStoredSkin1.FileName);
//else if spCompressedStoredSkin1.CompressedFileName <>'' then
// fileOpt.WriteString('skin', 'file', spCompressedStoredSkin1.CompressedFileName);
fileOpt.free;
end;
end;
procedure TForm1.btnSaveOstovClick(Sender: TObject);
var g: tgraph;
begin
if LbOstov.ItemIndex <> -1 then begin
try
g:=tgraph(LbOstov.Items.Objects[LbOstov.ItemIndex]);
dlgFilesave.Filter:='Graph File|*.bin';
if dlgFilesave.Execute then begin
g.SaveTofile(dlgFilesave.FileName);
if (lbtmpOpenGraph.Items.IndexOf(dlgFilesave.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFilesave.FileName);
end;
end;
except
end;
end;
end;
procedure TForm1.btnsaverouteClick(Sender: TObject);
var g: tgraph;
begin
if lbroute.ItemIndex <> -1 then begin
try
g:=tgraph(lbroute.Items.Objects[lbroute.ItemIndex]);
dlgFilesave.Filter:='Graph File|*.bin';
if dlgFilesave.Execute then begin
g.SaveTofile(dlgFilesave.FileName);
if (lbtmpOpenGraph.Items.IndexOf(dlgFilesave.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFilesave.FileName);
end;
end;
except
end;
end;
end;
procedure TForm1.BtnStartSearchRouteClick(Sender: TObject);
var arr:tarrg;
i: integer;
begin
if G_searchRoute then
G_searchRoute:=false
else
if g_drawRoute then
G_DrawRoute:=false
else begin
BtnStartSearchRoute.Caption:='Остановить';
G_searchRoute:=true;
lblRoutecount.Caption:='Поиск маршрутов';
arr:=SearchRoute(g, round(EdtKolMar.Value));
lblRoutecount.Caption:='Найдено '+inttostr(high(arr)) + ' маршрутов';
G_searchRoute:=false;
lblRouteInfo.Caption:='Отрисовка...';
g_drawRoute:=true;
LBRoute.Clear;
for i := 1 to high(arr) do begin
if G_drawroute then
lbroute.items.AddObject(arr[i].comment,arr[i]^)
else
break;
end;
G_drawRoute:=false;
lblRouteInfo.Caption:='Выведено '+ inttostr(LBRoute.Items.Count);
BtnStartSearchRoute.Caption:='Найти маршруты';
end
end;
procedure TForm1.BtnWebClick(Sender: TObject);
var gt:tgraph;
maxstream:integer;
ist,st:tv;
begin
if (cmbIst.ItemIndex<>-1) and (cmbstok.ItemIndex<>-1) then
begin
ist:=TV(cmbIst.Items.Objects[cmbIst.ItemIndex]);
st:=TV(cmbStok.Items.Objects[cmbStok.ItemIndex]);
case g.SearchMaxStreamAndRazrez(gt,ist,st,maxstream) of
1:begin
spskinlabel34.Caption:='Макс поток: '+inttostr(maxstream);
LBMinRazrez.Items.Clear;
LBMinRazrez.Items.AddObject('Мин разрез с пропускной способностью'+inttostr(maxstream),gt);
end;
-1:LBMinRazrez.Items.AddObject('Граф не является сетью',nil);
-2:LBMinRazrez.Items.AddObject('Отсутствует маршрут из источника в сток',nil);
end;
end;
end;
procedure TForm1.btpPetersenClick(Sender: TObject);
var i: integer;
begin
g:=Tgraph.Create;
g.Orgraph:=ChkOrgraph.Checked;
g.vzves:=ChkVzves.Checked;
g.comment:='Граф Петерсена';
try
for i := 1 to 5 do
g.Create(round(cos(2*PI*i/5)*100+g.col.he/2), round(sin(2*PI*i/5)*100+g.col.wi/2));
for i := 1 to 5 do
g.Create(round(cos(2*PI*i/5)*50+g.col.he/2), round(sin(2*PI*i/5)*50+g.col.wi/2));
for i := 1 to 5 do
g.Create(g.V[((i-1) mod 5)+1], g.V[(i) mod 5 + 1]);
for i := 1 to 5 do
g.Create(g.V[((i-1) mod 5)+1], g.V[(i-1) mod 5 + 6]);
for i := 1 to 5 do
g.Create(g.V[((i-1) mod 5)+6], g.V[(i+1) mod 5 + 6]);
except
end;
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.btpPetersenMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var gt: Tgraph;
i: integer;
begin
gt:=Tgraph.Create;
gt.Orgraph:=ChkOrgraph.Checked;
gt.vzves:=ChkVzves.Checked;
gt.comment:='Граф Петерсена';
try
for i := 1 to 5 do
gt.Create(round(cos(2*PI*i/5)*100+gt.col.he/2), round(sin(2*PI*i/5)*100+gt.col.wi/2));
for i := 1 to 5 do
gt.Create(round(cos(2*PI*i/5)*50+gt.col.he/2), round(sin(2*PI*i/5)*50+gt.col.wi/2));
for i := 1 to 5 do
gt.Create(gt.V[((i-1) mod 5)+1], gt.V[(i) mod 5 + 1]);
for i := 1 to 5 do
gt.Create(gt.V[((i-1) mod 5)+1], gt.V[(i-1) mod 5 + 6]);
for i := 1 to 5 do
gt.Create(gt.V[((i-1) mod 5)+6], gt.V[(i+1) mod 5 + 6]);
except
end;
gt.draw(imgGraph.Canvas);
gt.delete;
gt.free;
end;
procedure TForm1.chkNameEClick(Sender: TObject);
begin
g.col.ShownameE := chkNameE.Checked;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.chkNovClick(Sender: TObject);
begin
g.col.ShowNameV := chkNov.Checked;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.chkOptVesClick(Sender: TObject);
begin
g.col.ShowVes := chkOptVes.Checked;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.ChkOrgraphClick(Sender: TObject);
var i: integer;
begin
lbostov.Clear;
LBMinOstov.Clear;
lbroute.Clear;
if g.Orgraph then
for i := 1 to high(g.V) do
g.V[i].color:=clwhite;
g.Orgraph := ChkOrgraph.Checked;
btnCreatereb.Enabled:=g.Orgraph;
g.CheckGraph;
action(sender);
g.draw(imgGraph.Canvas);
end;
procedure TForm1.chkSetClick(Sender: TObject);
var i: integer;
noty, noty1: TNotifyEvent;
begin
g.Web := chkSet.Checked;
MnuVesE.Enabled := g.Vzves or g.web;
mnuPotok.enabled:=g.web;
noty:=ChkVzves.OnClick;
ChkVzves.OnClick:=nil;
ChkVzves.Enabled:=not g.Web;
// ChkVzves.OnClick:=noty;
noty1:=ChkOrgraph.OnClick;
ChkOrgraph.OnClick:=nil;
ChkOrgraph.Enabled:=not g.Web;
// ChkOrgraph.OnClick:=noty;
if g.web then begin
ChkVzves.Checked:=true;
ChkOrgraph.Checked:=true;
MnuVesE.Caption:='Пропускная способность';
for i := 1 to high(g.V) do
g.V[i].color:=clwhite;
end else begin
ChkVzves.Checked:=g.Vzves;
ChkOrgraph.Checked:=g.Orgraph;
MnuVesE.Caption:='Вес';
end;
btnColoring.Enabled:=not g.Orgraph;
action(sender);
g.draw(imgGraph.Canvas);
ChkVzves.OnClick:=noty;
ChkOrgraph.OnClick:=noty1;
end;
procedure TForm1.ChkVzvesClick(Sender: TObject);
begin
LbOstov.Clear;
g.Vzves := ChkVzves.Checked;
action(sender);
g.draw(imgGraph.Canvas);
end;
procedure TForm1.edtFileOptKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then begin
if FileExists(edtFileOpt.Text) then begin
g.col.filesave:=edtFileOpt.Text;
arrcolset;
end else
edtFileOpt.Text:= g.col.filesave
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var fileopt: TIniFile;
i: integer;
begin
fileopt:=TIniFile.Create(ExtractFileDir(Application.ExeName)+ '\Default.ini');
fileopt.writeString('options', 'fileopt', g.col.filesave);
fileopt.writeinteger('options', 'openfilecount', lbtmpOpenGraph.Items.Count-1);
for i := 0 to lbtmpOpenGraph.Items.Count-1 do
fileopt.writeString('OpenFiles', 'file'+inttostr(i), lbtmpOpenGraph.Items.Strings[i]);
fileopt.free;
halt;
end;
procedure TForm1.FormCreate(Sender: TObject);
var fileopt: tinifile;
i, j: integer;
str:string;
begin
new(G_Arrcol);
G:=Tgraph.Create;
if FileExists(ExtractFileDir(Application.ExeName)+ '\Default.ini') then begin
fileopt:=TIniFile.Create(ExtractFileDir(Application.ExeName)+ '\Default.ini');
G_Arrcol.filesave:=fileopt.ReadString('options', 'fileopt', '');
j:= fileopt.readinteger('options', 'openfilecount', -1);
for i := 0 to j do begin
str:=fileopt.readString('OpenFiles', 'file'+inttostr(i), 'error');
if str<> 'error' then
lbtmpOpenGraph.Items.Add(str);
end;
btnReloadoptionsClick(nil);
fileopt.free;
end else
btnDefaultOptionsClick(nil);
//Установка цветов
G_arrcol.he:=imgGraph.Height;
G_arrcol.wi:=imgGraph.width;
imgGraph.Repaint;
imgGraph.Canvas.Rectangle(0, 0, imgGraph.Width, imgGraph.Height);
G_arrcol.scale := 100;
G_arrcol.dx := 0;
G_arrcol.dy := 0;
G_arrcol.x0 := 0;
G_arrcol.y0 := 0;
G_DrawRoute:=false;
G_SaveAllRoute:=false;
{ noty:=ChkOrgraph.OnClick;
ChkOrgraph.OnClick:=nil;
ChkOrgraph.Enabled:=g.Orgraph;
chkorgraph.OnClick:=noty;
noty:=ChkVzves.OnClick;
ChkVzves.OnClick:=nil;
ChkVzves.Enabled:=g.Orgraph;
ChkVzves.OnClick:=noty;
noty:=Chkset.OnClick;
chkSet.OnClick:=nil;
chkSet.Enabled:=g.Orgraph;
chkSet.OnClick:=noty;
}
btnColoring.Enabled:=not g.Orgraph;
btncreatereb.Enabled:=g.Orgraph;
action;
end;
procedure TForm1.imgGraphMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p: TV;
q: TR;
begin
if Button = mbleft then begin
p:=g.GetVChoord(x, y);
q:=g.GetEChoord(x, y);
if p<> nil then begin
tv(p).status := G.col.dragv;
tv(p).move := true;
end else if q = nil then begin
g.col.dx := X;
g.col.dy := Y;
end;
end else if Button = mbRight then begin
p:=g.GetVChoord(x, y);
if p<> nil then begin
g.e[0].p1 := p;
end;
end;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.imgGraphMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
p: TV;
q: TR;
i: integer;
flag: boolean;
begin
flag:=true;
for i := 1 to high(g.v) do
if g.V[i].move then begin
if (X > g.col.wi - g.col.rad) then
X := g.col.wi - g.col.rad;
if (X < g.col.rad) then
X := g.col.rad;
if (Y < g.col.rad) then
Y := g.col.rad;
if (Y > g.col.he - g.col.rad) then
Y := g.col.he - g.col.rad;
g.V[i].X := X;
g.V[i].Y := Y;
flag:=false;
g.draw(imgGraph.Canvas);
break;
end;
if flag then begin
p:=g.GetVChoord(x, y);
q:=g.GetEChoord(x, y);
if p<> nil then begin
if not P.move then
P.status := g.col.movev
end else if q<> nil then
q.status := g.col.mevee
{else
if g.col.move then begin
g.col.dx := round((X - g.col.dx));
g.col.dy := round((Y - g.col.dy));
g.col.x0 := g.col.x0 - g.col.dx;
g.col.y0 := g.col.y0 - g.col.dy;
end};
g.draw(imgGraph.Canvas);
if g.e[0].p1 <> nil then begin
imgGraph.Canvas.Pen.Color:=g.col.colore;
drawstr(imgGraph.CanvaS, g.e[0].p1.X,g.e[0].p1.Y, X, Y, g.Orgraph, round
(g.col.rad * g.col.scale / 100));
end;
end;
//g.Draw(imgGraph.Canvas);
end;
procedure TForm1.imgGraphMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
p: TV;
q:TR;
begin
g.col.dx := 0;
g.col.dy := 0;
g.col.move := false;
g.V[0].X := X;
g.V[0].Y := Y;
for i := 1 to high(g.V) do
if g.V[i].move then begin
g.V[i].move := false;
g.V[i].status := g.col.colorV;
end;
if Button = mbRight then begin
p:=g.GetVChoord(x, y);
if p <> nil then
if (g.e[0].p1 = nil) or (g.e[0].p1 = P) then
MnuV.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y)
else begin
g.Create( g.e[0].p1, TV(P));
g.draw(imgGraph.Canvas);
action;
end
else begin
q:=g.GetEChoord(x, y);
if q <> nil then
MnuE.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y)
else
if g.e[0].p1 = nil then
mnuRec.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y)
end;
g.e[0].p1 := nil
end;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.LbOstovListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var pos: tpoint;
begin
if button=mbright then begin
pos.X:=x;
pos.Y:=y;
try
(sender as TspSkinListBox).ItemIndex:=(sender as TspSkinListBox).ItemAtPos(pos, true);
except
end;
if (sender as TspSkinListBox).ItemAtPos(pos, true) <> -1 then begin
popupOstov.Popup(Mouse.CursorPos.x,mouse.cursorpos.y);
end;
end;
end;
procedure TForm1.LbOstovMouseLeave(Sender: TObject);
begin
g.draw(imgGraph.Canvas);
end;
procedure TForm1.LBRouteListBoxKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
tmp: tgraph;
begin
try
tmp := tgraph((Sender as TSPSKINLISTBOX).Items.Objects[(Sender as TSPSKINLISTBOX).ItemIndex]);
g.draw(imgGraph.Canvas);
tmp.draw(imgGraph.Canvas, true);
except
g.draw(imgGraph.Canvas);
end;
// tgraph(LBRoute.Items.Objects[LBRoute.ItemAtPos(pos, true)]);
end;
procedure TForm1.LBRouteListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var pos: tpoint;
begin
if button=mbright then begin
pos.X:=x;
pos.Y:=y;
try
LBRoute.ItemIndex:=LBRoute.ItemAtPos(pos, true);
except
end;
if LBRoute.ItemAtPos(pos, true) <> -1 then begin
popupRoute.Popup(Mouse.CursorPos.x,mouse.cursorpos.y);
end;
end;
end;
procedure TForm1.LBRouteMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
pos: tpoint;
tmp: tgraph;
begin
pos.X := X;
pos.Y := Y;
try
tmp:=tgraph((sender as TspSkinListBox).Items.Objects[(sender as TspSkinListBox).ItemAtPos(pos, false)]);
g.draw(imgGraph.Canvas);
tmp.Orgraph:=g.Orgraph;
tmp.draw(imgGraph.Canvas, true);
except
g.draw(imgGraph.Canvas);
end;
end;
procedure TForm1.lbtmpOpenGraphDrawItem(Cnvs: TCanvas; Index, ItemWidth,
ItemHeight: Integer; TxtRect: TRect; State: TOwnerDrawState);
begin
if not FileExists(lbtmpOpenGraph.Items.Strings[index]) then
cnvs.font.Color:=clHighlight
else
cnvs.font.Color:=clblack;
Cnvs.TextOut(txtRect.Left, txtRect.Top, lbtmpOpenGraph.Items.Strings[Index]);
end;
procedure TForm1.lbtmpOpenGraphListBoxDblClick(Sender: TObject);
var tne: TNotifyEvent;
begin
try
g.Create(lbtmpOpenGraph.Items.Strings[lbtmpOpenGraph.ItemIndex]);
Tne:=ChkVzves.OnClick;
ChkVzves.OnClick:=nil;
ChkVzves.Checked:=g.Vzves;
ChkVzves.OnClick:=tne;
Tne:=ChkOrgraph.OnClick;
ChkOrgraph.OnClick:=nil;
ChkOrgraph.Checked:=g.orgraph;
ChkOrgraph.OnClick:=tne;
btnColoring.Enabled:=not g.Orgraph;
btncreatereb.Enabled:=g.Orgraph;
Tne:=chkSet.OnClick;
chkSet.OnClick:=nil;
chkSet.Checked:=g.web;
chkSet.OnClick:=tne;
action;
g.Draw(imgGraph.Canvas);
except
end;
end;
procedure TForm1.lbtmpOpenGraphListBoxMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var pos:Tpoint;
gt: tgraph;
begin
try
pos.X:=x;
pos.Y:=y;
lbtmpOpenGraph.Hint:=lbtmpOpenGraph.Items.Strings[lbtmpOpenGraph.ItemAtPos(pos, false)];
gt:=tgraph.Create(lbtmpOpenGraph.Hint);
gt.Draw(imggraph.canvas);
gt.delete;
gt.Free;
except
lbtmpOpenGraph.Hint:='';
g.Draw(imggraph.Canvas);
end;
end;
procedure TForm1.lbtmpOpenGraphMouseLeave(Sender: TObject);
begin
//
g.Draw(imggraph.Canvas);
end;
procedure TForm1.MnuClearClick(Sender: TObject);
begin
g.Create;
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.mnuCommentVClick(Sender: TObject);
//var
// a: Integer;
begin
// a := Mouseres(g, unscale(g.V[0]^.X, 0, arrcol)[1], unscale
// (0, g.V[0]^.Y, arrcol)[2], arrcol)[2];
// g.V[a]^.comment := NptVes.InputBox('Введите комментарий', 'Комментарий для вершины v' + inttostr(a), inttostr(g.V[a]^.comment));
end;
procedure TForm1.mnuCreateVClick(Sender: TObject);
begin
g.Create(g.V[0].X, g.V[0].Y);
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.mnuDelEClick(Sender: TObject);
var p: tr;
begin
p:=g.GetEChoord(g.V[0].x, g.V[0].y);
g.delete(p);
p.Free;
action;
g.Draw(imgGraph.Canvas);
end;
procedure TForm1.mnuDeVClick(Sender: TObject);
var p: tv;
begin
p:=g.GetVChoord(g.V[0].x,g.V[0].Y);
g.delete(P);
p.Free;
action;
g.draw(imgGraph.Canvas);
end;
procedure TForm1.mnuGetOstovClick(Sender: TObject);
var gt: tgraph;
begin
try
gt:= tgraph(lbostov.Items.Objects[lbostov.ItemIndex]);
//addcloseG;
g:=tgraph.assign(gt);
g.Draw(imgGraph.Canvas);
except
end;
end;
procedure TForm1.mnuGetRouteClick(Sender: TObject);
var gt: tgraph;
begin
try
gt:= tgraph(lbroute.Items.Objects[lbroute.ItemIndex]);
g.Free;
g:=gt;
g.Draw(imgGraph.Canvas);
action;
except
end;
end;
procedure TForm1.mnuOpenGraphClick(Sender: TObject);
begin
trY
dlgFileOpen.Filter:='Graph File|*.bin';
if dlgFileopen.Execute then begin
G.CREATE(dlgFileopen.FileName);
Action;
g.Draw(imgGraph.Canvas);
if (lbtmpOpenGraph.Items.IndexOf(dlgFileopen.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFileopen.FileName);
end;
end;
except
ShowMessage('Ошибка');
end;
end;
procedure TForm1.mnuOpenSmClick(Sender: TObject);
begin
try
dlgFileOpen.Filter:='Текстовый файл|*.txt';
if dlgFileopen.Execute then begin
G.CreatewithSm(dlgFileopen.FileName);
Action;
g.Draw(imgGraph.Canvas);
{ if (lbtmpOpenGraph.Items.IndexOf(dlgFileopen.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFileopen.FileName);
end;
} end;
except
ShowMessage('Ошибка');
end;
end;
procedure TForm1.mnuPotokClick(Sender: TObject);
var p: TR;
begin
p:= g.GetEChoord(g.V[0].X,g.V[0].Y);
repeat
p.potok := strtoint(NptVes.InputBox('Введите поток',
'Поток через ребро e' + inttostr(g.Num(p)) + ':', inttostr(p.potok))
)
until p.ves >= p.potok;
end;
procedure TForm1.mnuSaveImgOstovClick(Sender: TObject);
begin
if lbostov.ItemIndex <> -1 then
if dlgSavePicture.Execute then
g.saveimage(dlgSavePicture.FileName,tgraph(lbostov.Items.Objects[lbostov.ItemIndex]));
end;
procedure TForm1.MnuVesEClick(Sender: TObject);
var p: TR;
begin
p:= g.GetEChoord(g.V[0].X,g.V[0].Y);
if p<> nil then
try
if g.Web then
repeat
p.ves := strtoint(NptVes.InputBox('Введите пропускную способность',
'Пропускная способность для ребра e' + inttostr(g.Num(p)) + ':', inttostr(p.ves))
)
until p.ves >= p.potok
else
p.ves := strtoint(NptVes.InputBox('Введите вес',
'Вес для ребра e' + inttostr(g.Num(p)) + ':', inttostr(p.ves))
);
except
p.ves := 0;
end;
end;
procedure TForm1.mnuOpenincClick(Sender: TObject);
begin
trY
dlgFileOpen.Filter:='Текстовый файл|*.txt';
if dlgFileopen.Execute then begin
G.CreatewithInc(dlgFileopen.FileName);
Action;
g.Draw(imgGraph.Canvas);
{ if (lbtmpOpenGraph.Items.IndexOf(dlgFileopen.FileName) =-1) THEN begin
if (lbtmpOpenGraph.Items.count >= 10) then
lbtmpOpenGraph.Items.Delete(0);
lbtmpOpenGraph.Items.Add(dlgFileopen.FileName);
end;
} end;
except
ShowMessage('Ошибка');
end;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
if dlgSavePicture.Execute then begin
g.SaveImage(dlgSavePicture.FileName);
end;
end;
procedure TForm1.btnSearchOstovClick(Sender: TObject);
var arr:tarrg;
i: integer;
begin
if G_SearchOSTOV then begin
G_SearchOSTOV:=false;
end else
if G_Drawostov then
G_DrawOSTOV:=false
else begin
btnSearchOstov.Caption:='Остановить';
lblOstovinfo.Caption:='Поиск остовов';
G_SearchOSTOV:=true;
arr:=Searchostov(g);
G_SearchOstov:=false;
lblOStovInfo.Caption:='Отрисовка...';
G_DrawOSTOV:=true;
LbOstov.clear;
for i := 1 to high(arr) do begin
ProcessMessages;
if G_drawOstov then
if g.Vzves then
lbostov.Items.AddObject(arr[i].comment+ ' Вес '+ inttostr(arr[i].service),arr[i]^)
else
lbostov.Items.AddObject(arr[i].comment,arr[i]^)
else
break;
end;
G_DrawOSTOV:=false;
lblOStovInfo.Caption:='';
btnSearchOstov.enabled:=true;
btnSearchOstov.Caption:='Найти остовы';
LblOstovCount.Caption:='Количество остовов '+inttostr(high(arr));
end;
end;
procedure TForm1.spDynamicSkinForm1ChangeSkinData(Sender: TObject);
begin
// spSkinData1.CompressedStoredSkin := spCompressedStoredSkin1;
end;
procedure TForm1.sprebMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
//spSkinScrollBar1.Position:= spSkinScrollBar1.Position+ wheeldelta;
end;
procedure TForm1.spSkinButton1Click(Sender: TObject);
begin
ChDir(ExtractFilePath(Application.EXEName));
if ShellExecute(Handle, nil, 'Help.chm', nil, nil, SW_SHOW)<=32 then
MessageDlg('ОШИБКА: файл помощи не найден!',mtError,[mbok],0);
end;
procedure TForm1.spSkinLabel1Click(Sender: TObject);
begin
//ShowMessage(booltostr( DvuSvyaz(G)));
//true = -1;
end;
procedure TForm1.spSkinPageControl1Change(Sender: TObject);
var i,j, k:integer;
MatrixSm,MatrixInc:tmatrix;
arr:TArrG;
tmpg, gt: tgraph;
//ver: tv;
begin
if (spSkinPageControl1.ActivePage = spSkinTabSheet10) then begin
btnColoring.Enabled:=not g.Orgraph;
btncreatereb.Enabled:=g.Orgraph;
{ spReb.Visible:=false;
prsOpenReb.Visible:=true;
prsOpenReb.MaxValue:=high(g.e);
try
{ for i := 1 to high(ctrlreb) do begin
// ctrlreb[i][1].Free;
ctrlreb[i][2].Free;
ctrlreb[i][3].Free;
ctrlreb[i][4].Free;
end;
except
end;
setlength(CtrlReb, length(g.E));
for i := 1 to high(g.E) do begin
prsOpenReb.Value:=i;
processMessages;
ctrlreb[i][1]:=TspSkinLabel.create(nil);
(ctrlreb[i][1] as TspSkinLabel).Left:=3;
(ctrlreb[i][1] as TspSkinLabel).top:=10+(i-1)*25;
(ctrlreb[i][1] as TspSkinLabel).Height:=20;
(ctrlreb[i][1] as TspSkinLabel).Width:=70;
(ctrlreb[i][1] as TspSkinLabel).Caption:='Ребро e'+inttostr(i);
(ctrlreb[i][1] as TspSkinLabel).Parent:=SPReb;
(ctrlreb[i][1] as TspSkinLabel).SkinData:=spskindata1;
ctrlreb[i][2]:=TspSkinNumericEdit.create(nil);
(ctrlreb[i][2] as TspSkinNumericEdit).Left:=75;
(ctrlreb[i][2] as TspSkinNumericEdit).top:=10+(i-1)*25;
(ctrlreb[i][2] as TspSkinNumericEdit).Height:=20;
(ctrlreb[i][2] as TspSkinNumericEdit).Width:=30;
(ctrlreb[i][2] as TspSkinNumericEdit).text:=inttostr(g.E[i].ves);
(ctrlreb[i][2] as TspSkinNumericEdit).Parent:=SPReb;
(ctrlreb[i][2] as TspSkinNumericEdit).SkinData:=spskindata1;
(ctrlreb[i][2] as TspSkinNumericEdit).OnChange:=edtves;
(ctrlreb[i][2] as TspSkinNumericEdit).Enabled:= g.Vzves or g.web;
ctrlreb[i][3]:=TspSkinNumericEdit.create(nil);
(ctrlreb[i][3] as TspSkinNumericEdit).Left:=110;
(ctrlreb[i][3] as TspSkinNumericEdit).top:=10+(i-1)*25;
(ctrlreb[i][3] as TspSkinNumericEdit).Height:=20;
(ctrlreb[i][3] as TspSkinNumericEdit).Width:=30;
(ctrlreb[i][3] as TspSkinNumericEdit).text:=inttostr(g.E[i].potok);
(ctrlreb[i][3] as TspSkinNumericEdit).Parent:=SPReb;
(ctrlreb[i][3] as TspSkinNumericEdit).SkinData:=spskindata1;
(ctrlreb[i][3] as TspSkinNumericEdit).OnChange:=edtves;
(ctrlreb[i][3] as TspSkinNumericEdit).Enabled:= g.web;
ctrlreb[i][4]:=TspSkinButton.create(nil);
(ctrlreb[i][4] as TspSkinButton).Left:=150;
(ctrlreb[i][4] as TspSkinButton).top:=10+(i-1)*25;
(ctrlreb[i][4] as TspSkinButton).Height:=20;
(ctrlreb[i][4] as TspSkinButton).Width:=70;
(ctrlreb[i][4] as TspSkinButton).Parent:=SPReb;
(ctrlreb[i][4] as TspSkinButton).SkinData:=spskindata1;
(ctrlreb[i][4] as TspSkinButton).OnClick:=edtves;
(ctrlreb[i][4] as TspSkinButton).Caption:= 'Удалить';
end;
spReb.Visible:=true;
prsOpenReb.Visible:=false}
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet5) then BEGIN
LBMinOstov.Clear;
for i := 0 to lbSvaznost.Items.Count-1 do begin
gt:=tgraph(lbSvaznost.Items.Objects[i]);
SearchMinOstov(gt);
if g.Vzves then
LBMinOstov.Items.AddObject(gt.minOstov.comment+' Вес '+ inttostr(gt.minOstov.service), tobject(gt.minOstov))
else
LBMinOstov.Items.AddObject(gt.minOstov.comment, tobject(gt.minOstov))
end;
END else if (spSkinPageControl1.ActivePage = Tab1) then begin
//try
for i := 0 to LbMinPath.Items.Count-1 do
LbMinPath.Items.Objects[i].Free;
LbMinPath.Clear;
for i := 0 to lbroute.Items.Count-1 do
lbroute.Items.Objects[i].Free;
LBRoute.Clear;
// ver:=tv(cmbstartv.Items.Objects[cmbstartv.ItemIndex]);
cmbstartv.Items.Clear;
for i := 1 to high(g.v) do
cmbstartv.Items.AddObject('v'+ inttostr(i), tobject(g.V[i]));
// cmbstartv.ItemIndex:=cmbstartv.Items.IndexOfObject(tobject(ver));
// except
// cmbstartv.Items.Clear;
// for i := 1 to high(g.v) do
// cmbstartv.Items.AddObject('v'+ inttostr(i), tobject(g.V[i]));
//end;
// try
// ver:=tv(cmbendv.Items.Objects[cmbendv.ItemIndex]);
cmbendv.Items.Clear;
for i := 1 to high(g.v) do
cmbendv.Items.AddObject('v'+ inttostr(i), tobject(g.V[i]));
//cmbendv.ItemIndex:=cmbendv.Items.IndexOfObject(tobject(ver));
//except
//cmbendv.Items.Clear;
//for i := 1 to high(g.v) do
//cmbendv.Items.AddObject('v'+ inttostr(i), tobject(g.V[i]));
//end;}
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet9) then begin
cmbIst.Items.Clear;
cmbStok.Items.Clear;
for i := 1 to high(g.V) do begin
cmbIst.Items.AddObject('v'+inttostr(i), tobject(g.V[i]));
cmbstok.Items.AddObject('v'+inttostr(i), tobject(g.V[i]));
end;
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet7) then begin
lbfundcycle.Items.Clear;
lbfundKocycle.Items.Clear;
lblCikl.Caption:='Цикломатическое число ' + inttostr( FundCycle(g, lbfundcycle.Items));
lblKoCikl.Caption:='Коцикломатическое число ' + inttostr(FundRaz(g, lbfundKocycle.Items) );
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet2) then begin
g.GetMatrixSm(MatrixSm);
g.GetMatrixInc(MatrixInc);
try
with sgsm do
begin
RowCount:=length(g.V);
colCount:=length(g.V)+1;
Cells[colcount-1, 0]:='deg';
if RowCount>1 then begin
FixedCols:=1;
fixedrows:=1;
end;
for i := 1 to high(g.V) do begin
Cells[0, i]:='v'+inttostr(i);
Cells[i, 0]:='v'+inttostr(i);
sgin.Cells[0, i]:='v'+inttostr(i);
end;
for i := 1 to high(g.V) do
cells[ColCount-1,i]:=inttostr(g.degv(g.v[i]));
end;
sgin.RowCount:=length(g.v);
sgin.colCount:=length(g.e);
if sgin.RowCount>1 then
sgin.Fixedrows:=1;
if sgin.colCount>1 then
sgin.Fixedcols:=1;
for i := 1 to high(g.E) do
sgin.Cells[i, 0]:='e'+inttostr(i);
for i := 1 to high(g.v) do
for j := 1 to high(g.V) do
sgsm.Cells[j, i]:=inttostr(MatrixSm.Matrix[i, j]);
for i := 1 to high(g.v) do
for j := 1 to high(g.e) do
sgin.Cells[j, i]:=inttostr(Matrixinc.Matrix[i, j]);
except
end;
setlength(MatrixSm.Matrix,0,0);
matrixsm:=nil;
setlength(matrixinc.Matrix,0,0);
matrixinc:=nil;
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet11) then begin
for i := 0 to LbNazav.Items.Count-1 do
tgraph(lbnazav.Items.Objects[i]).Free;
LbNazav.Clear;
LbNezavMax.Clear;
for i := 0 to Lbdomin.Items.Count-1 do
tgraph(lbdomin.Items.Objects[i]).Free;
Lbdomin.Clear;
LBDominMin.Clear;
// LbNazav.Clear;
// LbNezavMax.Clear;
// Lbdomin.Clear;
// LBDominMin.Clear;
tmpg:=nil;
if not g.Orgraph then begin
arr:=Nezav(g);
if high(arr)>0 then tmpg:=arr[1]^;
for i := 1 to high(arr) do begin
LbNazav.Items.AddObject(arr[i].comment, tobject(arr[i]^));
if high(tmpg.V) < high(arr[i].V) then begin
LbNezavMax.Clear;
tmpg:=arr[i]^;
LbNezavMax.Items.AddObject(arr[i].comment, tobject(arr[i]^));
end else
if high(tmpg.V) = high(arr[i].V) then
LbNezavMax.Items.AddObject(arr[i].comment, tobject(arr[i]^));
end;
end;
arr:=Domin(g);
tmpg:=g;
for i := 1 to high(arr) do begin
Lbdomin.Items.AddObject(arr[i].comment, tobject(arr[i]^)) ;
if high(tmpg.V) > high(arr[i].V) then begin
lbDominMin.Clear;
tmpg:=arr[i]^;
lbDominMin.Items.AddObject(arr[i].comment, tobject(arr[i]^));
end else
if high(tmpg.V) = high(arr[i].V) then
lbDominMin.Items.AddObject(arr[i].comment, tobject(arr[i]^));
end;
end else if (spSkinPageControl1.ActivePage = spSkinTabSheet3) then begin
lblPlanar.Caption:='';
gt:=tgraph.Invert(g);
arr:=Nezav(gt);
for i := 0 to LbKliki.Items.Count-1 do
tgraph(lbKliki.Items.Objects[i]).Free;
Lbkliki.Clear;
tmpg:=nil;
if high(arr)>0 then
tmpg:=arr[1]^;
for i := 1 to high(arr) do begin
if high(tmpg.V) <= high(arr[i].V) then begin
if high(arr[i].v)>2 then begin
tmpg:=tgraph.assign(arr[i]^);
setlength(tmpg.E, 1);
for j := 1 to high(tmpg.V) do begin
for k := 1 to j-1 do
tmpg.Add(g.GetE(tmpg.V[j], tmpg.V[k]));
end;
TMPg.comment:='Клика '+ inttostr(high(tmpg.V));
if high(tmpg.V) >= 5 then
lblPlanar.Caption:='Граф не планарен';
Lbkliki.Items.AddObject(tmpg.comment, tobject(tmpg));
tmpg:=arr[i]^;
end;
end else
arr[i].Free;
end;
gt.Free;
if lblPlanar.Caption = '' then
lblPlanar.Caption:='Граф может быть планарен';
end;
end;
procedure TForm1.spSkinPageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
begin
{if g.Orgraph and ((tab = 3) or (tab =5)) then
AllowChange:=false
else
if not g.Web and (tab = 9) then
AllowChange:=false
else
AllowChange:=true;
}end;
procedure TForm1.spSkinPageControl1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
tab := spSkinPageControl1.IndexOfTabAt(x, y);
end;
procedure TForm1.spSkinUpDown1Change(Sender: TObject);
var i: integer;
begin
i:=1;
LBRoute.Selected[i]:=true;
end;
procedure TForm1.arrcolSet;
var i: integer;
begin
G_arrcol.ShowNameV := chkNov.Checked;
G_arrcol.ShownameE := chkNameE.Checked;
G_arrcol.ShowVes := chkOptVes.Checked;
G_arrcol.colorV := btnColorV.ColorValue;
G_arrcol.movev := btnMoveV.ColorValue;
G_arrcol.dragv := btnDragV.ColorValue;
G_arrcol.delv := btncolorDelv.ColorValue;
G_arrcol.colore := btncolorE.ColorValue;
G_arrcol.mevee := btnmoveE.ColorValue;
G_arrcol.dele := btncolordelE.ColorValue;
G_arrcol.Rect := btncolorRect.ColorValue;
G_arrcol.delta := round(EdtDelta.Value);
G_arrcol.rad := round(EdtRad.Value);
G_arrcol.selV := btncolorselV.ColorValue;
G_arrcol.selE := btncolorselE.ColorValue;
G_arrcol.sizefont:=round(spnSizeFont.Value);
g.col:=G_arrcol;
try
for i := 1 to high(g.V) do
g.V[i].status:=g.col.colorV;
for i := 1 to high(g.e) do
g.e[i].status:=g.col.colore;
except
end;
end;
procedure TForm1.Action(sender: tobject = nil);
var arr: tarrg;
i: integer;
begin
spSkinTabSheet3.Enabled:=not g.Orgraph;
spSkinTabSheet5.Enabled:=not g.Orgraph;
spSkinTabSheet9.Enabled:=g.Web;
spSkinLabel28.enabled:=g.Vzves and not g.Web;
LbMinPath.enabled:=g.Vzves and not g.Web;
btnminpath.enabled:=g.Vzves and not g.Web;
cmbstartv.enabled:=g.Vzves and not g.Web;
cmbendv.enabled:=g.Vzves and not g.Web;
spSkinLabel25.enabled:=g.Vzves and not g.Web;
spSkinLabel27.enabled:=g.Vzves and not g.Web;
spSkinLabel26.enabled:=not g.Orgraph;
spSkinLabel31.enabled:=not g.Orgraph;
LbNazav.enabled:=not g.Orgraph;
LbNezavMax.enabled:=not g.Orgraph;
if ( high(g.V) <> 0) and g.klika then lblClicka.Caption := 'Клика ' + inttostr( high(g.V))
else lblClicka.Caption := 'Не Клика';
if g.Orgraph then
if ( high(g.V) <> 0) and g.Odnorod then lblOdnorod.Caption := inttostr(g.DegV(g.V[1], 1)) + ' однородный'
else lblOdnorod.Caption :='Не однородный'
else
if ( high(g.V) <> 0) and g.Odnorod then lblOdnorod.Caption := inttostr(g.DegV(g.V[1])) + ' однородный'
else lblOdnorod.Caption :='Не однородный';
for i := 0 to lbSvaznost.Items.Count-1 do
lbSvaznost.Items.Objects[i].Free;
lbSvaznost.Clear;
arr:=FindConComponents(g);
for i := 1 to high(arr) do
lbSvaznost.Items.AddObject(arr[i].comment, arr[i]^);
if g.Orgraph then begin
arr:=FindStronglyConComponents(g);
for i := 1 to high(arr) do
lbSvaznost.Items.AddObject(arr[i].comment, arr[i]^);
end;
lblSvyazCount.Caption:='Количество компонент связности '+ inttostr(High(arr));
lblSvyazCount2.Caption:='Количество компонент связности '+ inttostr(High(arr));
for i := 0 to lbDvusvyaz.Items.Count-1 do
lbDvusvyaz.Items.Objects[i].Free;
lbDvusvyaz.Clear;
if High(arr) = 1 then begin
lblSvyaz1.Caption:='Граф связен';
if lbSvaznost.items.count = 1 then begin
arr:=Dvusvyaz(g);
for i := 1 to high(arr) do begin
lbDvusvyaz.Items.AddObject(arr[i].comment, arr[i]^);
end;
end;
end;
if g.Vzves then begin
lblminostov.Caption:='Минимальный Остов';
end else begin
lblminostov.Caption:='Cлучайный Остов';
end;
edtKolV.Value:=high(g.V);
edtkolE.value:=high(g.E);
spSkinPageControl1Change(nil);
// G_Process:=false;
// ProcessMessages;
// end;
// G_Process:=true;
//
// {Порядок
// 5: Компоненты связности
// 1: вычисленеи мин.остова.
// перенумерация ребер
// 2: иычисление матриц
// 3: маршруты - не факт
// 4: Остовы.
// 6: фунд. множества
// Сначала }
// {ОДНОРОДНЫЙ ЛИ ГРАФ}
// //g.creatematrix;
// if G_Process then
// if ( high(g.V) <> 0) and g.klika then lblClicka.Caption := 'Клика ' + inttostr( high(g.V))
// else lblClicka.Caption := 'Не Клика';
// if g.Orgraph then
// if ( high(g.V) <> 0) and g.Odnorod then lblOdnorod.Caption := inttostr(g.DegV(g.V[1], 1)) + ' однородный'
// else lblOdnorod.Caption :='Не однородный'
// else
// if ( high(g.V) <> 0) and g.Odnorod then lblOdnorod.Caption := inttostr(g.DegV(g.V[1])) + ' однородный'
// else lblOdnorod.Caption :='Не однородный';
// {КОМПОНЕНТЫ СВЯЗНОСТИ}
// if G_Process then begin
// FindConComponents(g,lbSvaznost.Items);
// LBsvaznost.Clear;
// lblSvyazCount.caption:=inttostr(length(g.tssvyaz))+ ' компонент связности';
// { for i := 0 to length(g.tssvyaz)-1 do
// LBsvaznost.items.addobject(g.tssvyaz[i].comment, g.tssvyaz[i]^);
// if lbSvaznost.Items.Count=1 then lblsvyaz.Caption:='Граф связан'
// else lblsvyaz.Caption:='Граф не связан';
// lblsvyaz1.Caption:=lblsvyaz.Caption;
//{ if g.Orgraph then begin
// FindStronglyConComponents(g,lbSvaznost.Items);
// lblSvyazCount.caption:=IntToStr(lbSvaznost.Items.Count-g.tssvyaz.count)+ ' компонент сильной связности';
// if lbSvaznost.Items.Count-g.tssvyaz.count = 1 then
// lblsvyaz.Caption := 'Граф сильно связан'
// else
// lblsvyaz.Caption := 'Граф не сильно связан';
// end; }
// lblSvyazCount2.caption:=lblSvyazCount.caption;
//
// end;
// {Минимальный остов}
// if G_Process then begin
// try
// g.minOstov.free;
// except
// end;
// LBMinOstov.Items.Clear;
// SearchMinOstov(g);
// if g.minOstov<> nil then
// LBMinOstov.Items.AddObject(g.minOstov.comment, g.minOstov);
// { if g.Vzves then begin
// lblminostov.Caption:='Минимальный Остов';
// for i := 0 to lbSvaznost.Items.Count-1 do begin
// gt:=tgraph(lbSvaznost.Items.Objects[i]);
// SearchMinOstov(gt);
// LBMinOstov.Items.AddObject(tgraph(lbSvaznost.Items.Objects[i]).minOstov.comment, tobject(tgraph(lbSvaznost.Items.Objects[i]).minOstov));
// end;
// end else begin
// lblminostov.Caption:='Cлучайный Остов';
// for i := 0 to lbSvaznost.Items.Count-1 do begin
// gt:=tgraph(lbSvaznost.Items.Objects[i]);
// SearchMinOstov(gt);
// LBMinOstov.Items.AddObject(gt.minOstov.comment, gt.minOstov);
// end;
// end; }
// end;
//
// //if spSkinPageControl1.ActivePageIndex=0 then
// spSkinPageControl1Change(sender);
//
//
// //----------
// lblRoutecount.Caption:='Маршруты не искались';
// lblRouteInfo.caption:='';
//
// btnSaveallostov.Enabled:=false;
// btnSaveallimgostov.Enabled:=false;
// edtKolV.Value:=high(g.V);
// edtkolE.value:=high(g.E);
//
//
// {КОЛИЧЕСТВО ОСТОВОВ }
//{ mxKir:=TMatrix.create(g.MatrixSm.col, g.MatrixSm.row);
// for i := 1 to high(g.v) do
// for j := 1 to high(g.v) do
// mxkir.Matrix[i, j]:=g.MatrixSm.Matrix[i, j];
// for i := 1 to high(g.v) do
// mxkir.Matrix[i, i]:=g.DegV(g.V[i]);
// mxkir:=mxkir.Alg(1,1);
// LblOstovCount.Caption:=inttostr(mxkir.det);
//// btnSearchOstovClick(nil);
// {Фундаментальные циклы}
// lblCikl.Caption:='Цикломатическое число ' + inttostr( high(g.E)-high(g.V)+ lbSvaznost.Items.Count);
// lblKoCikl.Caption:='Коцикломатическое число ' + inttostr( high(g.V) - 1);
// lbfundcycle.Items.Clear;
//if G_Process then begin
// FundCycle(g, lbfundcycle.Items);
// FundRaz(g, lbfundKocycle.Items);
// try
// SGCikl.ColCount:=high(g.E);
// SGCikl.RowCount:=lbfundcycle.Items.Count;
// for i := 0 to lbfundcycle.Items.Count -1 do begin
// for j := 0 to high(g.E)-1 do
// SGCikl.Cells[j, i]:='0';
// gt:=tgraph(lbfundcycle.Items.Objects[i]);
// for j := 0 to high(g.E) do
// if gt.ExistE(g.E[j]) then
// SGCikl.Cells[j-1, i]:='1';
// end;
// except
// end;
//end;
end;
procedure TForm1.Hold(flag: boolean = true);
begin
imgGraph.Enabled:=not flag;
btnclika3.Enabled:=not flag;
btnklika4.Enabled:=not flag;
btnklika5.Enabled:=not flag;
btnklika6.Enabled:=not flag;
btpPetersen.Enabled:=not flag;
BtnOpenGraph.enabled:=not flag;
btnKlika3x3.Enabled:=not flag;
mnuDeV.Enabled:=not flag;
mnuDelE.Enabled:=not flag;
MnuVesE.Enabled:=not flag;
MnuClear.Enabled:=not flag;
MnuCreateV.Enabled:=not flag;
lbtmpOpenGraph.Enabled:=not flag;
end;
procedure Tform1.edtves(sender:tobject);
var i, j: integer;
begin
for i := 1 to high(CtrlReb) do
if ctrlreb[i][2] = sender then begin
j:=round((ctrlreb[i][2] as TspSkinNumericEdit).Value);
if j < 0 then begin
(ctrlreb[i][2] as TspSkinNumericEdit).Value:=0;
g.E[i].ves:=0;
end else begin
g.E[i].ves:=j;
end;
g.Draw(imggraph.Canvas);
exit;
end;
for i := 1 to high(CtrlReb) do
if ctrlreb[i][3] = sender then begin
j:=round((ctrlreb[i][3] as TspSkinNumericEdit).Value);
if (j < 0) or (j > g.E[i].ves) then begin
(ctrlreb[i][3] as TspSkinNumericEdit).Value:=g.E[i].ves;
g.E[i].potok:=g.E[i].ves;
end else begin
g.E[i].potok:=j;
end;
g.Draw(imggraph.Canvas);
exit;
end;
for i := 1 to high(CtrlReb) do
if ctrlreb[i][4] = sender then begin
g.delete(g.E[i]);
g.Draw(imggraph.Canvas);
action;
exit;
end;
end;
end.
Соседние файлы в папке Программа для построения и анализа графов