Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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,Count, N: Integer;
- Begin
- N:=StrToInt(NEdit.Text);
- count:=0;
- For I := 1 To N - 2 Do
- If (XGrid.Cells[I - 1,0] < XGrid.Cells[I,0]) And (XGrid.Cells[I,0] < XGrid.Cells[I + 1,0] ) Then
- Count := Count + 1;
- ResultEdit.Text:=IntToStr(Count);
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement