unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Grids;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    LSize: TLabel;
    ESize: TEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Arr: TStringGrid;
    SetSize: TButton;
    Start: TButton;
    LAns: TLabel;
    Label3: TLabel;
    procedure N2Click(Sender: TObject);
    procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
    procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
    procedure SetSizeClick(Sender: TObject);
    procedure ESizeChange(Sender: TObject);
    procedure ESizeKeyPress(Sender: TObject; var Key: Char);
    procedure StartClick(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ArrKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMatrix = array of array of Real;
  function CalcOpr(Size: Integer; Matrix: TMatrix; Det: Real): Real;

var
  Form1: TForm1;
  Size: Integer;
  IsValid, GlobalFlag: Boolean;
  Ans: Real;
const
   MIN_SIZE = 2;
   MAX_SIZE = 8;

implementation

{$R *.dfm}

procedure TForm1.ArrKeyPress(Sender: TObject; var Key: Char);
const
   Digit: set of Char = ['0'..'9', #8, '-'];
var
   i, j, k: Integer;
   Flag: Boolean;
begin
   with (Sender as TStringGrid) do
   begin
      N4.Enabled := False;
      Flag := False;
      k := 0;
      if not(Key in Digit) then
         Key := #0;
      for i := 0 to Arr.RowCount - 1 do
         for j := 0 to Arr.ColCount - 1 do
            if Length(Arr.Cells[j, i]) <> 0 then
               Inc(k);
      if (k + 1 = (Size) * (Size)) or (k = Size * Size) then
         Flag := True
      else
         Flag := False;
   Start.Enabled := Flag;
   LAns.Visible := False;
   Label3.Caption := '';
   end;
end;

procedure TForm1.SetSizeClick(Sender: TObject);
var
   ErrMsg: String;
   Err: Integer;
begin
   ErrMsg := 'Кол-во вершин должно лежать в промежутке ' + IntToStr(MIN_SIZE) + '..' + IntToStr(MAX_SIZE);
   val(ESize.Text, Size, Err);
   if (Size < MIN_SIZE) or (Size > MAX_SIZE) then
      MessageDlg(ErrMsg, mtError, [mbOK], 0)
   else
   begin
      Start.Enabled := False;
      Size := StrToInt(ESize.Text);
      Arr.ColCount := Size;
      if Size = 2 then
      begin
         Arr.DefaultColWidth := 50;
         Arr.Width := (Arr.DefaultColWidth + 6) * Size;
         Arr.RowCount := Size;
         Arr.DefaultRowHeight := 20;
         Arr.Height := (Arr.DefaultRowHeight + 6) * Size;
      end
      else
      begin
         Arr.DefaultColWidth := 50;
         Arr.Width := (Arr.DefaultColWidth + 2) * Size;
         Arr.RowCount := Size;
         Arr.DefaultRowHeight := 20;
         Arr.Height := (Arr.DefaultRowHeight + 2) * Size;
      end;
      Arr.Visible := True;
      Start.Visible := True;
      Label3.Visible := True;
   end;
end;

function CalcZnak(ColPer: Integer): Integer;
begin
   if ColPer mod 2 = 0 then
      CalcZnak := 1
   else
      CalcZnak := -1;
end;

procedure Per(k, n: Integer; Matrix: TMatrix; ColPer: Integer);
var
   j, i: Integer;
   z: Real;
begin
   z := abs(Matrix[k, k]);
   i := k;
   ColPer := 0;
   for j := k + 1 to n - 1 do
      if abs(Matrix[j, k]) > z then
      begin
         z := abs(Matrix[j, k]);
         i := j;
      end;
   if i > k then
   begin
      Inc(ColPer);
      for j := k to n - 1 do
      begin
         z := Matrix[i, j];
         Matrix[i, j] := Matrix[k, j];
         Matrix[k, j] := z;
      end;
   end;
end;

function CalcOpr(Size: Integer; Matrix: TMatrix; Det: Real): Real;
var
   k, i, j, ColPer: Integer;
   r: Real;
   Flag: Boolean;
begin
   Flag := False;
   Det := 1.0;
   for i := 0 to Size - 1 do
   if not Flag then
   begin
      if Matrix[i, i] = 0 then
         Per(i, Size, Matrix, ColPer);
      Det := CalcZnak(ColPer) * Det * Matrix[i, i];
      for j := i + 1 to Size - 1 do
      begin
         if Matrix[i][i] = 0 then
         begin
            Flag := True;
            break;
         end;
         r := Matrix[j, i] / Matrix[i, i];
         for k := i to Size - 1 do
            Matrix[j, k] := Matrix[j, k] - r * Matrix[i, k];
         end;
   end;
   if not Flag then
      CalcOpr := Det
   else
      MessageDlg('Невозможно вычислить определитель', mtError, [mbOK], 0);
end;

procedure TForm1.StartClick(Sender: TObject);
var
   Matrix: TMatrix;
   i, j: Integer;
   Flag: Boolean;
begin
   Flag := True;
   for i := 0 to Size - 1 do
      if Flag then
         for j := 0 to Size - 1 do
            if Flag then
               if (Arr.Cells[i, j] = '-') or (Arr.Cells[i, j] = '') then
                  Flag := False;
   if not Flag then
      MessageDlg('Заполните матрицу корректно', mtError, [mbOK], 0)
   else
   begin
      SetLength(Matrix, Size, Size);
      for i := 0 to Size - 1 do
         for j := 0 to Size - 1 do
            Matrix[i, j] := StrToInt(Arr.Cells[j, i]);
      Ans := CalcOpr(Size, Matrix, 0);
      LAns.Visible := True;
      Label3.Caption := FloatToStrF(Ans, ffFixed, 5, 0);
      N4.Enabled := True;
   end;
end;

procedure TForm1.ESizeChange(Sender: TObject);
var
   IsValid: Boolean;
   i: Integer;
begin
   Arr.Visible := False;
   Start.Visible := False;
   LAns.Visible := False;
   Label3.Visible := False;
   N4.Enabled := False;
   Label3.Caption := '';
   with Arr do
      for i := 0 to Size do
         Cols[i].Clear;
   if ESize.Text <> '' then
      IsValid := True;
   SetSize.Enabled := IsValid;
end;

procedure TForm1.ESizeKeyPress(Sender: TObject; var Key: Char);
const
   Digit: set of Char = ['1'..'9', '0', #8];
begin
   with (Sender as TEdit) do
   begin
      if not(Key in Digit) then
         Key := #0;
   end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
      #10#13 + 'Все несохраненные данные будут утеряны.',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;

procedure TForm1.N2Click(Sender: TObject);
var
   Task: String;
begin
   Task := 'Данная программа считает определитель матрицы' + #10#13;
   Task := Task + 'Автор - Пестунов Илья, гр. 051007';
   MessageDlg(Task, mtInformation, [mbOK], 0);
end;

procedure TForm1.N3Click(Sender: TObject);
var
   MyFile: TextFile;
   i, Value, j: Integer;
begin
   ESize.Text := '';
   Arr.Visible := False;
   Start.Enabled := True;
   with Arr do
      for i := 0 to Size do
         Cols[i].Clear;
   if OpenDialog1.Execute then
   begin
      AssignFile(MyFile, OpenDialog1.FileName);
      Reset(MyFile);
      Read(MyFile, Size);
      ESize.Text := IntToStr(Size);
      Arr.ColCount := Size;
      if Size = 2 then
      begin
         Arr.Width := (Arr.DefaultColWidth + 6) * (Size);
         Arr.RowCount := Size;
         Arr.DefaultRowHeight := 20;
         Arr.Height := (Arr.DefaultRowHeight + 6) * Size;
      end
      else
      begin
         Arr.DefaultColWidth := 50;
         Arr.Width := (Arr.DefaultColWidth + 2) * (Size);
         Arr.RowCount := Size;
         Arr.DefaultRowHeight := 20;
         Arr.Height := (Arr.DefaultRowHeight + 2) * Size;
      end;
      for i := 0 to (Size - 1) do
         for j := 0 to Size - 1 do
         begin
            Read(MyFile, Value);
            Arr.Cells[j, i] := IntToStr(Value);
         end;
      CloseFile(MyFile);
      Arr.Visible := True;
      Start.Visible := True;
      LAns.Visible := False;
      Label3.Visible := True;
   end;
end;

procedure TForm1.N4Click(Sender: TObject);
var
   MyFile: TextFile;
   i, j: Integer;
begin
   if SaveDialog1.Execute then
   begin
      AssignFile(MyFile, SaveDialog1.FileName);
      Rewrite(MyFile);
      Writeln(MyFile, 'Размер матрицы: ', Size);
      Writeln(MyFile, 'Матрица: ');
      for i := 0 to Arr.RowCount do
      begin
         for j := 0 to Arr.ColCount do
         begin
            Write(MyFile, Arr.Cells[j, i], ' ');
         end;
         Writeln(MyFile);
      end;
      Write(MyFile, 'Определитель : ', Trunc(Ans));
      CloseFile(MyFile);
      MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
   end;
end;

procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
var
   IsValid: Boolean;
   N, i, Value, Err, j: Integer;
   MyFile: TextFile;
   Check: String;
const
   Digit: set of Char = ['1'..'9', '0', ' ', '-'];
begin
   IsValid := True;
   N := Length(OpenDialog1.FileName);
   if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x') and (OpenDialog1.FileName[N - 2] = 't') then
   begin
      AssignFile(MyFile, OpenDialog1.FileName);
      Reset(MyFile);
      Read(MyFile, Check);
      CloseFile(MyFile);
      if Length(Check) = 0 then
      begin
         MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
         IsValid := False;
      end
      else
      begin
         AssignFile(MyFile, OpenDialog1.FileName);
         Reset(MyFile);
         try
            Readln(MyFile, Size);
         except
            IsValid := False;
            MessageDlg('Порядок матрицы должен быть натуральным числом до 8', mtWarning, [mbOK], 0);
         end;
         if ((IsValid) and (Size < 2)) or ((IsValid) and (Size > MAX_SIZE)) then
         begin
            IsValid := False;
            MessageDlg('Порядок матрицы должна быть натуральным числом до 8', mtError, [mbOK], 0);
         end;
         if IsValid then
         begin
            for j := 1 to Size do
            begin
               Read(MyFile, Check);
               i := 1;
               while (IsValid) and (i <= Length(Check)) do
               begin
                  if not(Check[i] in Digit) then
                  begin
                     IsValid := False;
                     MessageDlg('Элементами матрицы должны быть числа', mtWarning, [mbOK], 0);
                  end;
                  Inc(i);
               end;
            end;
            Read(MyFile, Check);
               i := 1;
               while (IsValid) and (i <= Length(Check)) do
               begin
                  if not(Check[i] in Digit) then
                  begin
                     IsValid := False;
                     MessageDlg('Элементами массива должны быть числа', mtWarning, [mbOK], 0);
                  end;
                  Inc(i);
               end;
         end;
         CloseFile(MyFile);
      end;
   end
   else
   begin
      MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
      IsValid := False;
   end;
   if not(IsValid) then
      CanClose := False;
end;

procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
var
   N: Integer;
begin
   N := Length(SaveDialog1.FileName);
   if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x') and (SaveDialog1.FileName[N - 2] = 't') then
      CanClose := True
   else
   begin
      CanClose := False;
      MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
   end;
end;

end.