Advertisement
MadCortez

Untitled

Mar 23rd, 2021
371
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 11.95 KB | None | 0 0
  1. unit Unit1;
  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.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     N1: TMenuItem;
  13.     N2: TMenuItem;
  14.     N3: TMenuItem;
  15.     N4: TMenuItem;
  16.     Label1: TLabel;
  17.     Edit1: TEdit;
  18.     OpenDialog1: TOpenDialog;
  19.     SaveDialog1: TSaveDialog;
  20.     Arr: TStringGrid;
  21.     Button1: TButton;
  22.     Start: TButton;
  23.     Label2: TLabel;
  24.     Label3: TLabel;
  25.     procedure N2Click(Sender: TObject);
  26.     procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  27.     procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure Edit1Change(Sender: TObject);
  30.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  31.     procedure StartClick(Sender: TObject);
  32.     procedure N3Click(Sender: TObject);
  33.     procedure N4Click(Sender: TObject);
  34.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  35.     procedure ArrKeyPress(Sender: TObject; var Key: Char);
  36.   private
  37.     { Private declarations }
  38.   public
  39.     { Public declarations }
  40.   end;
  41.   TMatrix = array of array of Real;
  42.   function CalcOpr(Size: Integer; Matrix: TMatrix; Det: Real): Real;
  43.  
  44. var
  45.   Form1: TForm1;
  46.   Size: Integer;
  47.   IsValid, GlobalFlag: Boolean;
  48.   Ans: Real;
  49. const
  50.    MIN_SIZE = 2;
  51.    MAX_SIZE = 8;
  52.  
  53. implementation
  54.  
  55. {$R *.dfm}
  56.  
  57. procedure TForm1.ArrKeyPress(Sender: TObject; var Key: Char);
  58. const
  59.    Digit: set of Char = ['0'..'9', #8, '-'];
  60. var
  61.    i, j, k: Integer;
  62.    Flag: Boolean;
  63. begin
  64.    with (Sender as TStringGrid) do
  65.    begin
  66.       N4.Enabled := False;
  67.       Flag := False;
  68.       k := 0;
  69.       if not(Key in Digit) then
  70.          Key := #0;
  71.       for i := 0 to Arr.RowCount - 1 do
  72.          for j := 0 to Arr.ColCount - 1 do
  73.             if Length(Arr.Cells[j, i]) <> 0 then
  74.                Inc(k);
  75.       if (k + 1 = (Size) * (Size)) or (k = Size * Size) then
  76.          Flag := True
  77.       else
  78.          Flag := False;
  79.    Start.Enabled := Flag;
  80.    Label2.Visible := False;
  81.    Label3.Caption := 'Ввод данных';
  82.    end;
  83. end;
  84.  
  85. procedure TForm1.Button1Click(Sender: TObject);
  86. var
  87.    ErrMsg: String;
  88.    Err: Integer;
  89. begin
  90.    ErrMsg := 'Кол-во вершин должно лежать в промежутке ' + IntToStr(MIN_SIZE) + '..' + IntToStr(MAX_SIZE);
  91.    val(Edit1.Text, Size, Err);
  92.    if (Size < MIN_SIZE) or (Size > MAX_SIZE) then
  93.       MessageDlg(ErrMsg, mtError, [mbOK], 0)
  94.    else
  95.    begin
  96.       Start.Enabled := False;
  97.       Size := StrToInt(Edit1.Text);
  98.       Arr.ColCount := Size;
  99.       if Size = 2 then
  100.       begin
  101.          Arr.DefaultColWidth := 50;
  102.          Arr.Width := (Arr.DefaultColWidth + 6) * Size;
  103.          Arr.RowCount := Size;
  104.          Arr.DefaultRowHeight := 20;
  105.          Arr.Height := (Arr.DefaultRowHeight + 6) * Size;
  106.       end
  107.       else
  108.       begin
  109.          Arr.DefaultColWidth := 50;
  110.          Arr.Width := (Arr.DefaultColWidth + 2) * Size;
  111.          Arr.RowCount := Size;
  112.          Arr.DefaultRowHeight := 20;
  113.          Arr.Height := (Arr.DefaultRowHeight + 2) * Size;
  114.       end;
  115.       Arr.Visible := True;
  116.       Start.Visible := True;
  117.       Label3.Visible := True;
  118.    end;
  119. end;
  120.  
  121. function CalcZnak(ColPer: Integer): Integer;
  122. begin
  123.    if ColPer mod 2 = 0 then
  124.       CalcZnak := 1
  125.    else
  126.       CalcZnak := -1;
  127. end;
  128.  
  129. procedure Per(k, n: Integer; Matrix: TMatrix; ColPer: Integer);
  130. var
  131.    j, i: Integer;
  132.    z: Real;
  133. begin
  134.    z := abs(Matrix[k, k]);
  135.    i := k;
  136.    ColPer := 0;
  137.    for j := k + 1 to n - 1 do
  138.       if abs(Matrix[j, k]) > z then
  139.       begin
  140.          z := abs(Matrix[j, k]);
  141.          i := j;
  142.       end;
  143.    if i > k then
  144.    begin
  145.       Inc(ColPer);
  146.       for j := k to n - 1 do
  147.       begin
  148.          z := Matrix[i, j];
  149.          Matrix[i, j] := Matrix[k, j];
  150.          Matrix[k, j] := z;
  151.       end;
  152.    end;
  153. end;
  154.  
  155. function CalcOpr(Size: Integer; Matrix: TMatrix; Det: Real): Real;
  156. var
  157.    k, i, j, ColPer: Integer;
  158.    r: Real;
  159.    Flag: Boolean;
  160. begin
  161.    Flag := False;
  162.    Det := 1.0;
  163.    for i := 0 to Size - 1 do
  164.    if not Flag then
  165.    begin
  166.       if Matrix[i, i] = 0 then
  167.          Per(i, Size, Matrix, ColPer);
  168.       Det := CalcZnak(ColPer) * Det * Matrix[i, i];
  169.       for j := i + 1 to Size - 1 do
  170.       begin
  171.          if Matrix[i][i] = 0 then
  172.          begin
  173.             Flag := True;
  174.             break;
  175.          end;
  176.          r := Matrix[j, i] / Matrix[i, i];
  177.          for k := i to Size - 1 do
  178.             Matrix[j, k] := Matrix[j, k] - r * Matrix[i, k];
  179.          end;
  180.    end;
  181.    if not Flag then
  182.       CalcOpr := Det
  183.    else
  184.       MessageDlg('Невозможно вычислить определитель', mtError, [mbOK], 0);
  185. end;
  186.  
  187. procedure TForm1.StartClick(Sender: TObject);
  188. var
  189.    Matrix: TMatrix;
  190.    i, j: Integer;
  191.    Flag: Boolean;
  192. begin
  193.    Flag := True;
  194.    for i := 0 to Size - 1 do
  195.       if Flag then
  196.          for j := 0 to Size - 1 do
  197.             if Flag then
  198.                if (Arr.Cells[i, j] = '-') or (Arr.Cells[i, j] = '') then
  199.                   Flag := False;
  200.    if not Flag then
  201.       MessageDlg('Заполните матрицу корректно', mtError, [mbOK], 0)
  202.    else
  203.    begin
  204.       SetLength(Matrix, Size, Size);
  205.       for i := 0 to Size - 1 do
  206.          for j := 0 to Size - 1 do
  207.             Matrix[i, j] := StrToInt(Arr.Cells[j, i]);
  208.       Ans := CalcOpr(Size, Matrix, 0);
  209.       Label2.Visible := True;
  210.       Label3.Caption := FloatToStrF(Ans, ffFixed, 5, 0);
  211.       N4.Enabled := True;
  212.    end;
  213. end;
  214.  
  215. procedure TForm1.Edit1Change(Sender: TObject);
  216. var
  217.    IsValid: Boolean;
  218.    i: Integer;
  219. begin
  220.    Arr.Visible := False;
  221.    Start.Visible := False;
  222.    Label2.Visible := False;
  223.    Label3.Visible := False;
  224.    N4.Enabled := False;
  225.    Label3.Caption := 'Ввод данных';
  226.    with Arr do
  227.       for i := 0 to Size do
  228.          Cols[i].Clear;
  229.    if Edit1.Text <> '' then
  230.       IsValid := True;
  231.    Button1.Enabled := IsValid;
  232. end;
  233.  
  234. procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  235. const
  236.    Digit: set of Char = ['1'..'9', '0', #8];
  237. begin
  238.    with (Sender as TEdit) do
  239.    begin
  240.       if not(Key in Digit) then
  241.          Key := #0;
  242.    end;
  243. end;
  244.  
  245. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  246. begin
  247.    CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
  248.       #10#13 + 'Все несохраненные данные будут утеряны.',
  249.       mtConfirmation, [mbYes, mbNo], 0) = mrYes;
  250. end;
  251.  
  252. procedure TForm1.N2Click(Sender: TObject);
  253. var
  254.    Task: String;
  255. begin
  256.    Task := 'Данная программа считает определитель матрицы' + #10#13;
  257.    Task := Task + 'Автор - Пестунов Илья, гр. 051007';
  258.    MessageDlg(Task, mtInformation, [mbOK], 0);
  259. end;
  260.  
  261. procedure TForm1.N3Click(Sender: TObject);
  262. var
  263.    MyFile: TextFile;
  264.    i, Value, j: Integer;
  265. begin
  266.    Edit1.Text := '';
  267.    Arr.Visible := False;
  268.    Start.Enabled := True;
  269.    with Arr do
  270.       for i := 0 to Size do
  271.          Cols[i].Clear;
  272.    if OpenDialog1.Execute then
  273.    begin
  274.       AssignFile(MyFile, OpenDialog1.FileName);
  275.       Reset(MyFile);
  276.       Read(MyFile, Size);
  277.       Edit1.Text := IntToStr(Size);
  278.       Arr.ColCount := Size;
  279.       if Size = 2 then
  280.       begin
  281.          Arr.Width := (Arr.DefaultColWidth + 6) * (Size);
  282.          Arr.RowCount := Size;
  283.          Arr.DefaultRowHeight := 20;
  284.          Arr.Height := (Arr.DefaultRowHeight + 6) * Size;
  285.       end
  286.       else
  287.       begin
  288.          Arr.DefaultColWidth := 50;
  289.          Arr.Width := (Arr.DefaultColWidth + 2) * (Size);
  290.          Arr.RowCount := Size;
  291.          Arr.DefaultRowHeight := 20;
  292.          Arr.Height := (Arr.DefaultRowHeight + 2) * Size;
  293.       end;
  294.       for i := 0 to (Size - 1) do
  295.          for j := 0 to Size - 1 do
  296.          begin
  297.             Read(MyFile, Value);
  298.             Arr.Cells[j, i] := IntToStr(Value);
  299.          end;
  300.       CloseFile(MyFile);
  301.       Arr.Visible := True;
  302.       Start.Visible := True;
  303.       Label2.Visible := False;
  304.       Label3.Visible := True;
  305.    end;
  306. end;
  307.  
  308. procedure TForm1.N4Click(Sender: TObject);
  309. var
  310.    MyFile: TextFile;
  311.    i, j: Integer;
  312. begin
  313.    if SaveDialog1.Execute then
  314.    begin
  315.       AssignFile(MyFile, SaveDialog1.FileName);
  316.       Rewrite(MyFile);
  317.       Writeln(MyFile, 'Размер матрицы: ', Size);
  318.       Writeln(MyFile, 'Матрица: ');
  319.       for i := 0 to Arr.RowCount do
  320.       begin
  321.          for j := 0 to Arr.ColCount do
  322.          begin
  323.             Write(MyFile, Arr.Cells[j, i], ' ');
  324.          end;
  325.          Writeln(MyFile);
  326.       end;
  327.       Write(MyFile, 'Определитель : ', Trunc(Ans));
  328.       CloseFile(MyFile);
  329.       MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
  330.    end;
  331. end;
  332.  
  333. procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  334. var
  335.    IsValid: Boolean;
  336.    N, i, Value, Err, j: Integer;
  337.    MyFile: TextFile;
  338.    Check: String;
  339. const
  340.    Digit: set of Char = ['1'..'9', '0', ' ', '-'];
  341. begin
  342.    IsValid := True;
  343.    N := Length(OpenDialog1.FileName);
  344.    if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x') and (OpenDialog1.FileName[N - 2] = 't') then
  345.    begin
  346.       AssignFile(MyFile, OpenDialog1.FileName);
  347.       Reset(MyFile);
  348.       Read(MyFile, Check);
  349.       CloseFile(MyFile);
  350.       if Length(Check) = 0 then
  351.       begin
  352.          MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
  353.          IsValid := False;
  354.       end
  355.       else
  356.       begin
  357.          AssignFile(MyFile, OpenDialog1.FileName);
  358.          Reset(MyFile);
  359.          try
  360.             Readln(MyFile, Size);
  361.          except
  362.             IsValid := False;
  363.             MessageDlg('Порядок матрицы должен быть натуральным числом до 8', mtWarning, [mbOK], 0);
  364.          end;
  365.          if ((IsValid) and (Size < 2)) or ((IsValid) and (Size > MAX_SIZE)) then
  366.          begin
  367.             IsValid := False;
  368.             MessageDlg('Порядок матрицы должна быть натуральным числом до 8', mtError, [mbOK], 0);
  369.          end;
  370.          if IsValid then
  371.          begin
  372.             for j := 1 to Size do
  373.             begin
  374.                Read(MyFile, Check);
  375.                i := 1;
  376.                while (IsValid) and (i <= Length(Check)) do
  377.                begin
  378.                   if not(Check[i] in Digit) then
  379.                   begin
  380.                      IsValid := False;
  381.                      MessageDlg('Элементами матрицы должны быть числа', mtWarning, [mbOK], 0);
  382.                   end;
  383.                   Inc(i);
  384.                end;
  385.             end;
  386.             Read(MyFile, Check);
  387.                i := 1;
  388.                while (IsValid) and (i <= Length(Check)) do
  389.                begin
  390.                   if not(Check[i] in Digit) then
  391.                   begin
  392.                      IsValid := False;
  393.                      MessageDlg('Элементами массива должны быть числа', mtWarning, [mbOK], 0);
  394.                   end;
  395.                   Inc(i);
  396.                end;
  397.          end;
  398.          CloseFile(MyFile);
  399.       end;
  400.    end
  401.    else
  402.    begin
  403.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  404.       IsValid := False;
  405.    end;
  406.    if not(IsValid) then
  407.       CanClose := False;
  408. end;
  409.  
  410. procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  411. var
  412.    N: Integer;
  413. begin
  414.    N := Length(SaveDialog1.FileName);
  415.    if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x') and (SaveDialog1.FileName[N - 2] = 't') then
  416.       CanClose := True
  417.    else
  418.    begin
  419.       CanClose := False;
  420.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  421.    end;
  422. end;
  423.  
  424. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement