Lab.2.2.f

unit Lab_1_4_Forms;

interface

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

type
  TForm2_2 = class(TForm)
    MainMenu1: TMainMenu;
    ButtonFile: TMenuItem;
    ButtonOpenFile: TMenuItem;
    ButtonSaveFile: TMenuItem;
    ButtonInstruction: TMenuItem;
    ButtonAbout: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    LabelTask: TLabel;
    LabelNumber: TLabel;
    EditNumber: TEdit;
    LabelAnswer: TLabel;
    ButtonFindAnswer: TButton;
    MemoAnswer: TMemo;
    procedure ButtonOpenFileClick(Sender: TObject);
    procedure ButtonSaveFileClick(Sender: TObject);
    procedure ButtonAboutClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ButtonInstructionClick(Sender: TObject);
    procedure EditNumberKeyPress(Sender: TObject; var Key: Char);
    procedure ButtonFindAnswerClick(Sender: TObject);
    procedure EditNumberChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2_2: TForm2_2;

implementation

{$R *.dfm}

uses UnitError, UnitAbout, UnitExit, UnitInstruction_2_2;

type
    TArr = Array Of Integer;

const
    MAX_VALUE = 1000;                               //12004
    MIN_VALUE = 1;

Function ConsistencyUpToNumber(Number: Integer): TArr;
Var
    I: Integer;
    ArrNumbers: TArr;
Begin
    SetLength (ArrNumbers, Number - 1);
    I := 0;
    While (I < Number - 1) Do
    Begin
        ArrNumbers[I] := I + 2;
        Inc(I);
    End;
    ConsistencyUpToNumber := ArrNumbers;
End;

Function ArrayOfPrime(Number: Integer): TArr;
Var
    IsPrime: Array Of Boolean;
    I, J: Integer;
    PrimeNumbers: TArr;
Begin
    SetLength(IsPrime, Number);
    For I := 0 To Number - 1 Do
        IsPrime[I] := True;
    I := 2;
    While (I * I < Number) Do
    Begin
        If (IsPrime[I]) Then
        Begin
            J := 2 * I;
            While (J < Number) Do
            Begin
                IsPrime[J] := False;
                J := J + I;
            End;
        End;
        Inc (I);
    End;
    SetLength(PrimeNumbers, Number);
    Dec(Number);
    J := 0;
    For I := 2 To Number Do
        If (IsPrime[I]) Then
        Begin
            PrimeNumbers[J] := I;
            Inc (J);
        End;
    ArrayOfPrime := PrimeNumbers;
End;

Function SecondDivision(ArrNumbersElement, Quotient, Number: Integer): Integer;
Var
    ArrCorrectnessElement, K: Integer;
    ArrOfPrime: TArr;
Begin
    ArrCorrectnessElement := 0;
    ArrOfPrime := ArrayOfPrime(Number);
    K := 0;
    While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] <= Quotient)) Do
    Begin
        If (Quotient = ArrOfPrime[K]) Then
        Begin
            ArrCorrectnessElement := ArrNumbersElement;
            K := Number;
        End;
        Inc (K);
    End;
    SecondDivision := ArrCorrectnessElement;
End;

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

Function FindingRequiredNumbers(Number: Integer): TArr;
Var
    I, K, Quotient: Integer;
    ArrCorrectness, ArrNumbers, ArrOfPrime: TArr;
Begin
    ArrOfPrime := ArrayOfPrime(Number);
    ArrNumbers := ConsistencyUpToNumber(Number);
    Dec(Number);
    SetLength (ArrCorrectness, Number);
    Dec(Number);
    For I := 0 To Number Do
    Begin
        K := 0;
        While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] < ArrNumbers[I])) Do
        Begin
            If (ArrNumbers[I] Mod ArrOfPrime[K] = 0) Then
            Begin
                Quotient := ArrNumbers[I] Div ArrOfPrime[K];
                ArrCorrectness[I] := SecondDivision(ArrNumbers[I], Quotient, Number + 2);
                K := Number;
            End;
            Inc (K);
        End;
    End;
    FindingRequiredNumbers := ArrCorrectness;
End;

procedure TForm2_2.ButtonFindAnswerClick(Sender: TObject);
var
    Number, ZeroValue, I: Integer;
    ArrayOfCorrect: TArr;
    IsCorrect: Boolean;
    Error: String;
begin
    MemoAnswer.Text := '';
    IsCorrect := True;
    try
        Number := StrToInt(EditNumber.Text);
        if (Number > MAX_VALUE) or (Number < MIN_VALUE) then
        begin
            Error := 'Число не входит в диапазон допустимых значений. ';
            IsCorrect := false;
        end;
    except
        IsCorrect := False;
        Error := 'Некорректно введённое число. ';
    end;
    if (IsCorrect) then
    begin
        ArrayOfCorrect := FindingRequiredNumbers(Number);
        MemoAnswer.Lines.Add('Полученные натуральные числа:');
        Dec(Number, 2);
        ZeroValue := Number;
        For I := 0 To Number Do
            If (ArrayOfCorrect[I] <> 0) Then
            Begin
                MemoAnswer.Text := MemoAnswer.Text + IntToStr(ArrayOfCorrect[I]) + ' ';
                Dec(ZeroValue);
            End;
        If (ZeroValue = Number) Then
            MemoAnswer.Lines.Add('Натуральные числа, соответствующие требованиям, не найдены');
        ButtonSaveFile.Enabled := true;
    end
    else
    begin
        UnitError.FormError.LabelError.Caption := 'Ошибка! ' + Error;
        UnitError.FormError.ShowModal();
        UnitError.FormError.LabelError.Caption := '';
    end;
end;

procedure TForm2_2.ButtonInstructionClick(Sender: TObject);
begin
    UnitInstruction_2_2.FormInstruction_2_2.ShowModal();
end;

procedure TForm2_2.ButtonOpenFileClick(Sender: TObject);
var
    F: TextFile;
    Path, Error, NumberStr: String;
    Number, Res: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    Error := '';
    Number := 0;
    Res := 0;
    If OpenDialog1.Execute() Then
    Begin
        Path := OpenDialog1.FileName;
        AssignFile(F, Path);
        Try
            Reset(F);
            Try
                Read(F, NumberStr);
                if (NumberStr = '') then
                begin
                    Error := 'В файле не найдено элементов. ';
                    IsCorrect := False;
                end
                else
                begin
                    Number := StrToInt(NumberStr);
                    if not(EOF(F)) then
                    begin
                        Error := Error + 'Найдены лишние элементы в файле. ';
                        IsCorrect := False;
                    end;
                    if (Number > MAX_VALUE) or (Number < MIN_VALUE) then
                    begin
                        Error := Error + 'Число не входит в диапазон допустимых значений. ';
                        IsCorrect := false;
                    end;
                    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
            EditNumber.Text := IntToStr(Number);
        end;
    End;
end;

procedure TForm2_2.ButtonSaveFileClick(Sender: TObject);
var
    F: TextFile;
    Path, Error: String;
    Res: 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, MemoAnswer.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 TForm2_2.EditNumberChange(Sender: TObject);
begin
    ButtonFindAnswer.Enabled := True;
    MemoAnswer.Text := '';
    ButtonSaveFile.Enabled := false;
    if (Length(EditNumber.Text) = 0) then
        ButtonFindAnswer.Enabled := false;
end;

procedure TForm2_2.EditNumberKeyPress(Sender: TObject; var Key: Char);
begin
    if not(Key in [#8, #13, '0'..'9']) then
        Key := #0;
    if (Length(EditNumber.Text) = 0) and (Key in [#13, '0']) then
        Key := #0;
    if (Length(EditNumber.Text) = 1) and not(EditNumber.Text[1] = '1') then
        EditNumber.MaxLength := 3;
    if (Length(EditNumber.Text) = 3) and not(EditNumber.Text = '100') then
        EditNumber.MaxLength := 3
    else
        EditNumber.MaxLength := 4;
    if (Length(EditNumber.Text) = 3) and (EditNumber.Text = '100') and not(Key in ['0', #8, #13]) then
        Key := #0;
    if (Length(EditNumber.Text) > 0) and (Key = #13) then
        ButtonFindAnswerClick(Sender);
end;

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

end.