SHARE
TWEET

Untitled

a guest Feb 27th, 2020 70 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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.StdCtrls, Vcl.Grids, Vcl.Menus;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     PopupMenu1: TPopupMenu;
  12.     MainMenu1: TMainMenu;
  13.     OpenDialog1: TOpenDialog;
  14.     SaveDialog1: TSaveDialog;
  15.     N1: TMenuItem;
  16.     N2: TMenuItem;
  17.     AboutProgram: TMenuItem;
  18.     AboutMe: TMenuItem;
  19.     OpenFileMenu: TMenuItem;
  20.     SaveFileMenu: TMenuItem;
  21.     N7: TMenuItem;
  22.     CloseFormMenu: TMenuItem;
  23.     MatrixOnForm: TStringGrid;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     MatrixSize: TEdit;
  27.     ResultButton: TButton;
  28.     ResultLabel: TEdit;
  29.     Label3: TLabel;
  30.     procedure CloseFormMenuClick(Sender: TObject);
  31.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  32.     procedure AboutMeClick(Sender: TObject);
  33.     procedure AboutProgramClick(Sender: TObject);
  34.     procedure OpenFileMenuClick(Sender: TObject);
  35.     procedure SaveFileMenuClick(Sender: TObject);
  36.     procedure MatrixSizeKeyDown(Sender: TObject; var Key: Word;
  37.       Shift: TShiftState);
  38.     procedure MatrixSizeKeyPress(Sender: TObject; var Key: Char);
  39.     procedure MatrixOnFormKeyDown(Sender: TObject; var Key: Word;
  40.       Shift: TShiftState);
  41.     procedure MatrixOnFormKeyPress(Sender: TObject; var Key: Char);
  42.     procedure MatrixSizeChange(Sender: TObject);
  43.     procedure MatrixOnFormClick(Sender: TObject);
  44.     procedure ResultButtonClick(Sender: TObject);
  45.     procedure ResultLabelChange(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.   public
  49.     { Public declarations }
  50.   end;
  51.  
  52. var
  53.   MainForm: TMainForm;
  54.  
  55. type
  56.    TMatrix =  array of array of Integer;
  57.  
  58. implementation
  59.  
  60. {$R *.dfm}
  61.  
  62.  
  63. function FileExtensionChek(var NameOfFile: String): Boolean;
  64. var
  65.    Extension: String;
  66.    i, j: Integer;
  67. begin
  68.    if(pos('.',NameOfFile) = 0)then
  69.    begin
  70.       ShowMessage('Так как во введённом имени файла не указано расширение, автоматически присвоено расширение ".txt".');
  71.       NameOfFile := NameOfFile + '.txt';
  72.       FileExtensionChek := True;
  73.    end
  74.    else
  75.    begin
  76.       Extension := '';
  77.       j := length(NameOfFile);
  78.       for i := pos('.',NameOfFile) to j do
  79.          Extension := Extension + NameOfFile[i];
  80.       if (Extension <> '.txt') and (Extension <> '.doc') and (Extension <> '.text') then
  81.       begin
  82.          ShowMessage('Внимание, произошла ошибка! Файл с данным расширением не может быть использован. Программа поддерживает расширения : ".txt", ".doc", ".text".');
  83.          FileExtensionChek := False;
  84.       end
  85.       else
  86.          FileExtensionChek := True;
  87.    end;
  88. end;
  89.  
  90. procedure TMainForm.AboutMeClick(Sender: TObject);
  91. begin
  92.    Application.MessageBox('Данная программа разработана студентом группы 951007 Королёнком К.А.', 'Справка', MB_OK + MB_ICONINFORMATION)
  93. end;
  94.  
  95. procedure TMainForm.AboutProgramClick(Sender: TObject);
  96. begin
  97.    Application.MessageBox('Данная программа находит определитель матрицы.', 'Справка', MB_OK + MB_ICONINFORMATION)
  98. end;
  99.  
  100. procedure TMainForm.CloseFormMenuClick(Sender: TObject);
  101. begin
  102.    Close;
  103. end;
  104.  
  105. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  106. begin
  107.     case Application.MessageBox('Вы уверены, что хотите выйти из программы?', 'Выход', MB_YESNO) of ID_YES: ;
  108.       else
  109.          CanClose := False;
  110.    end;
  111. end;
  112.  
  113.  
  114.  
  115. procedure TMainForm.MatrixOnFormClick(Sender: TObject);
  116. var
  117.    NCol, NRow: Integer;
  118.    Correct: Boolean;
  119. begin
  120.    ResultLabel.Text := '';
  121.    Correct := True;
  122.    if MatrixSize.Text = '' then
  123.       Correct := False;
  124.    if Correct then
  125.    begin
  126.       if (StrToInt(MatrixSize.Text) < 21) and (StrToInt(MatrixSize.Text) > 1) then
  127.       begin
  128.          MatrixOnForm.ColCount := StrToInt(MatrixSize.Text);
  129.          MatrixOnForm.RowCount := StrToInt(MatrixSize.Text);
  130.          MatrixOnForm.EditorMode := True;
  131.          MatrixOnForm.Options:= MatrixOnForm.Options + [goEditing] + [goTabs];
  132.       end
  133.       else
  134.          Application.MessageBox('Ошибка! Указан недопустимый размер матрицы.','Ошибка', MB_OK + MB_ICONSTOP);
  135.    end
  136.    else
  137.       Application.MessageBox('Ошибка! Не указан размер матрицы.','Ошибка', MB_OK + MB_ICONSTOP);
  138. end;
  139.  
  140. procedure TMainForm.MatrixOnFormKeyDown(Sender: TObject; var Key: Word;
  141.   Shift: TShiftState);
  142. begin
  143.    if (Key = VK_INSERT) then Key:= 0;
  144. end;
  145.  
  146.  
  147.  
  148.  
  149. procedure TMainForm.MatrixOnFormKeyPress(Sender: TObject; var Key: Char);
  150. begin
  151.    if not (Key in ['0'..'9', #8])then Key := #0;
  152. end;
  153.  
  154. procedure TMainForm.MatrixSizeChange(Sender: TObject);
  155. var
  156.    i: Integer;
  157. begin
  158.    if (Sender as TEdit).Text <> '' then
  159.       ResultButton.Enabled := True
  160.    else
  161.       ResultButton.Enabled := False;
  162.    with MatrixOnForm do
  163.       for i := 0 to MatrixOnForm.RowCount do
  164.       begin
  165.          Rows[i].Clear;
  166.          MatrixOnForm.RowCount := 2;
  167.          MatrixOnForm.ColCount := 2;
  168.       end;
  169.    ResultLabel.Text := '';
  170. end;
  171.  
  172.  
  173.  
  174.  
  175. procedure TMainForm.MatrixSizeKeyDown(Sender: TObject; var Key: Word;
  176.   Shift: TShiftState);
  177. begin
  178.     if (Key = VK_INSERT) then Key:= 0;
  179. end;
  180.  
  181. procedure TMainForm.MatrixSizeKeyPress(Sender: TObject; var Key: Char);
  182. begin
  183.    if not (Key in ['0'..'9', #8])then Key := #0;
  184. end;
  185.  
  186.  
  187.  
  188.  
  189. procedure TMainForm.OpenFileMenuClick(Sender: TObject);
  190. var
  191.    FileF: TextFile;
  192.    FileData, FileName: String;
  193.    IsInvalidInput: Boolean;
  194.    NCol, NRow: Integer;
  195. begin
  196.    with MatrixOnForm do
  197.       for NRow := 0 to MatrixOnForm.RowCount do
  198.       begin
  199.          Rows[NRow].Clear;
  200.          MatrixOnForm.RowCount := 2;
  201.          MatrixOnForm.ColCount := 2;
  202.       end;
  203.    ResultLabel.Text := '';
  204.    MatrixSize.Text := '';
  205.    if OpenDialog1.Execute then
  206.    begin
  207.       FileName := OpenDialog1.FileName;
  208.       IsInvalidInput := True;
  209.       IsInvalidInput := FileExtensionChek(FileName);
  210.       if FileExists(FileName) and IsInvalidInput then
  211.       begin
  212.          AssignFile(FileF, FileName);
  213.          Reset(FileF);
  214.          if EoF(FileF) then
  215.             Application.MessageBox('Ошибка! Данный файл является пустым.','Ошибка', MB_OK + MB_ICONSTOP)
  216.          else
  217.          begin
  218.             Readln(FileF, FileData);
  219.             MatrixSize.Text := FileData;
  220.             if (StrToInt(MatrixSize.Text) < 21) and (StrToInt(MatrixSize.Text) > 1) then
  221.             begin
  222.                MatrixOnForm.ColCount := StrToInt(MatrixSize.Text);
  223.                MatrixOnForm.RowCount := StrToInt(MatrixSize.Text);
  224.                MatrixOnForm.EditorMode := True;
  225.                MatrixOnForm.Options:= MatrixOnForm.Options + [goEditing] + [goTabs];
  226.             end
  227.             else
  228.                Application.MessageBox('Ошибка! Указана недопустимый размер матрицы.','Ошибка', MB_OK + MB_ICONSTOP);
  229.             for NCol := 0 to MatrixOnForm.ColCount do
  230.                for NRow := 0 to MatrixOnForm.ColCount do
  231.                begin
  232.                   ReadLn(FileF, FileData);
  233.                   MatrixOnForm.Cells[NRow, NCol] := FileData;
  234.                end;
  235.          end;
  236.          CloseFile(FileF);
  237.       end
  238.       else if IsInvalidInput then
  239.          Application.MessageBox('Ошибка! Данный файл не найден.','Ошибка', MB_OK + MB_ICONSTOP);
  240.    end;
  241. end;
  242.  
  243.  
  244.  
  245. function MatrixWithoutRowAndCol(Matrix: TMatrix; Row, Col: Integer): TMatrix;
  246. var
  247.    OffRow, OffCol: Integer;
  248.    Size: Integer;
  249.    i, j: Integer;
  250.    NewMatrix: TMatrix;
  251. begin
  252.    OffRow := 0;
  253.    OffCol := 0;
  254.    Size := Length(Matrix) - 1;
  255.    SetLength(NewMatrix, Size, Size);
  256.    for i := 0  to Size - 1 do
  257.    begin
  258.       if(i = Row) then
  259.          OffRow := 1;
  260.       OffCol := 0;
  261.       for j := 0  to Size - 1 do
  262.       begin
  263.          if(j = Col) then
  264.             OffCol := 1;
  265.          NewMatrix[i][j] := Matrix[i + OffRow][j + OffCol];
  266.       end;
  267.    end;
  268.    MatrixWithoutRowAndCol := NewMatrix;
  269. end;
  270.  
  271.  
  272. function MatrixDet(Matrix: TMatrix): Integer;
  273. var
  274.    Det: Integer;
  275.    Degree: Integer;
  276.    Size: Integer;
  277.    i, j: Integer;
  278.    NewMatrix: TMatrix;
  279. begin
  280.    Det := 0;
  281.    Degree := 1;
  282.    Size := Length(Matrix);
  283.    if (Size = 2) then
  284.       Det := Matrix[0][0]*Matrix[1][1] - Matrix[1][0]*Matrix[0][1]
  285.    else
  286.    begin
  287.       SetLength(NewMatrix, Size - 1, Size - 1);
  288.       for i := 0 to High(Matrix) do
  289.       begin
  290.          for j := 0 to High(Matrix) do
  291.          begin
  292.             NewMatrix := MatrixWithoutRowAndCol(Matrix, 0, j);
  293.             Det := Det + Degree * (Matrix[0][j] * MatrixDet(NewMatrix));
  294.             Degree := (-1) * Degree;
  295.          end;
  296.       end;
  297.    end;
  298.    MatrixDet := Det;
  299. end;
  300.  
  301.  
  302.  
  303. procedure TMainForm.ResultButtonClick(Sender: TObject);
  304. var
  305.    Matrix: TMatrix;
  306.    IsCorrect: Boolean;
  307.    j, i: Integer;
  308.    Det: Integer;
  309. begin
  310.    IsCorrect := True;
  311.    for i := 0 to MatrixOnForm.RowCount - 1 do
  312.       for j := 0 to MatrixOnForm.ColCount - 1 do
  313.          if (MatrixOnForm.Cells[i, j] = '') then
  314.             IsCorrect := False;
  315.    if (IsCorrect = False) then
  316.       Application.MessageBox('Ошибка! Есть пустые окна!','Ошибка', MB_OK + MB_ICONSTOP)
  317.    else
  318.    begin
  319.       SetLength(Matrix, StrToInt(MatrixSize.Text), StrToInt(MatrixSize.Text));
  320.       for i := 0 to MatrixOnForm.RowCount - 1 do
  321.          for j := 0 to MatrixOnForm.ColCount - 1 do
  322.             Matrix[i, j] := StrToInt(MatrixOnForm.Cells[j, i]);
  323.       Det := MatrixDet(Matrix);
  324.       ResultLabel.Text := IntToStr(Det);
  325.    end;
  326.  
  327. end;
  328.  
  329.  
  330.  
  331.  
  332. procedure TMainForm.ResultLabelChange(Sender: TObject);
  333. begin
  334.    if (ResultLabel.Text <> '') then
  335.       SaveFileMenu.Enabled := True
  336.    else
  337.       SaveFileMenu.Enabled := False
  338. end;
  339.  
  340. procedure TMainForm.SaveFileMenuClick(Sender: TObject);
  341. var
  342.    FileF: TextFile;
  343.    FileName: String;
  344.    IsInvalidInput: Boolean;
  345. begin
  346.    if SaveDialog1.Execute then
  347.    begin
  348.       FileName := SaveDialog1.FileName;
  349.       IsInvalidInput := True;
  350.       IsInvalidInput := FileExtensionChek(FileName);
  351.       if FileExists(FileName) and IsInvalidInput then
  352.       begin
  353.          AssignFile(FileF, SaveDialog1.FileName);
  354.          Rewrite(FileF);
  355.          Write(FileF,'Определитель матрицы :');
  356.          Write(FileF, ResultLabel.Text);
  357.          CloseFile(FileF);
  358.       end
  359.       else
  360.           Application.MessageBox('Ошибка! Данный файл не найден.','Ошибка', MB_OK + MB_ICONSTOP);
  361.    end;
  362. end;
  363.  
  364. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top