Advertisement
altervisi0n

Untitled

Jun 30th, 2023
184
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 13.55 KB | None | 0 0
  1. Unit UnitMain;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7.   System.Classes, Vcl.Graphics,
  8.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtCtrls,
  9.   Vcl.Menus, UnitGraph;
  10.  
  11. Type
  12.   TEdge = Record
  13.     Vertexes: Array [1 .. 2] of Integer;
  14.   End;
  15.  
  16.   TArr = Array of TEdge;
  17.  
  18.   TCoordinate = Record
  19.     X, Y: Integer;
  20.   End;
  21.  
  22.   TNodeArr = Array of TCoordinate;
  23.  
  24.   TFormMain = class(TForm)
  25.     EditVertex: TEdit;
  26.     EditEdge: TEdit;
  27.     ButtonCreateMtx: TButton;
  28.     PanelTop: TPanel;
  29.     StringGridMtx: TStringGrid;
  30.     ButtonFindMinCover: TButton;
  31.     LabelMtx: TLabel;
  32.     MainMenu: TMainMenu;
  33.     SaveDlg: TSaveDialog;
  34.     OpenDlg: TOpenDialog;
  35.     PopupMenu: TPopupMenu;
  36.     NFile: TMenuItem;
  37.     NHelp: TMenuItem;
  38.     NDeveloper: TMenuItem;
  39.     NOpen: TMenuItem;
  40.     NSave: TMenuItem;
  41.     LabelVertexCover: TLabel;
  42.     ButtonViz: TButton;
  43.     LabelText: TLabel;
  44.     Procedure EditVertexChange(Sender: TObject);
  45.     Procedure EditEdgeChange(Sender: TObject);
  46.     Procedure ButtonCreateMtxClick(Sender: TObject);
  47.     Procedure StringGridMtxDrawCell(Sender: TObject; ACol, ARow: Integer;
  48.       Rect: TRect; State: TGridDrawState);
  49.     Procedure ButtonFindMinCoverClick(Sender: TObject);
  50.     Procedure FormCreate(Sender: TObject);
  51.     Procedure NDeveloperClick(Sender: TObject);
  52.     Procedure NHelpClick(Sender: TObject);
  53.     Procedure NOpenClick(Sender: TObject);
  54.     Procedure NSaveClick(Sender: TObject);
  55.     Procedure EditVertexKeyPress(Sender: TObject; var Key: Char);
  56.     Procedure EditEdgeKeyPress(Sender: TObject; var Key: Char);
  57.     Procedure StringGridMtxKeyPress(Sender: TObject; var Key: Char);
  58.     Procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  59.     Procedure ButtonVizClick(Sender: TObject);
  60.   Private
  61.     { Private declarations }
  62.   Public
  63.     Procedure ClearMtx();
  64.     Procedure ProcessEdits();
  65.   End;
  66.  
  67. Var
  68.   FormMain: TFormMain;
  69.   CountV, CountE: Integer;
  70.   Nodes: TNodeArr;
  71.   VertexCover: Set of Byte;
  72.   Edges: TArr;
  73.  
  74. Implementation
  75.  
  76. {$R *.dfm}
  77.  
  78. Procedure DrawGraph(Canvas: TCanvas; V, E: Integer);
  79. Const
  80.   VRADIUS = 20;
  81.   GRAPHRADIUS = 200;
  82. Var
  83.   Alfa: Real;
  84.   I, J: Integer;
  85.   Str: String;
  86. Begin
  87.   Alfa := 2 * Pi / V;
  88.   With Canvas Do
  89.   Begin
  90.     Font.Size := 12;
  91.     Pen.Width := 3;
  92.     For I := 0 to (V - 1) Do
  93.     Begin
  94.       Nodes[I].X := Round(GRAPHRADIUS * Cos(Alfa * I)) + 350;
  95.       Nodes[I].Y := Round(GRAPHRADIUS * Sin(Alfa * I)) + 250;
  96.     End;
  97.     For I := 0 to (E - 1) Do
  98.     Begin
  99.       MoveTo(Nodes[Edges[I].Vertexes[1] - 1].X,
  100.         Nodes[Edges[I].Vertexes[1] - 1].Y);
  101.       LineTo(Nodes[Edges[I].Vertexes[2] - 1].X,
  102.         Nodes[Edges[I].Vertexes[2] - 1].Y);
  103.     End;
  104.     For I := 0 to (V - 1) Do
  105.     Begin
  106.       If I + 1 in VertexCover Then
  107.         Brush.Color := clGreen
  108.       Else
  109.         Brush.Color := clGray;
  110.       Ellipse(Nodes[I].X - VRADIUS, Nodes[I].Y - VRADIUS, Nodes[I].X + VRADIUS,
  111.         Nodes[I].Y + VRADIUS);
  112.       Str := IntToStr(I + 1);
  113.       TextOut(Nodes[I].X - (TextWidth(Str) div 2),
  114.         Nodes[I].Y - (TextHeight(Str) div 2), Str);
  115.     End;
  116.   End;
  117. End;
  118.  
  119. Procedure TFormMain.ButtonFindMinCoverClick(Sender: TObject);
  120. Var
  121.   I, J, N, FirstCoverCount, SecondCoverCount: Integer;
  122.   IsIncorrect: Boolean;
  123.   ErrorMsg, VCString: String;
  124.   VertexCover1, VertexCover2: Set Of Byte;
  125. Begin
  126.   SetLength(Edges, CountE);
  127.   For I := 1 To CountE Do
  128.   Begin
  129.     N := 1;
  130.     For J := 1 To CountV Do
  131.       If StringGridMtx.Cells[I, J] = '1' Then
  132.       Begin
  133.         Edges[I - 1].Vertexes[N] := J;
  134.         Inc(N);
  135.       End;
  136.   End;
  137.   I := 0;
  138.   IsIncorrect := False;
  139.   While (I < CountE) And Not IsIncorrect Do
  140.   Begin
  141.     J := 0;
  142.     While (J < CountE) And Not IsIncorrect Do
  143.     Begin
  144.       If (Edges[I].Vertexes[1] = Edges[J].Vertexes[1]) And
  145.         (Edges[I].Vertexes[2] = Edges[J].Vertexes[2]) And (I <> J) Then
  146.       Begin
  147.         ErrorMsg := 'Вершины ' + IntToStr(Edges[I].Vertexes[1]) + ' и ' +
  148.           IntToStr(Edges[I].Vertexes[2]) + ' соединены двумя ребрами!';
  149.         Application.MessageBox(PWideChar(ErrorMsg), 'Ошибка', MB_ICONERROR);
  150.         IsIncorrect := True;
  151.       End;
  152.       Inc(J);
  153.     End;
  154.     Inc(I);
  155.   End;
  156.   LabelVertexCover.Caption := '';
  157.   If Not IsIncorrect Then
  158.   Begin
  159.     VCString := '';
  160.     SetLength(Nodes, StrToInt(EditVertex.Text));
  161.     FirstCoverCount := 0;
  162.     SecondCoverCount := 0;
  163.     VertexCover1 := [];
  164.     VertexCover2 := [];
  165.     For I := 0 To CountE - 1 Do
  166.     Begin
  167.       If Not((Edges[I].Vertexes[1] in VertexCover1) Or
  168.         (Edges[I].Vertexes[2] in VertexCover1)) Then
  169.       Begin
  170.         Include(VertexCover1, Edges[I].Vertexes[1]);
  171.         Inc(FirstCoverCount);
  172.       End;
  173.       // Exclude(VertexCover2, I)
  174.     End;
  175.     For I := CountE - 1 DownTo 0 Do
  176.     Begin
  177.       If Not((Edges[I].Vertexes[1] in VertexCover2) Or
  178.         (Edges[I].Vertexes[2] in VertexCover2)) Then
  179.       Begin
  180.         Include(VertexCover2, Edges[I].Vertexes[2]);
  181.         Inc(SecondCoverCount);
  182.       End;
  183.     End;
  184.     If FirstCoverCount < SecondCoverCount Then
  185.       VertexCover := VertexCover1
  186.     Else
  187.       VertexCover := VertexCover2;
  188.     For I := 1 to CountV Do
  189.       If I in VertexCover Then
  190.         VCString := VCString + ' ' + IntToStr(I);
  191.     LabelVertexCover.Caption := VCString;
  192.     NSave.Enabled := True;
  193.     ButtonViz.Enabled := True;
  194.   End;
  195. End;
  196.  
  197. procedure TFormMain.ButtonVizClick(Sender: TObject);
  198. Var
  199.   Graph: TFormGraph;
  200. Begin
  201.   Try
  202.     Graph := TFormGraph.Create(Self);
  203.     DrawGraph(Graph.Image1.Canvas, CountV, CountE);
  204.     Graph.ShowModal();
  205.   Finally
  206.     Graph.Free();
  207.   End;
  208. End;
  209.  
  210. Procedure TFormMain.ButtonCreateMtxClick(Sender: TObject);
  211. Var
  212.   C, I: Integer;
  213.   ErrorMsg: String;
  214. Begin
  215.   Try
  216.     CountV := StrToInt(EditVertex.Text);
  217.     CountE := StrToInt(EditEdge.Text);
  218.     If (CountV < 2) Or (CountV > 9) Then
  219.     Begin
  220.       Application.MessageBox('Кол-во вершин - 2..9', 'Ошибка', MB_ICONERROR);
  221.       EditVertex.Text := '';
  222.       ButtonCreateMtx.Enabled := False;
  223.     End
  224.     Else
  225.     Begin
  226.       If CountE < 1 Then
  227.       Begin
  228.         Application.MessageBox('Минимальное кол-во ребер - 1!', 'Ошибка',
  229.           MB_ICONERROR);
  230.         EditVertex.Text := '';
  231.         ButtonCreateMtx.Enabled := False;
  232.       End
  233.       Else
  234.       Begin
  235.         C := CountV * (CountV - 1) div 2;
  236.         If CountE > C Then
  237.         Begin
  238.           ErrorMsg := 'Максимально допустимое число ребер для графа из ' +
  239.             IntToStr(CountV) + ' вершин - ' + IntToStr(C);
  240.           Application.MessageBox(PWideChar(ErrorMsg), 'Ошибка', MB_ICONERROR);
  241.           EditEdge.Text := '';
  242.           ButtonCreateMtx.Enabled := False;
  243.         End
  244.         Else
  245.         Begin
  246.           StringGridMtx.Enabled := True;
  247.           StringGridMtx.RowCount := CountV + 1;
  248.           StringGridMtx.ColCount := CountE + 1;
  249.           For I := 1 To StringGridMtx.ColCount Do
  250.             StringGridMtx.Cells[I, 0] := 'a' + IntToStr(I);
  251.           For I := 1 To StringGridMtx.RowCount Do
  252.             StringGridMtx.Cells[0, I] := IntToStr(I);
  253.         End;
  254.       End;
  255.     End;
  256.   Except
  257.     Application.MessageBox('Введены некорректные данные', 'Ошибка',
  258.       MB_ICONERROR);
  259.   End;
  260. End;
  261.  
  262. Procedure TFormMain.ClearMtx();
  263. Var
  264.   I, J: Integer;
  265. Begin
  266.   For I := 1 To CountV Do
  267.     For J := 1 to CountE Do
  268.       StringGridMtx.Cells[J, I] := '';
  269. End;
  270.  
  271. Procedure TFormMain.ProcessEdits();
  272. Begin
  273.   ClearMtx;
  274.   LabelVertexCover.Caption := '';
  275.   StringGridMtx.Enabled := False;
  276.   ButtonFindMinCover.Enabled := False;
  277.   ButtonCreateMtx.Enabled := (EditEdge.Text <> '') And (EditVertex.Text <> '');
  278.   NSave.Enabled := False;
  279.   ButtonViz.Enabled := False;
  280. End;
  281.  
  282. Procedure TFormMain.EditEdgeChange(Sender: TObject);
  283. Begin
  284.   ProcessEdits;
  285. End;
  286.  
  287. Procedure TFormMain.EditEdgeKeyPress(Sender: TObject; var Key: Char);
  288. Begin
  289.   If Key = #13 Then
  290.     If ButtonCreateMtx.Enabled Then
  291.       ButtonCreateMtx.Click;
  292. End;
  293.  
  294. Procedure TFormMain.EditVertexChange(Sender: TObject);
  295. Begin
  296.   ProcessEdits;
  297. End;
  298.  
  299. Procedure TFormMain.EditVertexKeyPress(Sender: TObject; var Key: Char);
  300. Begin
  301.   If Key = #13 Then
  302.     If ButtonCreateMtx.Enabled Then
  303.       ButtonCreateMtx.Click;
  304. End;
  305.  
  306. Procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  307. Begin
  308.   CanClose := MessageBox(Handle, 'Вы действительно хотите выйти?', 'Внимание',
  309.     MB_OKCANCEL) = mrOk;
  310. End;
  311.  
  312. Procedure TFormMain.FormCreate(Sender: TObject);
  313. Var
  314.   I: Integer;
  315. Begin
  316.   For I := 1 To StringGridMtx.ColCount Do
  317.     StringGridMtx.Cells[I, 0] := 'a' + IntToStr(I);
  318.   For I := 1 To StringGridMtx.RowCount Do
  319.     StringGridMtx.Cells[0, I] := IntToStr(I);
  320. End;
  321.  
  322. Procedure TFormMain.NDeveloperClick(Sender: TObject);
  323. Begin
  324.   Application.MessageBox('Студент группы 251004 Асепков Данила',
  325.     'О разработчике',MB_ICONINFORMATION);
  326. End;
  327.  
  328. Procedure TFormMain.NHelpClick(Sender: TObject);
  329. Const
  330.   FIRST_MESSAGE =
  331.     '1. Программа работает с неориентированными графами, без петель и кратных ребер, и находит минимальное вершинное покрытие(найденные вершины отмечены зеленым цветом). Ребро должно соединять две вершины'
  332.     + #13#10;
  333.   SECOND_MESSAGE = '2. Количество вершин - 2..9' + #13#10 +
  334.     '3. Максимально допустимое число ребер для графа с N вершинами - N*(N - 1)/2'
  335.     + #13#10;
  336.   THIRD_MESSAGE =
  337.     '4. Перед открытием файла убедитесь, что все данные корректны. Первое число - кол-во ребер, второе - кол-во вершин, далее матрица инцидентности. Пример:'
  338.     + #13#10 + '3' + #13#10 + '3' + #13#10 + '1 0 1' + #13#10 + '1 1 0' + #13#10
  339.     + '0 1 1';
  340. Begin
  341.   Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE,
  342.     'Инструкция', MB_ICONINFORMATION);
  343. End;
  344.  
  345. Procedure TFormMain.NOpenClick(Sender: TObject);
  346. Var
  347.   OpenFile: TextFile;
  348.   IsCorrect: Boolean;
  349.   I, J, Elem: Integer;
  350. Begin
  351.   If (OpenDlg.Execute()) then
  352.   Begin
  353.     IsCorrect := True;
  354.     LabelVertexCover.Caption := '';
  355.     ClearMtx;
  356.     AssignFile(OpenFile, OpenDlg.FileName);
  357.     Try
  358.       Reset(OpenFile);
  359.     Except
  360.       Application.MessageBox('Проверьте параметры доступа файла!', 'Ошибка',
  361.         MB_ICONERROR);
  362.       IsCorrect := False;
  363.     End;
  364.     If IsCorrect Then
  365.     Begin
  366.       Try
  367.         Read(OpenFile, CountV);
  368.         Read(OpenFile, CountE);
  369.         EditVertex.Text := IntToStr(CountV);
  370.         EditEdge.Text := IntToStr(CountE);
  371.         ButtonCreateMtx.Click;
  372.         For I := 1 To CountV Do
  373.           For J := 1 To CountE Do
  374.           Begin
  375.             Read(OpenFile, Elem);
  376.             StringGridMtx.Cells[J, I] := IntToStr(Elem);
  377.           End;
  378.         ButtonFindMinCover.Enabled := True;
  379.         StringGridMtx.Enabled := True;
  380.       Except
  381.         Application.MessageBox('Данные в файле некорректны!', 'Ошибка',
  382.           MB_ICONERROR);
  383.         ClearMtx;
  384.         StringGridMtx.Enabled := False;
  385.         ButtonFindMinCover.Enabled := False;
  386.         EditVertex.Clear;
  387.         EditEdge.Clear;
  388.         NSave.Enabled := False;
  389.       End;
  390.     End;
  391.     CloseFile(OpenFile);
  392.   End;
  393. End;
  394.  
  395. Procedure TFormMain.NSaveClick(Sender: TObject);
  396. Var
  397.   SaveFile: TextFile;
  398.   I, J: Integer;
  399. Begin
  400.   If SaveDlg.Execute Then
  401.   Begin
  402.     AssignFile(SaveFile, SaveDlg.FileName);
  403.     Try
  404.       Rewrite(SaveFile);
  405.       Writeln(SaveFile, 'Матрица инцидентности:');
  406.       For I := 1 To CountV Do
  407.       Begin
  408.         For J := 1 to CountE Do
  409.           Write(SaveFile, StringGridMtx.Cells[J, I] + ' ');
  410.         Writeln(SaveFile);
  411.       End;
  412.       Writeln(SaveFile, 'Список инцидентности:' + LabelVertexCover.Caption);
  413.       CloseFile(SaveFile);
  414.       Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение',
  415.         MB_ICONINFORMATION);
  416.     Except
  417.       Application.MessageBox('Отказано в доступе! Измените параметры файла! ',
  418.         'Ошибка!', MB_ICONERROR);
  419.     End;
  420.   End;
  421. End;
  422.  
  423. Procedure TFormMain.StringGridMtxDrawCell(Sender: TObject; ACol, ARow: Integer;
  424.   Rect: TRect; State: TGridDrawState);
  425. Var
  426.   I, J, CountOne: Integer;
  427.   IsIncorrect: Boolean;
  428. Begin
  429.   IsIncorrect := False;
  430.   I := 1;
  431.   While (I < StringGridMtx.ColCount) And Not IsIncorrect Do
  432.   Begin
  433.     J := 1;
  434.     CountOne := 0;
  435.     While (J < StringGridMtx.RowCount) And Not IsIncorrect Do
  436.     Begin
  437.       If StringGridMtx.Cells[I, J] = '1' Then
  438.         Inc(CountOne)
  439.       Else If StringGridMtx.Cells[I, J] <> '0' Then
  440.         IsIncorrect := True;
  441.       Inc(J)
  442.     End;
  443.     If (CountOne <> 2) Or (IsIncorrect) Then
  444.     Begin
  445.       ButtonFindMinCover.Enabled := False;
  446.       ButtonViz.Enabled := False;
  447.       LabelVertexCover.Caption := '';
  448.       IsIncorrect := True;
  449.     End
  450.     Else
  451.       ButtonFindMinCover.Enabled := True;
  452.     Inc(I);
  453.   End;
  454. End;
  455.  
  456. Procedure TFormMain.StringGridMtxKeyPress(Sender: TObject; var Key: Char);
  457. Begin
  458.   If Not(Key In ['0', '1', #13, #8, #46]) Then
  459.     Key := #0;
  460. End;
  461.  
  462. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement