форма32

Unit form23;

Interface

Uses
    Math,
    Vcl.ExtDlgs,
    Vcl.Dialogs,
    Vcl.Menus,
    Vcl.StdCtrls,
    Vcl.Controls,
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Forms,
    Unit23_1,
    Unit23_2,
    Vcl.ComCtrls,
    Vcl.Grids;

Type
    TErrorCode = (EcCorrect, EcInvalid_Value, EcInvalid_Range, EcNot_Readable, EcNot_Writeable, EcIncorrect_Amount_lines);
    Type
 TArr = Array Of Array Of Array Of Integer;
    TMainForm = Class(TForm)
        MainMenu: TMainMenu;
        FileMenu: TMenuItem;
        OpenMenu: TMenuItem;
        SaveMenu: TMenuItem;
        ExitMenu: TMenuItem;
        InstructionMenu: TMenuItem;
        DeveloperMenu: TMenuItem;
        TaskLabel: TLabel;
        NEdit: TEdit;
        ResultButton: TButton;
        ResultEdit: TEdit;
        MyOpenTextFileDialog: TOpenTextFileDialog;
        MySaveTextFileDialog: TSaveTextFileDialog;
        RLabel: TLabel;
        XGrid: TStringGrid;
        Label1: TLabel;
        PopupMenu1: TPopupMenu;
        Label2: TLabel;
    MEdit: TEdit;
    KEdit: TEdit;
    Label3: TLabel;
    Procedure NEditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
        Procedure InstructionMenuClick(Sender: TObject);
        Procedure DeveloperMenuClick(Sender: TObject);
        Procedure OpenMenuClick(Sender: TObject);
        Procedure SaveMenuClick(Sender: TObject);
        Procedure ResultButtonClick(Sender: TObject);
        Procedure ExitMenuClick(Sender: TObject);
        Procedure CalcResult(Sender: TObject);
        Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
        Function CheckInputFields(Sender: TObject; CurEdit: TEdit; CurStringGrid: TStringGrid): Boolean;
        Procedure FileMenuClick(Sender: TObject);
        Procedure CheckEdit(Sender: TObject; Var Key: Char; CurEdit: TEdit);
        Procedure SelectEdit(Sender: TObject; Var Key: Word);
        Procedure FormCreate(Sender: TObject);

       function CheckCells(CurStringGrid: TStringGrid): Boolean;
        Procedure NEditKeyPress(Sender: TObject; Var Key: Char);
        Procedure XGridSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
        Procedure NEditChange(Sender: TObject);
        Procedure GridCheck(Sender: TObject);
        Procedure XGridKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
        Procedure SelectEdit2 (Sender: TObject; Var Key: Word; CurEdit:TEdit);
        Procedure MEditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
    procedure MEditKeyPress(Sender: TObject; var Key: Char);
    procedure MEditChange(Sender: TObject);
    procedure KEditChange(Sender: TObject);
    procedure KEditKeyPress(Sender: TObject; var Key: Char);
    procedure KEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    Function EnterArr():TArr;
    procedure ColorizeColumn(StringGrid: TStringGrid; ColumnIndex: Integer; Color: TColor);
    procedure XGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    Private
        { Private declarations }
    Public
        { Public declarations }
    End;

Const
    ERRORS: Array [TErrorCode] Of String = ('', 'Некорректный тип данных внутри файла!', 'Значения не попадают в диапазон!',
        'Файл закрыт для чтения!', 'Файл закрыт для записи!', 'Неверное количество данных в файле');
    BACKSPACE = #8;
    NONE = #0;
    DIGITS = ['0' .. '9'];
    MAX_N = 10;
    MIN_N = 3;
    MAX_X = 1000;
    MIN_X = -1000;

Var
    MainForm: TMainForm;

Implementation

{$R *.dfm}

Function IsAbleToReading(Var F: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := EcCorrect;
    Try
        Reset(F);
        CloseFile(F);
    Except
        Error := EcNot_Readable;
    End;
    IsAbleToReading := Error;
End;

Function FindChar(MyText: String; MyChar: Char): Boolean;
Var
    N, I, Counter: Integer;
Begin
    N := Length(MyText);
    Counter := 0;
    For I := 1 To N Do
        If MyText[I] = MyChar Then
            Inc(Counter);
    If Counter = 0 Then
        FindChar := False
    Else
        FindChar := True;
End;

Function CheckUserArea(Num: Integer; Const MAX, MIN: Integer): Boolean;

Var
    IsCorrect: Boolean;
Begin
    If (Num < 2) Or (Num > 90) Then
    Begin
        IsCorrect := False;
    End
    Else
        IsCorrect := True;
    CheckUserArea := IsCorrect;
End;

Function CheckXArea(Num: Double; Const MAX, MIN: Real): Boolean;

Var
    IsCorrect: Boolean;
Begin
    If (Num < MIN) Or (Num > MAX) Then
    Begin
        IsCorrect := False;
    End
    Else
        IsCorrect := True;
    CheckXArea := IsCorrect;
End;

Function CheckFileData(Var F: TextFile; N, M,k1: Integer; var Error: TErrorCode):TErrorCode;
Var
 KLine: String;
 K :Real;
 numbers: TArray<string>;
  CountN, CountM, I: Integer;
Begin
 I := 0;
  CountM := 0;
 While (Error= EcCorrect)And Not EOF(F) Do
 Begin

    Try
    Read(F, KLine);
    numbers := KLine.Split([' ']);
    Except
    Error := EcInvalid_Value;
    End;
    If (Error= EcCorrect) And (Length(numbers) <> N*K1) Then
    Begin
    Error := EcIncorrect_Amount_lines;
    End;
    I:=0;
    While (Error= EcCorrect) And (I<(Length(numbers))) Do
    Begin
        Try
        K:= StrToFloat(numbers[I]);
        Except
        Error := EcInvalid_Value;
        End;
        Inc(I);
        If (Error= EcCorrect)And Not(CheckXArea(K, MAX_X, MIN_X)) Then
        Error := EcInvalid_Range;
    End;

    Inc(CountM);
    Readln(F);
 End;
 If(Error= EcCorrect)And( CountM <> M) Then
    Begin
    Error := EcIncorrect_Amount_lines;
    End;
 CloseFile(F);
 CheckFileData := Error;
End;

Function CheckFileData1(Var F: TextFile): TErrorCode;
Var
    FLine: String;
    I, N,M,J,k1: Integer;
    K, S: Double;
    Error: TErrorCode;
Begin
    Error := EcCorrect;
    Reset(F);

    For I := 1 To 3 Do
    Begin
        Readln(F, FLine);
        Try
            Begin
                If I = 1 Then
                    M := StrToInt(FLine)
                Else
                   If I = 2 Then

                    N := StrToInt(FLine)
                    Else
                    K1 := StrToInt(FLine)
            End;
        Except
            Error := EcInvalid_Value;
        End;

            If (Error = EcCorrect) And Not(CheckUserArea(StrToInt(FLine), MAX_N, MIN_N)) Then
                Error := EcInvalid_Range;

    End;
   if Error = EcCorrect then
   Error:=CheckFileData( F, N, M,k1,Error);
    CheckFileData1:= Error;
End;

Procedure TMainForm.DeveloperMenuClick(Sender: TObject);
Var
    DeveloperForm: TDeveloperForm;
Begin
    DeveloperForm := TDeveloperForm.Create(Self);
    DeveloperForm.ShowModal;
    DeveloperForm.Free;
End;

Procedure TMainForm.InstructionMenuClick(Sender: TObject);
Var
    InstructionForm: TInstructionForm;
Begin

    InstructionForm := TInstructionForm.Create(Self);
    InstructionForm.ShowModal;
    InstructionForm.Free;
End;

procedure TMainForm.KEditChange(Sender: TObject);
Var
I, L, K:Integer;
Begin
     If (KEdit.Text = '') Then
    Begin
    for I := 0 to XGrid.ColCount-1 do

        XGrid.Rows[I].Clear;
        XGrid.ColCount := 0;
    End
    Else
    Begin
    XGrid.ColCount := StrToInt(KEdit.Text)*StrToInt(NEdit.Text);

    End;

End;

procedure TMainForm.KEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Begin
    SelectEdit2(Sender, Key, KEdit);
End;

procedure TMainForm.KEditKeyPress(Sender: TObject; var Key: Char);
begin
   CheckEdit(Sender, Key, KEdit);
end;

procedure TMainForm.ColorizeColumn(StringGrid: TStringGrid; ColumnIndex: Integer; Color: TColor);
var
  RowIndex: Integer;
begin
  if (ColumnIndex >= 0) and (ColumnIndex < StringGrid.ColCount) then
  begin
    for RowIndex := 0 to StringGrid.RowCount - 1 do
    begin
      StringGrid.Canvas.Brush.Color := Color;
      StringGrid.Canvas.FillRect(StringGrid.CellRect(ColumnIndex, RowIndex));
      StringGrid.Canvas.TextRect(StringGrid.CellRect(ColumnIndex, RowIndex),
        StringGrid.CellRect(ColumnIndex, RowIndex).Left + 2,
        StringGrid.CellRect(ColumnIndex, RowIndex).Top + 2,
        StringGrid.Cells[ColumnIndex, RowIndex]);
    end;
  end;
end;
Procedure TMainForm.NEditChange(Sender: TObject);
Var
I:Integer;
Begin
    If (NEdit.Text = '') Then
    Begin
    for I := 0 to XGrid.ColCount-1 do

        XGrid.Rows[I].Clear;
        XGrid.ColCount := 0;
    End
    Else
   { XGrid.ColCount := StrToInt(KEdit.Text)*StrToInt(NEdit.Text);  }
End;

procedure TMainForm.MEditChange(Sender: TObject);
Var
I:Integer;
begin

If (MEdit.Text = '' ) Then
    Begin
        for I := 0 to XGrid.RowCount-1 do
        XGrid.Rows[I].Clear;
        XGrid.RowCount := 0;
    End
    Else
    XGrid.RowCount := StrToInt(MEdit.Text);
end;

Procedure TMainForm.MEditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Begin
    SelectEdit2(Sender, Key, MEdit);
End;
procedure TMainForm.MEditKeyPress(Sender: TObject; var Key: Char);
begin
   CheckEdit(Sender, Key, MEdit);
end;

Procedure TMainForm.NEditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Begin
    SelectEdit2(Sender, Key, NEdit);
End;
Procedure TMainForm.NEditKeyPress(Sender: TObject; Var Key: Char);
Begin
    CheckEdit(Sender, Key, NEdit);
End;

Procedure TMainForm.OpenMenuClick(Sender: TObject);
Var
    X1: Real;
    FilePath: String;
    F: TextFile;
    ErrorCode: TErrorCode;
    N1,M1, I,J,K1: Integer;
    N,M, X,K: String;
    numbers: TArray<string>;
Begin
    If MyOpenTextFileDialog.Execute Then
    Begin
        FilePath := MyOpenTextFileDialog.FileName;
        AssignFile(F, FilePath);
        ErrorCode := IsAbleToReading(F);
        If ErrorCode = EcCorrect Then
        Begin
            ErrorCode := CheckFileData1(F);
            If ErrorCode <> EcCorrect Then
                Application.MessageBox(PChar(ERRORS[ErrorCode]), 'Ошибка', MB_OK)
            Else
            Begin
                Reset(F);
                Readln(F, M);
                MEdit.Text := M;
                Readln(F, N);
                NEdit.Text := N;
                Readln(F, K);
                KEdit.Text := K;
                N1 := StrToInt(N);
                M1 := StrToInt(M);
                K1:=   StrToInt(k);
                For J := 0 To M1 - 1 Do
                Begin
                Read(F, X);
                 numbers := X.Split([' ']);
                    For I := 0 To (N1*K1-1) Do
                    Begin
                    XGrid.Cells[I, J] := numbers[I];
                    End;
                    Readln(F);
                End;
                CloseFile(F);
            End;
        End
        Else
            Application.MessageBox(PChar(ERRORS[ErrorCode]), 'Ошибка', MB_OK);
    End;

End;


Function TMainForm.EnterArr():TArr;
Var
N,M,K,I,J,L,J1:Integer;
RArr:Tarr;
Begin
 N:= StrToInt(NEdit.Text);
 M:= StrToInt(KEdit.Text);
 K:= StrToInt(MEdit.Text);
 SetLength(RArr,K,M,N);
 J1:=0;
for L := 0 to K-1 do

 Begin
     for I := 0 to M-1 do
     Begin
     J:=0;
       for J:= 0 to N-1 do

       Begin
        RArr[L,I,J]:=StrToInt(XGrid.Cells[J1,I]);
       Inc(J1);
       End;
     End;
 End;
 EnterArr:= RArr;
End;

Function DeletBackspace(EditText: String; Var KeyChar: Char): String;
Begin
    If (KeyChar = BACKSPACE) Then
        DeletBackspace := EditText
    Else
        DeletBackspace := EditText + KeyChar;

End;

Procedure TMainForm.CheckEdit(Sender: TObject; Var Key: Char; CurEdit: TEdit);
Begin
    If Not(Key In DIGITS) And Not(Key = BACKSPACE)  Then
        Key := NONE
    Else
    Begin
        If (Length(CurEdit.Text) < 1) And (Key = '0') Then
            Key := NONE;
        If (Length(CurEdit.Text) > 1) And Not(CheckUserArea(StrToInt(DeletBackspace(CurEdit.Text, Key)), MAX_N, MIN_N)) Then
            Key := NONE;
    End;
End;

Procedure TMainForm.SelectEdit(Sender: TObject; Var Key: Word);
Begin
    With XGrid Do
    Begin
        If (Key = VK_RIGHT) Then
        Begin
            If Col < (Colcount - 1) Then
                Col := Col + 1
            Else
                Col := 0;
            Key := 0;
        End
        Else
        Begin
            If (Key = VK_LEFT) Then
            Begin
                If Col > 0 Then
                    Col := Col - 1
                Else
                    Col := Colcount - 1;
                Key := 0;
            End
            Else
            Begin
                If (Key = VK_Up)  Then
                Begin
                If Row > 0 Then
                    Row := Row - 1
                Else
                    Row := Rowcount - 1;
                Key := 0;
                End
                Else
                Begin
                  If (Key = VK_Down) Then
                Begin
                If Row < (Rowcount - 1) Then
                Row := Row + 1
            Else
                Row := 0;
            Key := 0;
                End;
            End;

        End;

    End;

End;
End;

procedure TMainForm.SelectEdit2(Sender: TObject; var Key: Word; CurEdit: TEdit);
begin
  with XGrid do
  begin
    if (Key = VK_RIGHT) or (Key = VK_LEFT) then
      XGrid.SetFocus
    else if (Key = VK_Up) then
    begin
      SelectNext(CurEdit, True, True);
    end
    else if (Key = VK_Down) then
    begin
      SelectNext(CurEdit, True, False);
    end;
  end;
end;

Function TMainForm.CheckInputFields(Sender: TObject; CurEdit: TEdit; CurStringGrid: TStringGrid): Boolean;
Var
    N,M: Byte;
    IsCorrect:boolean;
Begin

   IsCorrect := True;
    If (NEdit.Text = '')Or(MEdit.Text = '') Then
    Begin
        IsCorrect:= False;
        CurEdit.SetFocus;
        ShowMessage('Введите размер матрицы!');
    End
    Else
    Begin
        N := StrToInt(NEdit.Text);
        M := StrToInt(MEdit.Text);
        If (N < 2) Then
        Begin
            IsCorrect := False;
            CurEdit.Text := '';
            CurEdit.SetFocus;
            ShowMessage('N не может быть меньше 2!');
        End
        Else
        Begin
            If (M < 2) Then
            Begin
                IsCorrect := False;
                CurEdit.Text := '';
                CurEdit.SetFocus;
                ShowMessage('M не может быть меньше 2!');
            End

        End;

    End;
    If Not(CheckCells(XGrid))And (IsCorrect) Then
                Begin
                    IsCorrect := False;
                    CurStringGrid.SetFocus;
                    ShowMessage('Заполните таблицу до конца!');
                End;
    CheckInputFields:=IsCorrect;

End;

procedure TMainForm.XGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  Var
  K,I,J, N, I1:Integer;
begin
if( KEdit.Text<>'') And (Medit.Text<>'') And (NEdit.Text<>'') then
Begin
K:= StrToInt(KEdit.Text);
N:= StrToInt(NEdit.Text);
I1:=0;
for J := 0 to K-1 do
Begin
    for I := 0 to N-1 do

    Begin
        if J Mod 2 = 1 then
            ColorizeColumn(XGrid, I1, clRed)
        else
            if J Mod 2 = 0 then
                ColorizeColumn(XGrid, I1, clGreen);
    Inc(I1);
    End;
End;
end;
end;
end;

Procedure TMainForm.XGridKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Begin
    SelectEdit(Sender, Key)
End;

Procedure TMainForm.XGridSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
Var
    I, J: Integer;
    Amount: Extended;
Begin
    For I := 0 To XGrid.RowCount Do
    Begin
        For J := 0 To XGrid.ColCount Do
    Begin
        If ((Not TryStrToFloat(XGrid.Cells[I, J], Amount)) And (XGrid.Cells[I, J] <> '') And (XGrid.Cells[I, J] <> '-')) Then
        Begin
            ShowMessage('Некорректные исходные данные!');
            XGrid.Cells[I, J] := '';
        End
        Else
            If (XGrid.Cells[I, J] <> '') And (XGrid.Cells[I, J] <> '-') Then
            Begin
                If Not(CheckXArea(StrToFloat(XGrid.Cells[I, J]), MAX_X, MIN_X)) Then
                Begin

                    ShowMessage('Некорректные исходные данные!');
                    XGrid.Cells[I, J] := '';
                End;
            End;
    End;
    End;

End;

Procedure TMainForm.CalcResult(Sender: TObject);
Var
    Count, I, J: Integer;
    IsCorrect: Boolean;
Begin
    Count := 0;
    IsCorrect := True;
    For J := 0 To StrToInt(MEdit.Text) - 1 Do
    Begin
        For I := 0 To StrToInt(NEdit.Text) - 2 Do
        Begin
            If (StrToFloat(XGrid.Cells[I, J]) >= (StrToFloat(XGrid.Cells[I+1, J]))) Then
            Begin
                IsCorrect := False;
            End;

        End;
        If IsCorrect Then
                Inc(Count);
        IsCorrect := True;
    End;
    ResultEdit.Text:='Количество отсортированных по возрастанию строк матрицы: '+IntToStr(Count);
End;

Procedure TMainForm.GridCheck(Sender: TObject);
Var
    I,J: Integer;
    Amount: Extended;
    IsExistCell:Boolean;
Begin
   IsExistCell := True;
    For I := 0 To (XGrid.RowCount)-1 Do
    Begin
         For J := 0 To XGrid.ColCount-1 Do
         Begin
        If (XGrid.Cells[I, J] = '-') Then
        Begin
            IsExistCell := False;
            XGrid.Cells[I, J] := ''
        End;
         End;
    End;
    if Not(IsExistCell) then
       ShowMessage('Некорректные исходные данные!');
End;

Procedure TMainForm.ResultButtonClick(Sender: TObject);
Begin
    GridCheck(Sender);
    If CheckInputFields(Sender, NEdit, XGrid) Then
        CalcResult(Sender);
End;

Var
    IsSave: Boolean = False;

Procedure TMainForm.SaveMenuClick(Sender: TObject);
Var
    FilePath: String;
    F: TextFile;
Begin
    If (ResultEdit.Text <> '') Then
    Begin
        If MySaveTextFileDialog.Execute Then
        Begin
            FilePath := MySaveTextFileDialog.FileName;
            AssignFile(F, FilePath);
            If FileIsReadOnly(FilePath) Then
                Application.MessageBox(PChar(ERRORS[EcNot_Writeable]), 'Ошибка', MB_OK + MB_ICONERROR)
            Else
            Begin
                Rewrite(F);
                Write(F, ResultEdit.Text);
                CloseFile(F);
                IsSave := True;
            End;
        End;
    End;

End;

Procedure TMainForm.FileMenuClick(Sender: TObject);
Begin
    If ResultEdit.Text<>'' Then
        SaveMenu.Enabled := True
    Else
        SaveMenu.Enabled := False;
End;

Procedure TMainForm.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Var
    IsExit: Word;
Begin
    If Not IsSave And (ResultEdit.Text <> '') Then
    Begin
        IsExit := Application.MessageBox('Вы не сохранили файл, хотите ли сохранить?', 'Выход', MB_YESNOCANCEL + MB_ICONQUESTION);
        Case IsExit Of
            MrYes:
                Begin
                    CanClose := False;
                    FileMenu.Click;
                    SaveMenu.Click;
                End;

            MrNo:
                CanClose := True;
            MrCancel:
                CanClose := False;
        End;

    End
    Else
    Begin
        IsExit := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION);
        Case IsExit Of
            MrYes:
                CanClose := True;
            MrNo:
                CanClose := False;
        End;
    End;
End;

Procedure TMainForm.FormCreate(Sender: TObject);
Begin
    TaskLabel.Caption := 'Данная программа подсчитывает количество строк заданной матрицы, которые упорядочены по возрастанию.';;
End;

function TMainForm.CheckCells(CurStringGrid: TStringGrid): Boolean;
var
  I, J: Integer;
begin
  Result := True;

  for I := 0 to CurStringGrid.RowCount - 1 do
  begin
    for J := 0 to CurStringGrid.ColCount - 1 do
    begin
      if CurStringGrid.Cells[J, I] = '' then
      begin
        Result := False;
        Exit; // Если найдена пустая ячейка, выходим из функции
      end;
    end;
  end;
end;
Procedure TMainForm.ExitMenuClick(Sender: TObject);
Var
    IsExit: Word;
Begin
    If Not IsSave And (ResultEdit.Text <> '') Then
    Begin
        IsExit := Application.MessageBox('Вы не сохранили файл, хотите ли сохранить?', 'Выход', MB_YESNOCANCEL + MB_ICONQUESTION);
        Case IsExit Of
            MrYes:
                SaveMenu.Click;
            MrNo:
                Close;
        End;

    End
    Else
    Begin
        IsExit := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION);
        Case IsExit Of
            MrYes:
                Close;
        End;
    End;
End;

End.