Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Unit Main;
- Interface
- Uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
- System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.Menus, System.Actions,
- Vcl.ActnList;
- Type
- TMainForm = Class(TForm)
- MainGrid: TStringGrid;
- MainMenu: TMainMenu;
- ManageBtn: TMenuItem;
- DrawBtn: TMenuItem;
- MainActionList: TActionList;
- AManageNodes: TAction;
- AdjacencyListBtn: TMenuItem;
- Savebtn: TMenuItem;
- SaveDialog1: TSaveDialog;
- N1: TMenuItem;
- N2: TMenuItem;
- Procedure FormActivate(Sender: TObject);
- Procedure FormResize(Sender: TObject);
- Procedure ManageBtnClick(Sender: TObject);
- Procedure AManageNodesExecute(Sender: TObject);
- Procedure DrawBtnClick(Sender: TObject);
- Procedure AdjacencyListBtnClick(Sender: TObject);
- Procedure MainGridKeyPress(Sender: TObject; Var Key: Char);
- Procedure GetVerticesCoverBtnClick(Sender: TObject);
- Procedure SavebtnClick(Sender: TObject);
- procedure N2Click(Sender: TObject);
- procedure N1Click(Sender: TObject);
- Private
- { Private declarations }
- Public
- End;
- Var
- MainForm: TMainForm;
- Implementation
- {$R *.dfm}
- Uses Manage, Draw, Adjacency,
- UAddLinks;
- Type
- TEdge = Record
- P1, P2: Byte;
- End;
- TEArray = Array Of TEdge;
- Procedure NameFixedCells(MainGrid: TStringGrid);
- Var
- I: Integer;
- Begin
- For I := 1 To MainGrid.ColCount - 1 Do
- Begin
- MainGrid.Cells[I, 0] := IntToStr(I);
- End;
- For I := 1 To MainGrid.RowCount - 1 Do
- Begin
- MainGrid.Cells[0, I] := IntToStr(I);
- End;
- End;
- Procedure ClearTable(TablForClear: TStringGrid);
- Var
- I, J: Integer;
- Begin
- With TablForClear Do
- For I := 1 To (RowCount - 1) Do
- For J := 1 To (ColCount - 1) Do
- TablForClear.Cells[J, I] := '';
- End;
- Procedure MakeStringGridSameSize(MainGrid: TStringGrid);
- Begin
- MainGrid.Width := MainForm.ClientWidth;
- MainGrid.Height := MainForm.ClientHeight;
- MainGrid.DefaultColWidth := Round(MainForm.ClientWidth / MainGrid.ColCount);
- End;
- Procedure TMainForm.AdjacencyListBtnClick(Sender: TObject);
- Begin
- AdjacencyForm.Show;
- End;
- Procedure TMainForm.AManageNodesExecute(Sender: TObject);
- Begin
- AdjacencyForm.ClearImage(AdjacencyForm.Image1);
- ClearTable(MainGrid);
- Savebtn.Enabled := False;
- MainGrid.ColCount := StrToInt(ManageForm.NodeCountEdit.Text) + 1;
- MainGrid.RowCount := StrToInt(ManageForm.NodeCountEdit.Text) + 1;
- MakeStringGridSameSize(MainGrid);
- NameFixedCells(MainGrid);
- End;
- Procedure TMainForm.DrawBtnClick(Sender: TObject);
- Begin
- DrawForm.Show;
- End;
- Procedure TMainForm.FormActivate(Sender: TObject);
- Begin
- MakeStringGridSameSize(MainGrid);
- NameFixedCells(MainGrid);
- End;
- Procedure TMainForm.FormResize(Sender: TObject);
- Begin
- MakeStringGridSameSize(MainGrid);
- End;
- Function NoSameEdges(EdgesArray: TEArray; P1: Byte; P2: Byte): Boolean;
- Var
- I: Integer;
- Begin
- Result := True;
- For I := 0 To Length(EdgesArray) - 1 Do
- Begin
- If ((EdgesArray[I].P1 = P1) And (EdgesArray[I].P2 = P2)) Or
- ((EdgesArray[I].P1 = P2) And (EdgesArray[I].P2 = P1)) Then
- Begin
- Result := False;
- Break;
- End;
- End;
- End;
- Function VerticleHasEdge(Ver: Byte; EdgesArray: TEArray): Boolean;
- Var
- I: Integer;
- Begin
- Result := False;
- For I := 0 To Length(EdgesArray) - 1 Do
- Begin
- If (EdgesArray[I].P1 = Ver) Or (EdgesArray[I].P2 = Ver) Then
- Begin
- Result := True;
- Break;
- End;
- End;
- End;
- Function DeleteElemFromArr(Index: Byte; EdgesArray: TEArray): TEArray;
- Var
- I: Integer;
- Begin
- For I := Index To Length(EdgesArray) - 2 Do
- EdgesArray[I] := EdgesArray[I + 1];
- SetLength(EdgesArray, Length(EdgesArray) - 1);
- Result := EdgesArray;
- End;
- Function DeleteAllEdgesWithVer(Ver: Byte; EdgesArray: TEArray): TEArray;
- Var
- IsDeletedAll: Boolean;
- I: Integer;
- Begin
- IsDeletedAll := True;
- Repeat
- For I := 0 To Length(EdgesArray) - 1 Do
- Begin
- If (EdgesArray[I].P1 = Ver) Or (EdgesArray[I].P2 = Ver) Then
- Begin
- IsDeletedAll := False;
- EdgesArray := DeleteElemFromArr(I, EdgesArray);
- Break;
- End;
- End;
- If I = Length(EdgesArray) Then
- IsDeletedAll := True;
- Until IsDeletedAll;
- Result := EdgesArray;
- End;
- Procedure TMainForm.GetVerticesCoverBtnClick(Sender: TObject);
- Var
- EdgesArray: TEArray;
- ACover: Array Of Byte;
- I, J: Byte;
- ResStr: String;
- Begin
- SetLength(EdgesArray, 0);
- For I := 1 To MainGrid.ColCount Do
- Begin
- For J := 1 To MainGrid.ColCount Do
- Begin
- If (I <> J) And (MainGrid.Cells[I, J] = MainGrid.Cells[J, I]) And
- ((MainGrid.Cells[I, J] <> '') And (MainGrid.Cells[I, J] <> '0')) Then
- Begin
- If NoSameEdges(EdgesArray, I, J) Then
- Begin
- SetLength(EdgesArray, Length(EdgesArray) + 1);
- EdgesArray[Length(EdgesArray) - 1].P1 := I;
- EdgesArray[Length(EdgesArray) - 1].P2 := J;
- End;
- End;
- End;
- End;
- SetLength(ACover, 0);
- For I := 1 To MainGrid.ColCount Do
- Begin
- If VerticleHasEdge(I, EdgesArray) Then
- Begin
- SetLength(ACover, Length(ACover) + 1);
- ACover[Length(ACover) - 1] := I;
- EdgesArray := DeleteAllEdgesWithVer(I, EdgesArray);
- End;
- End;
- ResStr := '';
- For I := 0 To Length(ACover) - 1 Do
- Begin
- ResStr := ResStr + ' ' + IntToStr(ACover[I]);
- End;
- ShowMessage(ResStr);
- End;
- Procedure TMainForm.MainGridKeyPress(Sender: TObject; Var Key: Char);
- Begin
- If Not(Key In ['0' .. '1', #8]) Then
- Begin
- Key := #0;
- End;
- End;
- Procedure TMainForm.ManageBtnClick(Sender: TObject);
- Begin
- ManageForm.NodeCountEdit.Text := IntToStr(MainGrid.ColCount - 1);
- NameFixedCells(MainGrid);
- ManageForm.ShowModal;
- FrmAddLinkns.Nheights := StrToInt(ManageForm.NodeCountEdit.Text);
- FrmAddLinkns.ShowModal;
- End;
- procedure TMainForm.N1Click(Sender: TObject);
- begin
- Application.MessageBox
- ('Импортировать список (неориентированный граф), инструкция:' +
- #13#10'1. Файл должен содержать только числа, которые не превышают максимальной вершины.'#13#10
- + '2. Если вершине не нужно задавать n-ую связь, то ставится пробел, смотреть пример ниже.'#13#10
- + '3. Первая строка - число вершин в графе'#13#10 + 'Пример:'#13#10 +
- '3'#13#10 + '2 3'#13#10 + '1 '#13#10 + '1 3'#13#10,
- 'Инструкция к программе', MB_OK + MB_ICONINFORMATION);
- end;
- procedure TMainForm.N2Click(Sender: TObject);
- begin
- Application.MessageBox('Выполнил студент группы 251004, Асепков Данила.',
- 'О разработчике', MB_OK + MB_ICONINFORMATION);
- end;
- Procedure SaveStringGridToFile(StringGrid: TStringGrid; Const FileName: String);
- Var
- FileStream: TFileStream;
- StreamWriter: TStreamWriter;
- Row, Col: Integer;
- Begin
- Try
- // Проверяем, существует ли файл
- If Not(FileExists(FileName)) Then
- Raise Exception.Create('Файл уже существует.');
- FileStream := TFileStream.Create(FileName, FmCreate);
- Try
- StreamWriter := TStreamWriter.Create(FileStream);
- Try
- For Row := 0 To StringGrid.RowCount - 1 Do
- Begin
- For Col := 0 To StringGrid.ColCount - 1 Do
- Begin
- StreamWriter.Write(StringGrid.Cells[Col, Row]);
- If Col < StringGrid.ColCount - 1 Then
- StreamWriter.Write(#9);
- // Добавляем разделитель между ячейками
- End;
- StreamWriter.WriteLine; // Переходим на новую строку
- End;
- Finally
- StreamWriter.Free;
- End;
- Finally
- FileStream.Free;
- End;
- Except
- On E: Exception Do
- Begin
- // Обработка ошибки
- ShowMessage('Ошибка при сохранении файла: ' + E.Message);
- End;
- End;
- End;
- Procedure TMainForm.SavebtnClick(Sender: TObject);
- Begin
- If (SaveDialog1.Execute) Then
- SaveStringGridToFile(MainGrid, SaveDialog1.FileName);
- End;
- End.
- unit Adjacency;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
- System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
- type
- TAdjacencyForm = class(TForm)
- Image1: TImage;
- procedure FormActivate(Sender: TObject);
- private
- { Private declarations }
- public
- Procedure ClearImage(Image: TImage);
- end;
- var
- AdjacencyForm: TAdjacencyForm;
- implementation
- {$R *.dfm}
- Uses Main;
- Procedure TAdjacencyForm.ClearImage(Image: TImage);
- Begin
- With Image.Canvas do
- Begin
- Pen.Color := clWhite;
- Brush.Color := clWhite;
- Rectangle(0, 0, Image.Width, Image.Height);
- End;
- End;
- Procedure TAdjacencyForm.FormActivate(Sender: TObject);
- Var
- I, J: Integer;
- PosY, TempX: Integer;
- Begin
- PosY := 20;
- For I := 1 to MainForm.MainGrid.ColCount - 1 do
- Begin
- With Image1.Canvas do
- Begin
- Pen.Color := clBlack;
- Brush.Color := clWhite;
- Rectangle(30, PosY - 10, 60, PosY + 20);
- TextOut(33, PosY - 3, MainForm.MainGrid.Cells[I, 0]);
- Rectangle(59, PosY - 10, 90, PosY + 20);
- TempX := 90;
- For J := 1 to MainForm.MainGrid.ColCount - 1 do
- Begin
- With MainForm.MainGrid do
- Begin
- If (I <> J) and (Cells[I, J] = Cells[J, I]) and (Cells[I, J] <> '')
- then
- Begin
- MoveTo(TempX, PosY);
- TempX := TempX + 20;
- LineTo(TempX, PosY);
- Rectangle(TempX, PosY - 10, TempX + 30, PosY + 20);
- TextOut(TempX + 3, PosY - 3, IntToStr(J));
- TempX := TempX + 30 - 1;
- Rectangle(TempX, PosY - 10, TempX + 30, PosY + 20);
- TempX := TempX + 30;
- End;
- End;
- End;
- End;
- Inc(PosY, 40);
- End;
- End;
- end.
- Unit Manage;
- Interface
- Uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
- System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin;
- Type
- TManageForm = class(TForm)
- NodeCountEdit: TSpinEdit;
- Label1: TLabel;
- SaveBtn: TButton;
- procedure SaveBtnClick(Sender: TObject);
- Private
- { Private declarations }
- Public
- { Public declarations }
- End;
- Var
- ManageForm: TManageForm;
- Implementation
- {$R *.dfm}
- Uses Main, uAddLinks;
- Procedure TManageForm.SaveBtnClick(Sender: TObject);
- Begin
- If StrToInt(NodeCountEdit.Text) > 10 then
- NodeCountEdit.Text := '10'
- Else If StrToInt(NodeCountEdit.Text) < 0 then
- NodeCountEdit.Text := '1';
- MainForm.aManageNodes.Execute;
- frmAddLinkns.nHeights := NodeCountEdit.Value;
- frmAddLinkns.ClearSgTable(frmAddLinkns.SgLinks);
- Self.Close;
- End;
- End.
- Unit uAddLinks;
- Interface
- Uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
- System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Main,
- Vcl.Menus, Manage;
- Type
- TfrmAddLinkns = Class(TForm)
- Label1: TLabel;
- SgLinks: TStringGrid;
- SgHeights: TStringGrid;
- Label2: TLabel;
- Label3: TLabel;
- MainMenu1: TMainMenu;
- N1: TMenuItem;
- OpenDialog1: TOpenDialog;
- Procedure FormShow(Sender: TObject);
- Procedure FormKeyPress(Sender: TObject; Var Key: Char);
- Procedure ChangeTable();
- Procedure N1Click(Sender: TObject);
- Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
- Procedure SgLinksSetEditText(Sender: TObject; ACol, ARow: Integer;
- Const Value: String);
- Private
- Function NotRepeated(Str: String; Pos: Integer): Boolean;
- Public
- Nheights: Integer;
- Procedure ClearSgTable(STRGRID: TStringGrid);
- End;
- Var
- FrmAddLinkns: TfrmAddLinkns;
- Implementation
- {$R *.dfm}
- Procedure TfrmAddLinkns.ClearSgTable(STRGRID: TStringGrid);
- Var
- I, J: Integer;
- Begin
- With STRGRID Do
- For I := 0 To (RowCount - 1) Do
- For J := 0 To (ColCount - 1) Do
- STRGRID.Cells[J, I] := '';
- End;
- Procedure TfrmAddLinkns.FormClose(Sender: TObject; Var Action: TCloseAction);
- Var
- I, J, Pos: Integer;
- Begin
- For I := 0 To Nheights - 1 Do
- For J := 0 To Nheights - 2 Do
- Begin
- If (SgLinks.Cells[J, I] <> '') Then
- Begin
- Pos := StrToInt(SgLinks.Cells[J, I]);
- MainForm.MainGrid.Cells[Pos, I + 1] := '1';
- MainForm.MainGrid.Cells[I + 1, Pos] := '1';
- End;
- End;
- MainForm.Savebtn.Enabled := True;
- End;
- Procedure TfrmAddLinkns.FormKeyPress(Sender: TObject; Var Key: Char);
- Var
- Num, ARow: Integer;
- Begin
- ARow := SgLinks.Row + 1;
- If Not CharInSet(Key, ['1' .. '9', #08]) Then
- Key := #0;
- Num := Ord(Key) - 48;
- If (Num > Nheights) Or (ARow = Num) Then
- Key := #0;
- End;
- Procedure TfrmAddLinkns.ChangeTable();
- Var
- I: Integer;
- Begin
- SgHeights.RowCount := Nheights;
- SgLinks.ColCount := Nheights - 1;
- SgLinks.RowCount := Nheights;
- SgHeights.Height := 35 * (Nheights + 1);
- SgLinks.Width := 35 * Nheights;
- SgLinks.Height := 35 * (Nheights + 1);
- For I := 0 To Nheights - 1 Do
- SgHeights.Cells[0, I] := IntToStr(I + 1);
- End;
- Procedure TfrmAddLinkns.FormShow(Sender: TObject);
- Begin
- ChangeTable;
- End;
- Function IsFileCorrect(Path: String): Boolean;
- Var
- ISize, JSize, Num: Integer;
- IsCorrect: Boolean;
- MatrixFile: TextFile;
- Size: Integer;
- Begin
- ISize := 0;
- JSize := 0;
- IsCorrect := True;
- AssignFile(MatrixFile, Path);
- Reset(MatrixFile);
- Readln(MatrixFile, Size);
- If (Size < 1) Or (Size > 9) Then
- Begin
- IsCorrect := False;
- MessageBox(Application.Handle,
- 'Файл содержит некорректные данные. Первая строка - размер. Значение от 1 до 5',
- 'Уведомление об ошибке', MB_ICONERROR);
- End;
- ManageForm.NodeCountEdit.Value := Size;
- FrmAddLinkns.Nheights := Size;
- FrmAddLinkns.ChangeTable;
- MainForm.AManageNodes.Execute;
- While Not(SeekEof(MatrixFile)) And IsCorrect Do
- Begin
- While Not(SeekEoln(MatrixFile)) And IsCorrect Do
- Begin
- Try
- Read(MatrixFile, Num);
- If (Num > Size) Or (Num < 0) Then
- Begin
- IsCorrect := False;
- MessageBox(Application.Handle,
- 'Файл содержит некорректные данные. число должно быть вершиной ',
- 'Уведомление об ошибке', MB_ICONERROR);
- End;
- If Num = 0 Then
- FrmAddLinkns.SgLinks.Cells[JSize, ISize] := ''
- Else
- FrmAddLinkns.SgLinks.Cells[JSize, ISize] := IntToStr(Num);
- Except
- IsCorrect := False;
- End;
- Inc(JSize);
- End;
- Inc(ISize);
- Readln(MatrixFile);
- JSize := 0;
- End;
- If ISize <> Size Then
- Begin
- IsCorrect := False;
- MessageBox(Application.Handle,
- 'Файл содержит некорректные данные. Недостаточно строк',
- 'Уведомление об ошибке', MB_ICONERROR);
- End;
- CloseFile(MatrixFile);
- IsFileCorrect := IsCorrect;
- End;
- Procedure TfrmAddLinkns.N1Click(Sender: TObject);
- Begin
- ManageForm.NodeCountEdit.Value := 1;
- If Not((OpenDialog1.Execute) And (IsFileCorrect(OpenDialog1.Filename))) Then
- ManageForm.NodeCountEdit.Value := 1
- End;
- Function TfrmAddLinkns.NotRepeated(Str: String; Pos: Integer): Boolean;
- Var
- I: Integer;
- IsNotRepeated: Boolean;
- Begin
- IsNotRepeated := True;
- For I := 0 To Nheights - 1 Do
- Begin
- If SgHeights.Cells[I, Pos] = Str Then
- IsNotRepeated := False;
- End;
- NotRepeated := IsNotRepeated;
- End;
- Procedure TfrmAddLinkns.SgLinksSetEditText(Sender: TObject; ACol, ARow: Integer;
- Const Value: String);
- Var
- I, J: Integer;
- Begin
- For I := 0 To SgLinks.ColCount - 1 Do
- For J := 0 To SgLinks.ColCount - 1 Do
- Begin
- If Length(SgLinks.Cells[J, I]) > 1 Then
- SgLinks.Cells[J, I] := '';
- End;
- End;
- End.
- Unit Draw;
- Interface
- Uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
- System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.IOUtils, Math;
- Type
- TDrawForm = class(TForm)
- Image: TImage;
- procedure FormActivate(Sender: TObject);
- Private
- { Private declarations }
- Public
- { Public declarations }
- End;
- Var
- DrawForm: TDrawForm;
- Implementation
- {$R *.dfm}
- Uses Main;
- Type
- TCoor = Record
- X, Y: Integer;
- End;
- TArray = Array of Byte;
- Const
- X_LOC: Array [1 .. 10] of Integer = (300, 200, 400, 100, 500, 100, 500, 200,
- 400, 300);
- Y_LOC: Array [1 .. 10] of Integer = (30, 70, 70, 110, 110, 200, 200, 240,
- 240, 280);
- Function IsAlreadyAdded(Arr: TArray; Pos: Byte): Boolean;
- Var
- I: Integer;
- Begin
- If Length(Arr) = 0 then
- Result := False
- Else
- Begin
- Result := False;
- For I := 0 to Length(Arr) - 1 do
- Begin
- If Pos = Arr[I] then
- Begin
- Result := True;
- Break;
- End;
- End;
- End;
- End;
- Procedure Visualize(Image: TImage);
- Var
- I, J, Pos: Integer;
- CreatedPosArray: TArray;
- Begin
- SetLength(CreatedPosArray, 0);
- For I := 1 to MainForm.MainGrid.ColCount - 1 do
- Begin
- Repeat
- Pos := RandomRange(1, 11);
- Until not IsAlreadyAdded(CreatedPosArray, Pos);
- SetLength(CreatedPosArray, Length(CreatedPosArray) + 1);
- CreatedPosArray[Length(CreatedPosArray) - 1] := Pos;
- End;
- For I := 1 to MainForm.MainGrid.ColCount - 1 do
- Begin
- For J := 1 to MainForm.MainGrid.RowCount - 1 do
- Begin
- If I <> J then
- Begin
- With MainForm.MainGrid do
- Begin
- If (Cells[I, J] = Cells[J, I]) and
- ((Cells[I, J] <> '') and (Cells[I, J] <> '0')) and
- (Cells[J, I] <> '') then
- Begin
- With Image.Canvas do
- Begin
- Pen.Color := clBlack;
- MoveTo(X_LOC[CreatedPosArray[I - 1]],
- Y_LOC[CreatedPosArray[I - 1]]);
- LineTo(X_LOC[CreatedPosArray[J - 1]],
- Y_LOC[CreatedPosArray[J - 1]]);
- End;
- End;
- End;
- End;
- End;
- End;
- For I := 1 to MainForm.MainGrid.ColCount - 1 do
- Begin
- With Image.Canvas do
- Begin
- Pen.Color := clBlack;
- Brush.Color := clWhite;
- Rectangle((X_LOC[CreatedPosArray[I - 1]] - 20),
- (Y_LOC[CreatedPosArray[I - 1]] - 20),
- (X_LOC[CreatedPosArray[I - 1]] + 20),
- (Y_LOC[CreatedPosArray[I - 1]] + 20));
- TextOut(X_LOC[CreatedPosArray[I - 1]] - 10, Y_LOC[CreatedPosArray[I - 1]]
- - 7, IntToStr(I));
- End;
- End;
- End;
- Procedure ClearImage(Image: TImage);
- Begin
- With Image.Canvas do
- Begin
- Pen.Color := clWhite;
- Brush.Color := clWhite;
- Rectangle(0, 0, Image.Width, Image.Height);
- End;
- End;
- Procedure TDrawForm.FormActivate(Sender: TObject);
- Begin
- Image.Width := Self.ClientWidth;
- Image.Height := Self.ClientHeight;
- ClearImage(Image);
- Visualize(Image);
- End;
- End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement