Lab.3.3.F

unit Lab_3_3_Form;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    ButtonFile: TMenuItem;
    ButtonOpenFile: TMenuItem;
    ButtonSaveFile: TMenuItem;
    ButtonInstruction: TMenuItem;
    ButtonAbout: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    LabelTask: TLabel;
    LabelSizeArray: TLabel;
    EditSizeArray: TEdit;
    ButtonCreateSpreadSheep: TButton;
    StringGridArray: TStringGrid;
    ButtonSort: TButton;
    MemoSort: TMemo;
    EditSortedArray: TEdit;
    LabelProcess: TLabel;
    LabelSortedArray: TLabel;
    procedure EditSizeArrayKeyPress(Sender: TObject; var Key: Char);
    procedure ButtonCreateSpreadSheepClick(Sender: TObject);
    procedure EditSizeArrayChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure StringGridArrayKeyPress(Sender: TObject; var Key: Char);
    procedure StringGridArraySelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure ButtonSortClick(Sender: TObject);
    procedure ButtonInstructionClick(Sender: TObject);
    procedure ButtonAboutClick(Sender: TObject);
    procedure ButtonOpenFileClick(Sender: TObject);
    procedure ButtonSaveFileClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses UnitAbout, UnitError, UnitExit, UnitInstruction_3_3;

const
    MIN_ELEMENT = -20;
    MAX_ELEMENT = 20;
    MIN_SIZE = 1;
    MAX_SIZE = 20;

Type
    TArr = Array Of Integer;
Var
    LengthArr: Integer;
    Arr: TArr;

function FillArr(Sender: TObject; ArrLen: Integer; SprSheep: TStringGrid; var IsCorrect: Boolean): TArr;
var
    I: Integer;
    A: TArr;
begin
    SetLength(A, LengthArr);
    I := 1;
    IsCorrect := True;
    while (IsCorrect) and (I <= ArrLen)do
    begin
        try
            A[I - 1] := StrToInt(SprSheep.Cells[I, 1]);
        except
            IsCorrect := False;
            UnitError.FormError.LabelError.Caption := 'Ошибка! Получено некорректное значение элемента массива!';
            UnitError.FormError.ShowModal();
        end;
        Inc(I);
    end;
    FillArr := A;
end;


procedure FillNumbersSpreadSheep(Sender: TObject; ArrLen: Integer; SprSheep: TStringGrid);
var
    I: Integer;
    CanChange: Boolean;
begin
    for I := 1 to ArrLen do
    begin
        SprSheep.Cells[I, 0] := '№' + IntToStr(I);
    end;
end;


procedure TForm1.ButtonAboutClick(Sender: TObject);
begin
    UnitAbout.FormAbout.ShowModal();
end;

procedure TForm1.ButtonCreateSpreadSheepClick(Sender: TObject);
var
    IsCorrect: Boolean;
    I: Integer;
begin
    ButtonCreateSpreadSheep.Enabled := False;
    IsCorrect := True;
    try
        LengthArr := StrToInt(EditSizeArray.Text);
    except
        IsCorrect := False;
        UnitError.FormError.LabelError.Caption := 'Ошибка! Получено некорректное значение длины массива!';
        UnitError.FormError.ShowModal();
    end;
    if (IsCorrect) then
    begin
        StringGridArray.ColCount := LengthArr + 1;
        SetLength(Arr, LengthArr);
        StringGridArray.ColWidths[0] := 85;
        StringGridArray.Cells[0,0] := '№ элемента';
        StringGridArray.Cells[0,1] := 'Элемент';
        FillNumbersSpreadSheep(Sender, LengthArr, StringGridArray);
        StringGridArray.Visible := True;
        StringGridArray.Enabled := True;
        for I := 1 to LengthArr do
        begin
            StringGridArraySelectCell(Sender, I, 1, IsCorrect);
        end;
        ButtonSort.Visible := True;
        ButtonSort.Enabled := True;
    end;
end;

Procedure WriteArr(Arr: TArr; var Memo: TMemo);
Var
    I: Integer;
    Str: String;
Begin
    For I := 0 To High(Arr) Do
        Str := Str + IntToStr(Arr[I]) + ' ';
    Memo.Lines.Add(Str);
End;

Procedure Sort(Var Arr: TArr; var Memo: TMemo);
Var
    I, J, X: Integer;
Begin
    For I := 1 To High(Arr) Do
    Begin
        X := Arr[I];
        J := I;
        While (J > 0) And (Arr[J - 1] > X) Do
        Begin
            Arr[J] := Arr[J - 1];
            Dec(J);
        End;
        Arr[J] := X;
        WriteArr(Arr, Memo);
    End;
End;

procedure TForm1.ButtonInstructionClick(Sender: TObject);
begin
    UnitInstruction_3_3.FormInstruction_3_3.ShowModal();
end;

procedure TForm1.ButtonOpenFileClick(Sender: TObject);
var
    F: TextFile;
    Path, Error: String;
    I, Res, Size: Integer;
    IsCorrect: Boolean;
    A: TArr;
begin
    IsCorrect := True;
    Error := '';
    Res := 0;
    Size := 0;
    If OpenDialog1.Execute() Then
    Begin
        Path := OpenDialog1.FileName;
        AssignFile(F, Path);
        Try
            Reset(F);
            Try
                Readln(F, Size);
                if (Size < MIN_SIZE) or (Size > MAX_SIZE) then
                begin
                    IsCorrect := False;
                    Error := Error + 'Размер массива за пределами диапазона допустимых значений. ';
                end;
                I := 0;
                SetLength(A, Size);
                While (IsCorrect) and (I < Size) Do
                Begin
                    Read(F, A[I]);
                    If (A[I] < MIN_ELEMENT) Or (A[I] > MAX_ELEMENT) Then
                    Begin
                        IsCorrect := False;
                        Error := Error + 'Размер элемента за пределами диапазона допустимых значений. ';
                    End;
                    if (I < High(A)) and (EOF(F)) then
                    begin
                        IsCorrect := False;
                        Error := Error + 'Недостаточно элементов в файле. ';
                    end;
                    Inc(I);
                End;
            Finally
                CloseFile(F);
            End;
        Except
            IsCorrect := False;
            Error := Error + 'Нет доступа к файлу';
        End;
        If not(IsCorrect) Then
        Begin
            UnitError.FormError.LabelError.Caption := 'Ошибка считывания с файла. ' + Error;
            Res := UnitError.FormError.ShowModal();
        End;
        if Res > 0 Then
            UnitError.FormError.LabelError.Caption := ''
        else
        begin
            LengthArr := Size;
            EditSizeArray.Text := IntToStr(Size);
            ButtonCreateSpreadSheepClick(Sender);
            for I := 1 to LengthArr do
            begin
                StringGridArray.Cells[I, 1] := IntToStr(A[I - 1]);
            end;
        end;
    End;
end;

procedure TForm1.ButtonSaveFileClick(Sender: TObject);
var
    F: TextFile;
    Path, Error: String;
    Res, Answer: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    Res := 0;
    Error := '';
    if SaveDialog1.Execute() then
    begin
        Path := SaveDialog1.FileName;
        AssignFile(F, Path);
        Try
            Rewrite(F);
            Try
                Write(F, 'Отсортированный массив: ', EditSortedArray.Text)
            Finally
                CloseFile(F);
            End;
        Except
            IsCorrect := False;
            Error := 'Нет доступа к файлу';
        End;
        if not(IsCorrect) then
        begin
            UnitError.FormError.LabelError.Caption := 'Ошибка считывания с файла. ' + Error;
            Res := UnitError.FormError.ShowModal();
        end;
        if Res > 0 Then
            UnitError.FormError.LabelError.Caption := '';
    end;
end;

procedure TForm1.ButtonSortClick(Sender: TObject);
var
    I: Integer;
    IsFill, IsCorrect: Boolean;
begin
    for I := 1 to LengthArr do
        if (StringGridArray.Cells[I, 1].IsEmpty) then
            IsFill := False
        else
            IsFill := True;
    if (IsFill) then
        Arr := FillArr(Sender, LengthArr, StringGridArray, IsCorrect)
    else
    begin
        UnitError.FormError.LabelError.Caption := 'Ошибка! Получено недостаточное количество элементов массива!';
        UnitError.FormError.ShowModal();
        IsCorrect := False;
    end;
    if (IsCorrect) then
    begin
        ButtonSaveFile.Enabled := True;
        LabelSortedArray.Visible := True;
        EditSortedArray.Visible := True;
        MemoSort.Text := '';
        MemoSort.Visible := True;
        LabelProcess.Visible := True;
        EditSortedArray.Visible := true;
        WriteArr(Arr, MemoSort);
        Sort(Arr, MemoSort);
        for I := 0 to High(Arr) do
            EditSortedArray.Text := EditSortedArray.Text + IntToStr(Arr[I]) + ' ';
    end;
end;

procedure TForm1.EditSizeArrayChange(Sender: TObject);
var
    I, J: Integer;
begin
    ButtonCreateSpreadSheep.Enabled := True;
    StringGridArray.Visible := False;
    StringGridArray.Enabled := False;
    ButtonSaveFile.Enabled := False;
    ButtonSort.Visible := False;
    ButtonSort.Enabled := False;
    LabelSortedArray.Visible := False;
    EditSortedArray.Visible := False;
    EditSortedArray.Text := '';
    LabelProcess.Visible := False;
    MemoSort.Visible := False;
    LabelProcess.Visible := False;
    for I := 0 to StringGridArray.ColCount - 1 do
        for J := 0 to StringGridArray.RowCount - 1 do
            StringGridArray.Cells[I, J] := '';
    if EditSizeArray.Text = '' then
    begin
        ButtonCreateSpreadSheep.Enabled := False;
    end;
end;

procedure TForm1.EditSizeArrayKeyPress(Sender: TObject; var Key: Char);
var
    Number: Integer;
begin
    if not(Key in ['0'..'9', #8, #13])then
        Key := #0;
    if (Length(EditSizeArray.Text) = 0) and (Key = '0') Then
        Key := #0;
    if (Length(EditSizeArray.Text) = 1) and (EditSizeArray.Text[1] = '2') and (Key in ['1'..'9']) then
        Key := #0;
    if (Length(EditSizeArray.Text) = 1) and not(EditSizeArray.Text[1] in ['2', '1']) and (Key in ['0'..'9']) then
        Key := #0;
    if (Length(EditSizeArray.Text) > 0) and (Key = #13) then
        ButtonCreateSpreadSheepClick(Sender);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Var
    Res: Integer;
begin
    Res := UnitExit.FormExit.ShowModal();
    If Res = mrOk Then
        CanClose := True
    Else
        CanClose := False;
end;

procedure TForm1.StringGridArrayKeyPress(Sender: TObject; var Key: Char);
var
    MaxLength: Integer;
begin
    if not(Key in ['0'..'9', '-', #8, #13])then
        Key := #0;
    MaxLength := 2;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) > 0) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][1] = '-') then
        MaxLength := 3;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) > 0) and (Key = '-') then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) > 0) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][1] = '0') and not(Key = #8) Then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = 1) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][1] = '2') and (Key in ['1'..'9']) then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = 1) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][1] in ['3'..'9']) and (Key in ['0'..'9']) then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = 2) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row] = '-2') and not(Key in ['0', #8]) then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = 1) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row] = '-') and (Key = '0') then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = 2) and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][1] = '-') and (StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row][2] in ['3'..'9']) and (Key in ['0'..'9']) then
        Key := #0;
    if (Length(StringGridArray.Cells[StringGridArray.Col, StringGridArray.Row]) = MaxLength) and not(Key = #8)then
        Key := #0;
end;

procedure TForm1.StringGridArraySelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
    if (ACol = 0) or (ARow = 0) then
        CanSelect := False;
end;

end.