форма 14

unit form21;

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,Unit21_1, Unit21_2,
  Vcl.ComCtrls, Vcl.Grids;

type
  TErrorCode=(ecCorrect, ecInvalid_Value, ecInvalid_Range, ecNot_Readable, ecNot_Writeable, ecIncorrect_Amount_lines);
  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;
    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; CurEdit:TEdit);
    procedure FormCreate(Sender: TObject);

    function CheckCells(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
    procedure NEditKeyPress(Sender: TObject; var Key: Char);
    procedure XGridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure NEditChange(Sender: TObject);




  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
  ERRORS: Array [TErrorCode] Of String= ('',
                                         'Некорректный тип данных внутри файла!',
                                         'Значения не попадают в диапазон!',
                                         'Файл закрыт для чтения!',
                                         'Файл закрыт для записи!',
                                         'Неверное количество данных в файле');
  BACKSPACE=#8;
  NONE=#0;
  DIGITS=['0'..'9'];
  MAX_N=90;
  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 < MIN) Or (Num > MAX) 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): TErrorCode;
Var
    FLine: String;
    I, N: Integer;
    K,s:Double;
    Error: TErrorCode;
Begin
    Error:=ecCorrect;
    Reset(F);
    Readln(F, FLine);
    try
    N:=StrToInt(FLine);
    Except
    Error:= ecInvalid_Value;
    end;
    If (Error=ecCorrect) And Not(CheckUserArea(N,MAX_N,MIN_N))  Then
    Error:=ecInvalid_Range;
    If (Error=ecCorrect)  then
    begin
    for I := 1 to N do
    Begin
        Read(F, FLine);
        If Not(TryStrToFloat(Fline,s)) Then
        Begin
        Error:= ecInvalid_Value;
        Break;
        End;

        If Not(CheckXArea(K,MAX_X,MIN_X)) Then
        Begin
        Error:=ecInvalid_Range;
        Break;
        End;
       Readln(F);
    end;
    If (Error=ecCorrect) And Not (EOF(F)) Then
    Error:=ecIncorrect_Amount_lines;
    end;
    CloseFile(F);
    CheckFileData := 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.NEditChange(Sender: TObject);


begin
if NEdit.Text='' then
Begin
XGrid.Rows[0].Clear;
XGrid.ColCount:=0;
End
Else
XGrid.ColCount:=StrToInt(NEdit.Text)
 end;

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

procedure TMainForm.OpenMenuClick(Sender: TObject);
Var
    FilePath: String;
    F:TextFile;
    ErrorCode:TErrorCode;
    N1,I:Integer;
    N,X:String;
begin
    if MyOpenTextFileDialog.Execute then
    Begin
         FilePath:=MyOpenTextFileDialog.FileName;
         AssignFile(F,FilePath);
         ErrorCode:=IsAbleToReading(F);
         if ErrorCode=ecCorrect then
         Begin
            ErrorCode:=CheckFileData(F);
            if ErrorCode<>ecCorrect then
            Application.MessageBox(PChar(ERRORS[ErrorCode]),'Ошибка',MB_OK)
            Else
            Begin
            Reset(F);
            Readln(F,N);
            NEdit.Text:=N;
            N1:=StrToInt(N);
            for I := 0 to N1-1 do
            Begin
            Readln(F,X);
            XGrid.Cells[I,0]:=X;
            End;
            CloseFile(F);
            End;
         End
         Else
            Application.MessageBox(PChar(ERRORS[ErrorCode]),'Ошибка',MB_OK);
    End;

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; CurEdit:TEdit);
Begin
   if (Key = VK_UP) Or (Key=VK_RIGHT)then
   SelectNext(CurEdit,False,True)
   Else
       if (Key = VK_DOWN) Or (Key=VK_LEFT) then
         SelectNext(CurEdit,True,True);

End;


function TMainForm.CheckInputFields(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
var
N:Byte;
begin

 CheckInputFields := True ;
if(curEdit.Text='') then
Begin
  CheckInputFields:=false;
  CurEdit.SetFocus;
  ShowMessage('Введите N!');
End
Else
Begin
N:=StrToInt(curEdit.Text);
        If(N<3) then
           Begin
    CheckInputFields:=false;
    CurEdit.Text:='';
   CurEdit.SetFocus;
   ShowMessage('N не может быть меньше 3!');
   End
   Else
   if Not(CheckCells(Sender,CurEdit,CurStringGrid)) then
   Begin
   CheckInputFields:=false;
   CurStringGrid.SetFocus;
   ShowMessage('Заполните таблицу до конца!');
   End ;
End



End;

Procedure TMainForm.XGridSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
Var
    I: Integer;
    amount :extended;
begin
    for I := 0 to XGrid.ColCount do
    begin
        if ((Not TryStrToFloat(XGrid.Cells[I, 0], amount)) and
          (XGrid.Cells[I, 0] <> '') and (XGrid.Cells[I, 0] <> '-')) then
        begin
            ShowMessage('Некорректные исходные данные!');
            XGrid.Cells[I, 0] := '';
        end
        Else
        if(XGrid.Cells[I, 0] <> '') and Not(CheckXArea(StrToFloat(XGrid.Cells[I, 0]),MAX_X,MIN_X)) then
        begin
            ShowMessage('Некорректные исходные данные!');
            XGrid.Cells[I, 0] := '';
        end;
    end;

end;



procedure TMainForm.CalcResult(Sender: TObject);
var
  I, N: Integer;
  NewArr: array of Real;
begin
  N := StrToInt(NEdit.Text);
  SetLength(NewArr, N);
  NewArr[0] := StrToFloat(XGrid.Cells[0, 0]);
  NewArr[N - 1] := StrToFloat(XGrid.Cells[0, 0]);
  for I := 1 to N - 2 do
    NewArr[I] := (StrToFloat(XGrid.Cells[I - 1, 0]) + StrToFloat(XGrid.Cells[I, 0]) + StrToFloat(XGrid.Cells[I + 1, 0])) / 3;

  for I := 0 to N - 1 do
    ResultEdit.Lines.Add(FloatToStr(NewArr[I]));
end;

procedure TMainForm.ResultButtonClick(Sender: TObject);
begin
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,' координаты точки: ()'#13#10'Радиус окружности:  Ответ(Принадлежит ли точка окружности): ', ResultEdit.Text);
          CloseFile(F);
          IsSave:=True;
          End;
    End;
   End;


end;
procedure TMainForm.FileMenuClick(Sender: TObject);
begin
  if ResultButton.Enabled 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:= 'Данная программа подсчитывает количество таких троек'+#13#10+'последовательности х1, х2, …, хn, что xi-1<xi<xi+1';
end;
function TMainForm.CheckCells(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
Var
N,I:Integer;
IsNotExist:Boolean;
begin
IsNotExist := true;
for I := 0 to N do
Begin
if(CurStringGrid.Cells[I,0]='') then
Begin
IsNotExist := false;
Break;
End;
End;
CheckCells:=IsNotExist;
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.