Untitled

altervisi0n

Jun 30th, 2023

185

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

Delphi 13.55 KB | None | 0 0

raw download clone embed print report

Unit UnitMain;
Interface
Uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtCtrls,
Vcl.Menus, UnitGraph;
Type
TEdge = Record
Vertexes: Array [1 .. 2] of Integer;
End;
TArr = Array of TEdge;
TCoordinate = Record
X, Y: Integer;
End;
TNodeArr = Array of TCoordinate;
TFormMain = class(TForm)
EditVertex: TEdit;
EditEdge: TEdit;
ButtonCreateMtx: TButton;
PanelTop: TPanel;
StringGridMtx: TStringGrid;
ButtonFindMinCover: TButton;
LabelMtx: TLabel;
MainMenu: TMainMenu;
SaveDlg: TSaveDialog;
OpenDlg: TOpenDialog;
PopupMenu: TPopupMenu;
NFile: TMenuItem;
NHelp: TMenuItem;
NDeveloper: TMenuItem;
NOpen: TMenuItem;
NSave: TMenuItem;
LabelVertexCover: TLabel;
ButtonViz: TButton;
LabelText: TLabel;
Procedure EditVertexChange(Sender: TObject);
Procedure EditEdgeChange(Sender: TObject);
Procedure ButtonCreateMtxClick(Sender: TObject);
Procedure StringGridMtxDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
Procedure ButtonFindMinCoverClick(Sender: TObject);
Procedure FormCreate(Sender: TObject);
Procedure NDeveloperClick(Sender: TObject);
Procedure NHelpClick(Sender: TObject);
Procedure NOpenClick(Sender: TObject);
Procedure NSaveClick(Sender: TObject);
Procedure EditVertexKeyPress(Sender: TObject; var Key: Char);
Procedure EditEdgeKeyPress(Sender: TObject; var Key: Char);
Procedure StringGridMtxKeyPress(Sender: TObject; var Key: Char);
Procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Procedure ButtonVizClick(Sender: TObject);
Private
{ Private declarations }
Public
Procedure ClearMtx();
Procedure ProcessEdits();
End;
Var
FormMain: TFormMain;
CountV, CountE: Integer;
Nodes: TNodeArr;
VertexCover: Set of Byte;
Edges: TArr;
Implementation
{$R *.dfm}
Procedure DrawGraph(Canvas: TCanvas; V, E: Integer);
Const
VRADIUS = 20;
GRAPHRADIUS = 200;
Var
Alfa: Real;
I, J: Integer;
Str: String;
Begin
Alfa := 2 * Pi / V;
With Canvas Do
Begin
Font.Size := 12;
Pen.Width := 3;
For I := 0 to (V - 1) Do
Begin
Nodes[I].X := Round(GRAPHRADIUS * Cos(Alfa * I)) + 350;
Nodes[I].Y := Round(GRAPHRADIUS * Sin(Alfa * I)) + 250;
End;
For I := 0 to (E - 1) Do
Begin
MoveTo(Nodes[Edges[I].Vertexes[1] - 1].X,
Nodes[Edges[I].Vertexes[1] - 1].Y);
LineTo(Nodes[Edges[I].Vertexes[2] - 1].X,
Nodes[Edges[I].Vertexes[2] - 1].Y);
End;
For I := 0 to (V - 1) Do
Begin
If I + 1 in VertexCover Then
Brush.Color := clGreen
Else
Brush.Color := clGray;
Ellipse(Nodes[I].X - VRADIUS, Nodes[I].Y - VRADIUS, Nodes[I].X + VRADIUS,
Nodes[I].Y + VRADIUS);
Str := IntToStr(I + 1);
TextOut(Nodes[I].X - (TextWidth(Str) div 2),
Nodes[I].Y - (TextHeight(Str) div 2), Str);
End;
End;
End;
Procedure TFormMain.ButtonFindMinCoverClick(Sender: TObject);
Var
I, J, N, FirstCoverCount, SecondCoverCount: Integer;
IsIncorrect: Boolean;
ErrorMsg, VCString: String;
VertexCover1, VertexCover2: Set Of Byte;
Begin
SetLength(Edges, CountE);
For I := 1 To CountE Do
Begin
N := 1;
For J := 1 To CountV Do
If StringGridMtx.Cells[I, J] = '1' Then
Begin
Edges[I - 1].Vertexes[N] := J;
Inc(N);
End;
End;
I := 0;
IsIncorrect := False;
While (I < CountE) And Not IsIncorrect Do
Begin
J := 0;
While (J < CountE) And Not IsIncorrect Do
Begin
If (Edges[I].Vertexes[1] = Edges[J].Vertexes[1]) And
(Edges[I].Vertexes[2] = Edges[J].Vertexes[2]) And (I <> J) Then
Begin
ErrorMsg := 'Вершины ' + IntToStr(Edges[I].Vertexes[1]) + ' и ' +
IntToStr(Edges[I].Vertexes[2]) + ' соединены двумя ребрами!';
Application.MessageBox(PWideChar(ErrorMsg), 'Ошибка', MB_ICONERROR);
IsIncorrect := True;
End;
Inc(J);
End;
Inc(I);
End;
LabelVertexCover.Caption := '';
If Not IsIncorrect Then
Begin
VCString := '';
SetLength(Nodes, StrToInt(EditVertex.Text));
FirstCoverCount := 0;
SecondCoverCount := 0;
VertexCover1 := [];
VertexCover2 := [];
For I := 0 To CountE - 1 Do
Begin
If Not((Edges[I].Vertexes[1] in VertexCover1) Or
(Edges[I].Vertexes[2] in VertexCover1)) Then
Begin
Include(VertexCover1, Edges[I].Vertexes[1]);
Inc(FirstCoverCount);
End;
// Exclude(VertexCover2, I)
End;
For I := CountE - 1 DownTo 0 Do
Begin
If Not((Edges[I].Vertexes[1] in VertexCover2) Or
(Edges[I].Vertexes[2] in VertexCover2)) Then
Begin
Include(VertexCover2, Edges[I].Vertexes[2]);
Inc(SecondCoverCount);
End;
End;
If FirstCoverCount < SecondCoverCount Then
VertexCover := VertexCover1
Else
VertexCover := VertexCover2;
For I := 1 to CountV Do
If I in VertexCover Then
VCString := VCString + ' ' + IntToStr(I);
LabelVertexCover.Caption := VCString;
NSave.Enabled := True;
ButtonViz.Enabled := True;
End;
End;
procedure TFormMain.ButtonVizClick(Sender: TObject);
Var
Graph: TFormGraph;
Begin
Try
Graph := TFormGraph.Create(Self);
DrawGraph(Graph.Image1.Canvas, CountV, CountE);
Graph.ShowModal();
Finally
Graph.Free();
End;
End;
Procedure TFormMain.ButtonCreateMtxClick(Sender: TObject);
Var
C, I: Integer;
ErrorMsg: String;
Begin
Try
CountV := StrToInt(EditVertex.Text);
CountE := StrToInt(EditEdge.Text);
If (CountV < 2) Or (CountV > 9) Then
Begin
Application.MessageBox('Кол-во вершин - 2..9', 'Ошибка', MB_ICONERROR);
EditVertex.Text := '';
ButtonCreateMtx.Enabled := False;
End
Else
Begin
If CountE < 1 Then
Begin
Application.MessageBox('Минимальное кол-во ребер - 1!', 'Ошибка',
MB_ICONERROR);
EditVertex.Text := '';
ButtonCreateMtx.Enabled := False;
End
Else
Begin
C := CountV * (CountV - 1) div 2;
If CountE > C Then
Begin
ErrorMsg := 'Максимально допустимое число ребер для графа из ' +
IntToStr(CountV) + ' вершин - ' + IntToStr(C);
Application.MessageBox(PWideChar(ErrorMsg), 'Ошибка', MB_ICONERROR);
EditEdge.Text := '';
ButtonCreateMtx.Enabled := False;
End
Else
Begin
StringGridMtx.Enabled := True;
StringGridMtx.RowCount := CountV + 1;
StringGridMtx.ColCount := CountE + 1;
For I := 1 To StringGridMtx.ColCount Do
StringGridMtx.Cells[I, 0] := 'a' + IntToStr(I);
For I := 1 To StringGridMtx.RowCount Do
StringGridMtx.Cells[0, I] := IntToStr(I);
End;
End;
End;
Except
Application.MessageBox('Введены некорректные данные', 'Ошибка',
MB_ICONERROR);
End;
End;
Procedure TFormMain.ClearMtx();
Var
I, J: Integer;
Begin
For I := 1 To CountV Do
For J := 1 to CountE Do
StringGridMtx.Cells[J, I] := '';
End;
Procedure TFormMain.ProcessEdits();
Begin
ClearMtx;
LabelVertexCover.Caption := '';
StringGridMtx.Enabled := False;
ButtonFindMinCover.Enabled := False;
ButtonCreateMtx.Enabled := (EditEdge.Text <> '') And (EditVertex.Text <> '');
NSave.Enabled := False;
ButtonViz.Enabled := False;
End;
Procedure TFormMain.EditEdgeChange(Sender: TObject);
Begin
ProcessEdits;
End;
Procedure TFormMain.EditEdgeKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 Then
If ButtonCreateMtx.Enabled Then
ButtonCreateMtx.Click;
End;
Procedure TFormMain.EditVertexChange(Sender: TObject);
Begin
ProcessEdits;
End;
Procedure TFormMain.EditVertexKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 Then
If ButtonCreateMtx.Enabled Then
ButtonCreateMtx.Click;
End;
Procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Begin
CanClose := MessageBox(Handle, 'Вы действительно хотите выйти?', 'Внимание',
MB_OKCANCEL) = mrOk;
End;
Procedure TFormMain.FormCreate(Sender: TObject);
Var
I: Integer;
Begin
For I := 1 To StringGridMtx.ColCount Do
StringGridMtx.Cells[I, 0] := 'a' + IntToStr(I);
For I := 1 To StringGridMtx.RowCount Do
StringGridMtx.Cells[0, I] := IntToStr(I);
End;
Procedure TFormMain.NDeveloperClick(Sender: TObject);
Begin
Application.MessageBox('Студент группы 251004 Асепков Данила',
'О разработчике',MB_ICONINFORMATION);
End;
Procedure TFormMain.NHelpClick(Sender: TObject);
Const
FIRST_MESSAGE =
'1. Программа работает с неориентированными графами, без петель и кратных ребер, и находит минимальное вершинное покрытие(найденные вершины отмечены зеленым цветом). Ребро должно соединять две вершины'
+ #13#10;
SECOND_MESSAGE = '2. Количество вершин - 2..9' + #13#10 +
'3. Максимально допустимое число ребер для графа с N вершинами - N*(N - 1)/2'
+ #13#10;
THIRD_MESSAGE =
'4. Перед открытием файла убедитесь, что все данные корректны. Первое число - кол-во ребер, второе - кол-во вершин, далее матрица инцидентности. Пример:'
+ #13#10 + '3' + #13#10 + '3' + #13#10 + '1 0 1' + #13#10 + '1 1 0' + #13#10
+ '0 1 1';
Begin
Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE,
'Инструкция', MB_ICONINFORMATION);
End;
Procedure TFormMain.NOpenClick(Sender: TObject);
Var
OpenFile: TextFile;
IsCorrect: Boolean;
I, J, Elem: Integer;
Begin
If (OpenDlg.Execute()) then
Begin
IsCorrect := True;
LabelVertexCover.Caption := '';
ClearMtx;
AssignFile(OpenFile, OpenDlg.FileName);
Try
Reset(OpenFile);
Except
Application.MessageBox('Проверьте параметры доступа файла!', 'Ошибка',
MB_ICONERROR);
IsCorrect := False;
End;
If IsCorrect Then
Begin
Try
Read(OpenFile, CountV);
Read(OpenFile, CountE);
EditVertex.Text := IntToStr(CountV);
EditEdge.Text := IntToStr(CountE);
ButtonCreateMtx.Click;
For I := 1 To CountV Do
For J := 1 To CountE Do
Begin
Read(OpenFile, Elem);
StringGridMtx.Cells[J, I] := IntToStr(Elem);
End;
ButtonFindMinCover.Enabled := True;
StringGridMtx.Enabled := True;
Except
Application.MessageBox('Данные в файле некорректны!', 'Ошибка',
MB_ICONERROR);
ClearMtx;
StringGridMtx.Enabled := False;
ButtonFindMinCover.Enabled := False;
EditVertex.Clear;
EditEdge.Clear;
NSave.Enabled := False;
End;
End;
CloseFile(OpenFile);
End;
End;
Procedure TFormMain.NSaveClick(Sender: TObject);
Var
SaveFile: TextFile;
I, J: Integer;
Begin
If SaveDlg.Execute Then
Begin
AssignFile(SaveFile, SaveDlg.FileName);
Try
Rewrite(SaveFile);
Writeln(SaveFile, 'Матрица инцидентности:');
For I := 1 To CountV Do
Begin
For J := 1 to CountE Do
Write(SaveFile, StringGridMtx.Cells[J, I] + ' ');
Writeln(SaveFile);
End;
Writeln(SaveFile, 'Список инцидентности:' + LabelVertexCover.Caption);
CloseFile(SaveFile);
Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение',
MB_ICONINFORMATION);
Except
Application.MessageBox('Отказано в доступе! Измените параметры файла! ',
'Ошибка!', MB_ICONERROR);
End;
End;
End;
Procedure TFormMain.StringGridMtxDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
Var
I, J, CountOne: Integer;
IsIncorrect: Boolean;
Begin
IsIncorrect := False;
I := 1;
While (I < StringGridMtx.ColCount) And Not IsIncorrect Do
Begin
J := 1;
CountOne := 0;
While (J < StringGridMtx.RowCount) And Not IsIncorrect Do
Begin
If StringGridMtx.Cells[I, J] = '1' Then
Inc(CountOne)
Else If StringGridMtx.Cells[I, J] <> '0' Then
IsIncorrect := True;
Inc(J)
End;
If (CountOne <> 2) Or (IsIncorrect) Then
Begin
ButtonFindMinCover.Enabled := False;
ButtonViz.Enabled := False;
LabelVertexCover.Caption := '';
IsIncorrect := True;
End
Else
ButtonFindMinCover.Enabled := True;
Inc(I);
End;
End;
Procedure TFormMain.StringGridMtxKeyPress(Sender: TObject; var Key: Char);
Begin
If Not(Key In ['0', '1', #13, #8, #46]) Then
Key := #0;
End;
End.

Add Comment

Please, Sign In to add comment