Advertisement
MadCortez

Untitled

Apr 28th, 2021
743
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 16.92 KB | None | 0 0
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Grids,
  8.   Vcl.ExtCtrls;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     FileButton: TMenuItem;
  14.     AboutButton: TMenuItem;
  15.     ReadButton: TMenuItem;
  16.     SaveButton: TMenuItem;
  17.     OpenDialog1: TOpenDialog;
  18.     SaveDialog1: TSaveDialog;
  19.     Start: TButton;
  20.     SizeEdit: TEdit;
  21.     SizeLabel: TLabel;
  22.     Label1: TLabel;
  23.     Label2: TLabel;
  24.     Label3: TLabel;
  25.     Label4: TLabel;
  26.     Label5: TLabel;
  27.     Label6: TLabel;
  28.     Label7: TLabel;
  29.     Label8: TLabel;
  30.     Label9: TLabel;
  31.     Label10: TLabel;
  32.     Matrix1: TStringGrid;
  33.     Matrix2: TStringGrid;
  34.     Label11: TLabel;
  35.     Label12: TLabel;
  36.     Label13: TLabel;
  37.     Label14: TLabel;
  38.     Label15: TLabel;
  39.     Label16: TLabel;
  40.     Label17: TLabel;
  41.     Label18: TLabel;
  42.     Label19: TLabel;
  43.     Label20: TLabel;
  44.     Label21: TLabel;
  45.     Label22: TLabel;
  46.     Label23: TLabel;
  47.     Label24: TLabel;
  48.     Label25: TLabel;
  49.     Label26: TLabel;
  50.     Label27: TLabel;
  51.     Label28: TLabel;
  52.     Label29: TLabel;
  53.     Label30: TLabel;
  54.     Matrix1Label: TLabel;
  55.     Matrix2Label: TLabel;
  56.     Check: TButton;
  57.     Label31: TLabel;
  58.     Label32: TLabel;
  59.     Label33: TLabel;
  60.     Label34: TLabel;
  61.     Label35: TLabel;
  62.     Label36: TLabel;
  63.     Label37: TLabel;
  64.     Label38: TLabel;
  65.     Label39: TLabel;
  66.     Label40: TLabel;
  67.     Label41: TLabel;
  68.     Label42: TLabel;
  69.     Label43: TLabel;
  70.     Label44: TLabel;
  71.     Label45: TLabel;
  72.     Label46: TLabel;
  73.     Label47: TLabel;
  74.     Label48: TLabel;
  75.     Label49: TLabel;
  76.     Label50: TLabel;
  77.     Label51: TLabel;
  78.     Label52: TLabel;
  79.     Label53: TLabel;
  80.     Label54: TLabel;
  81.     Label55: TLabel;
  82.     Label56: TLabel;
  83.     Label57: TLabel;
  84.     Label58: TLabel;
  85.     Label59: TLabel;
  86.     Label60: TLabel;
  87.     procedure AboutButtonClick(Sender: TObject);
  88.     procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  89.     procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  90.     procedure EditChange(Sender: TObject);
  91.     procedure ReadButtonClick(Sender: TObject);
  92.     procedure SaveButtonClick(Sender: TObject);
  93.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  94.     procedure EditKeyPress(Sender: TObject; var Key: Char);
  95.     procedure StartClick(Sender: TObject);
  96.     procedure CheckClick(Sender: TObject);
  97.     procedure Matrix1MouseDown(Sender: TObject; Button: TMouseButton;
  98.       Shift: TShiftState; X, Y: Integer);
  99.     procedure Matrix2MouseDown(Sender: TObject; Button: TMouseButton;
  100.       Shift: TShiftState; X, Y: Integer);
  101.     procedure FillMatrixs();
  102.   private
  103.     { Private declarations }
  104.   public
  105.     { Public declarations }
  106.   end;
  107.  
  108. {$R *.dfm}
  109.  
  110. Type
  111.    TMatrix = array[0..9, 0..9] of Byte;
  112. var
  113.   Form1: TForm1;
  114.   N, Size: Integer;
  115.   Matrix11, Matrix22: TMatrix;
  116.   P: array[0..9] of Byte;
  117.   GlobalFlag: Boolean;
  118.   Ans: String;
  119. const
  120.    MIN_SIZE = 2;
  121.    MAX_SIZE = 10;
  122.  
  123. implementation
  124. procedure ShowAns(Ans: String); stdcall; external 'MyDll.dll';
  125.  
  126. procedure TForm1.EditChange(Sender: TObject);
  127. var
  128.    IsValid1: Boolean;
  129.    i: Integer;
  130. begin
  131.    IsValid1 := False;
  132.    GlobalFlag := False;
  133.    SaveButton.Enabled := False;
  134.    Matrix1.Visible := False;
  135.    Matrix2.Visible := False;
  136.    Matrix1Label.Visible := False;
  137.    Matrix2Label.Visible := False;
  138.    Check.Visible := False;
  139.    for i := 1 to 10 do
  140.    begin
  141.       TLabel(FindComponent('Label' + IntToStr(i))).Visible := False;
  142.       TLabel(FindComponent('Label' + IntToStr(10 + i))).Visible := False;
  143.       TLabel(FindComponent('Label' + IntToStr(20 + i))).Visible := False;
  144.       TLabel(FindComponent('Label' + IntToStr(30 + i))).Visible := False;
  145.    end;
  146.    PatBlt(Form1.Canvas.Handle, 0, 470, Form1.ClientWidth, Form1.ClientHeight, PATCOPY);
  147.  
  148.    if SizeEdit.Text <> '' then
  149.       IsValid1 := True;
  150.    if IsValid1 then
  151.       Start.Enabled := True
  152.    else
  153.       Start.Enabled := False;
  154. end;
  155.  
  156. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  157. begin
  158.    CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
  159.       #10#13 + 'Все несохраненные данные будут утеряны.',
  160.       mtConfirmation, [mbYes, mbNo], 0) = mrYes;
  161. end;
  162.  
  163. procedure TForm1.Matrix1MouseDown(Sender: TObject; Button: TMouseButton;
  164.   Shift: TShiftState; X, Y: Integer);
  165. var
  166.    ACol, ARow: Integer;
  167. begin
  168.    Matrix1.MouseToCell(X, Y, ACol, ARow);
  169.    if Matrix1.Cells[ACol, ARow] = '0' then
  170.    begin
  171.       Matrix1.Cells[ACol, ARow] := '1';
  172.       Canvas.Pen.Color := clRed;
  173.       Canvas.Pen.Width := 2;
  174.       Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Left,
  175.       TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Top);
  176.       Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Left,
  177.       TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Top);
  178.    end
  179.    else
  180.    begin
  181.       Matrix1.Cells[ACol, ARow] := '0';
  182.       Canvas.Pen.Color := Form1.Color;
  183.       Canvas.Pen.Width := 2;
  184.       Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Left,
  185.       TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Top);
  186.       Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Left,
  187.       TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Top);
  188.    end;
  189. end;
  190.  
  191. procedure TForm1.Matrix2MouseDown(Sender: TObject; Button: TMouseButton;
  192.   Shift: TShiftState; X, Y: Integer);
  193. var
  194.    ACol, ARow: Integer;
  195. begin
  196.    Matrix2.MouseToCell(X, Y, ACol, ARow);
  197.    if Matrix2.Cells[ACol, ARow] = '0' then
  198.    begin
  199.       GlobalFlag := False;
  200.       Matrix2.Cells[ACol, ARow] := '1';
  201.       Canvas.Pen.Color := clRed;
  202.       Canvas.Pen.Width := 2;
  203.       Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Left,
  204.       TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Top);
  205.       Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Left,
  206.       TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Top);
  207.    end
  208.    else
  209.    begin
  210.       GlobalFlag := False;
  211.       Matrix2.Cells[ACol, ARow] := '0';
  212.       Canvas.Pen.Color := Form1.Color;
  213.       Canvas.Pen.Width := 2;
  214.       Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Left,
  215.       TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Top);
  216.       Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Left,
  217.       TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Top);
  218.    end;
  219. end;
  220.  
  221. procedure TForm1.FillMatrixs();
  222. var
  223.    i, j: Integer;
  224. begin
  225.    for i := 0 to n - 1 do
  226.       for j := 0 to n - 1 do
  227.       begin
  228.          Matrix11[i, j] := StrToInt(Matrix1.Cells[j, i]);
  229.          Matrix22[i, j] := StrToInt(Matrix2.Cells[j, i]);
  230.       end;
  231. end;
  232.  
  233. procedure CheckForIzomorph();
  234. var
  235.    i, j: Integer;
  236.    Flag: Boolean;
  237. begin
  238.    Flag := True;
  239.    for i := 0 to n - 1 do
  240.       if Flag then
  241.          for j := 0 to n - 1 do
  242.             if Matrix11[i, j] <> Matrix22[p[i], p[j]] then
  243.                Flag := False;
  244.    GlobalFlag := Flag;
  245. end;
  246.  
  247. procedure swap(x, y: longint);
  248. var c: Integer;
  249. begin
  250.    c := p[x];
  251.    p[x] := p[y];
  252.    p[y] := c;
  253. end;
  254.  
  255. procedure next_perm(k, n: longint);
  256. var i: longint;
  257. begin
  258.    if GlobalFlag then
  259.       exit;
  260.    if k = n then
  261.    begin
  262.       CheckForIzomorph;
  263.       exit;
  264.    end;
  265.    for i := k to n do
  266.    begin
  267.       swap(k, i);
  268.       next_perm(k + 1, n);
  269.       swap(k, i);
  270.    end;
  271. end;
  272.  
  273. procedure TForm1.CheckClick(Sender: TObject);
  274. var
  275.    i, j: Integer;
  276.    s: string;
  277. begin
  278.    FillMatrixs;
  279.    for i := 0 to n - 1 do
  280.       P[i] := i;
  281.    next_perm(0, n - 1);
  282.    if GlobalFlag then
  283.       Ans := 'Графы изоморфны'
  284.    else
  285.       Ans := 'Графы не изоморфны';
  286.    ShowAns(Ans);
  287.    SaveButton.Enabled := True;
  288. end;
  289.  
  290. procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
  291. const
  292.    Digit: set of Char = ['0'..'9', #8];
  293. begin
  294.    with (Sender as TEdit) do
  295.    begin
  296.       if not(Key in Digit) then
  297.          Key := #0;
  298.    end;
  299.    SaveButton.Enabled := False;
  300. end;
  301.  
  302. procedure TForm1.AboutButtonClick(Sender: TObject);
  303. var
  304.    Task: String;
  305. begin
  306.    Task := 'Данная программа проверяет два графа на изоморфность. Графы заданы матрицами смежности' + #10#13;
  307.    Task := Task + 'Автор - Пестунов Илья, гр. 051007';
  308.    MessageDlg(Task, mtInformation, [mbOK], 0);
  309. end;
  310.  
  311. procedure TForm1.ReadButtonClick(Sender: TObject);
  312. var
  313.    MyFile: TextFile;
  314.    i, j, m: Integer;
  315. begin
  316.    SizeEdit.Text := '';
  317.    Check.Visible := False;
  318.    Matrix1.Visible := False;
  319.    if OpenDialog1.Execute then
  320.    begin
  321.       AssignFile(MyFile, OpenDialog1.FileName);
  322.       Reset(MyFile);
  323.       Read(MyFile, N);
  324.       SizeEdit.Text := IntToStr(N);
  325.       Form1.Start.Click;
  326.       for i := 0 to n - 1 do
  327.          for j := 0 to n - 1 do
  328.          begin
  329.             Read(MyFile, m);
  330.             Matrix1.Cells[j, i] := IntToStr(m);
  331.             if m = 1 then
  332.             begin
  333.                Canvas.Pen.Color := clRed;
  334.                Canvas.Pen.Width := 2;
  335.                Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(i + 41))).Left,
  336.                TLabel(FindComponent('Label' + IntToStr(i + 41))).Top);
  337.                Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(j + 41))).Left,
  338.                TLabel(FindComponent('Label' + IntToStr(j + 41))).Top);
  339.             end;
  340.          end;
  341.       for i := 0 to n - 1 do
  342.          for j := 0 to n - 1 do
  343.          begin
  344.             Read(MyFile, m);
  345.             Matrix2.Cells[j, i] := IntToStr(m);
  346.             if m = 1 then
  347.             begin
  348.                Canvas.Pen.Color := clRed;
  349.                Canvas.Pen.Width := 2;
  350.                Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(i + 51))).Left,
  351.                TLabel(FindComponent('Label' + IntToStr(i + 51))).Top);
  352.                Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(j + 51))).Left,
  353.                TLabel(FindComponent('Label' + IntToStr(j + 51))).Top);
  354.             end;
  355.          end;
  356.       CloseFile(MyFile);
  357.    end;
  358. end;
  359.  
  360. procedure TForm1.SaveButtonClick(Sender: TObject);
  361. var
  362.    MyFile: TextFile;
  363.    i, j: Integer;
  364. begin
  365.    if SaveDialog1.Execute then
  366.    begin
  367.       AssignFile(MyFile, SaveDialog1.FileName);
  368.       Rewrite(MyFile);
  369.       Writeln(MyFile, Ans);
  370.       CloseFile(MyFile);
  371.       MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
  372.    end;
  373. end;
  374.  
  375. procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  376. var
  377.    IsValid: Boolean;
  378.    N, i, Err, j, m: Integer;
  379.    MyFile: TextFile;
  380.    Check: String;
  381. const
  382.    Digit: set of Char = ['1'..'9', '0', ' ', '-'];
  383. begin
  384.    IsValid := True;
  385.    N := Length(OpenDialog1.FileName);
  386.    if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x')
  387.    and (OpenDialog1.FileName[N - 2] = 't') then
  388.    begin
  389.       AssignFile(MyFile, OpenDialog1.FileName);
  390.       Reset(MyFile);
  391.       Read(MyFile, Check);
  392.       CloseFile(MyFile);
  393.       if Length(Check) = 0 then
  394.       begin
  395.          MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
  396.          IsValid := False;
  397.       end
  398.       else
  399.       begin
  400.          AssignFile(MyFile, OpenDialog1.FileName);
  401.          Reset(MyFile);
  402.          try
  403.             Readln(MyFile, N);
  404.          except
  405.             IsValid := False;
  406.             MessageDlg('Кол-во вершин должно быть натуральным от 2 до 10', mtWarning, [mbOK], 0);
  407.          end;
  408.          if (IsValid) and ((N < MIN_SIZE) or (N > MAX_SIZE)) then
  409.          begin
  410.             IsValid := False;
  411.             MessageDlg('Кол-во вершин должно быть натуральным от 2 до 10', mtError, [mbOK], 0);
  412.          end;
  413.          if IsValid then
  414.          for i := 0 to n - 1 do
  415.          if IsValid then
  416.             for j := 0 to n - 1 do
  417.             begin
  418.                try
  419.                   Read(MyFile, m);
  420.                   if (m <> 0) and (m <> 1) then
  421.                      begin
  422.                         IsValid := False;
  423.                         MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
  424.                         break
  425.                      end;
  426.                except
  427.                   IsValid := False;
  428.                   MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
  429.                end;
  430.             end;
  431.          if IsValid then
  432.          for i := 0 to n - 1 do
  433.          if IsValid then
  434.             for j := 0 to n - 1 do
  435.             begin
  436.                try
  437.                   Read(MyFile, m);
  438.                   if (m <> 0) and (m <> 1) then
  439.                      begin
  440.                         IsValid := False;
  441.                         MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
  442.                         break;
  443.                      end;
  444.                except
  445.                   IsValid := False;
  446.                   MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
  447.                end;
  448.             end;
  449.          CloseFile(MyFile);
  450.       end;
  451.    end
  452.    else
  453.    begin
  454.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  455.       IsValid := False;
  456.    end;
  457.    if not(IsValid) then
  458.       CanClose := False;
  459. end;
  460.  
  461. procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  462. var
  463.    N: Integer;
  464. begin
  465.    N := Length(SaveDialog1.FileName);
  466.    if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x')
  467.    and (SaveDialog1.FileName[N - 2] = 't') then
  468.       CanClose := True
  469.    else
  470.    begin
  471.       CanClose := False;
  472.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  473.    end;
  474. end;
  475.  
  476. procedure TForm1.StartClick(Sender: TObject);
  477. var
  478.    Err, i, j, Radius: Integer;
  479. begin
  480.    Val(SizeEdit.Text, n, Err);
  481.    if (N < MIN_SIZE) or (N > MAX_SIZE)  then
  482.       MessageDlg('Введите кол-во вершин в указанном диапазоне', mtError, [mbOK], 0)
  483.    else
  484.    begin
  485.       SaveButton.Enabled := False;
  486.       Matrix1.RowCount := n;
  487.       Matrix1.ColCount := n;
  488.       Matrix1.Width := Matrix1.DefaultColWidth * n + (n * 3);
  489.       Matrix1.Height := Matrix1.DefaultRowHeight * n + (n * 3);
  490.       Matrix2.RowCount := n;
  491.       Matrix2.ColCount := n;
  492.       Matrix2.Width := Matrix2.DefaultColWidth * n + (n * 3);
  493.       Matrix2.Height := Matrix2.DefaultRowHeight * n + (n * 3);
  494.       for i := 0 to n - 1 do
  495.          for j := 0 to n - 1 do
  496.             Matrix1.Cells[i, j] := '0';
  497.       for i := 0 to n - 1 do
  498.          for j := 0 to n - 1 do
  499.             Matrix2.Cells[i, j] := '0';
  500.       Matrix1.Visible := True;
  501.       Matrix1Label.Visible := True;
  502.       Matrix2.Visible := True;
  503.       Matrix2Label.Visible := True;
  504.       PatBlt(Form1.Canvas.Handle, 0, 470, Form1.ClientWidth, Form1.ClientHeight, PATCOPY);
  505.       for i := 1 to n do
  506.       begin
  507.          TLabel(FindComponent('Label' + IntToStr(i))).Visible := True;
  508.          TLabel(FindComponent('Label' + IntToStr(i + 10))).Visible := True;
  509.          TLabel(FindComponent('Label' + IntToStr(i + 20))).Visible := True;
  510.          TLabel(FindComponent('Label' + IntToStr(i + 30))).Visible := True;
  511.          Radius := 5;
  512.          Canvas.Pen.Color := clRed;
  513.          Canvas.Pen.Width := 2;
  514.          Canvas.Ellipse(TLabel(FindComponent('Label' + IntToStr(i + 40))).Left - TLabel(FindComponent('Label' + IntToStr(i + 40))).Width,
  515.          TLabel(FindComponent('Label' + IntToStr(i + 40))).Top - TLabel(FindComponent('Label' + IntToStr(i + 40))).Height + Radius,
  516.          TLabel(FindComponent('Label' + IntToStr(i + 40))).Left + TLabel(FindComponent('Label' + IntToStr(i + 40))).Width + Radius,
  517.          TLabel(FindComponent('Label' + IntToStr(i + 40))).Top + TLabel(FindComponent('Label' + IntToStr(i + 40))).Height+ Radius);
  518.          Canvas.TextOut(TLabel(FindComponent('Label' + IntToStr(i + 40))).Left,
  519.          TLabel(FindComponent('Label' + IntToStr(i + 40))).Top,
  520.          IntToStr(i));
  521.          Canvas.Ellipse(TLabel(FindComponent('Label' + IntToStr(i + 50))).Left - TLabel(FindComponent('Label' + IntToStr(i + 50))).Width,
  522.          TLabel(FindComponent('Label' + IntToStr(i + 50))).Top - TLabel(FindComponent('Label' + IntToStr(i + 50))).Height + Radius,
  523.          TLabel(FindComponent('Label' + IntToStr(i + 50))).Left + TLabel(FindComponent('Label' + IntToStr(i + 50))).Width + Radius,
  524.          TLabel(FindComponent('Label' + IntToStr(i + 50))).Top + TLabel(FindComponent('Label' + IntToStr(i + 50))).Height+ Radius);
  525.          Canvas.TextOut(TLabel(FindComponent('Label' + IntToStr(i + 50))).Left,
  526.          TLabel(FindComponent('Label' + IntToStr(i + 50))).Top,
  527.          IntToStr(i));
  528.       end;
  529.       Check.Visible := True;
  530.    end;
  531. end;
  532.  
  533. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement