Advertisement
gguuppyy

dasha21

Feb 28th, 2024
14
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 12.43 KB | None | 0 0
  1. unit form21;
  2.  
  3. interface
  4.  
  5. uses
  6. 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,
  7. Vcl.ComCtrls, Vcl.Grids;
  8.  
  9. type
  10. TErrorCode=(ecCorrect, ecInvalid_Value, ecInvalid_Range, ecNot_Readable, ecNot_Writeable, ecIncorrect_Amount_lines);
  11. TMainForm = class(TForm)
  12. MainMenu: TMainMenu;
  13. FileMenu: TMenuItem;
  14. OpenMenu: TMenuItem;
  15. SaveMenu: TMenuItem;
  16. ExitMenu: TMenuItem;
  17. InstructionMenu: TMenuItem;
  18. DeveloperMenu: TMenuItem;
  19. TaskLabel: TLabel;
  20. NEdit: TEdit;
  21. ResultButton: TButton;
  22. ResultEdit: TEdit;
  23. MyOpenTextFileDialog: TOpenTextFileDialog;
  24. MySaveTextFileDialog: TSaveTextFileDialog;
  25. RLabel: TLabel;
  26. XGrid: TStringGrid;
  27. Label1: TLabel;
  28. procedure InstructionMenuClick(Sender: TObject);
  29. procedure DeveloperMenuClick(Sender: TObject);
  30. procedure OpenMenuClick(Sender: TObject);
  31. procedure SaveMenuClick(Sender: TObject);
  32. procedure ResultButtonClick(Sender: TObject);
  33. procedure ExitMenuClick(Sender: TObject);
  34. procedure CalcResult(Sender:TObject);
  35. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  36. function CheckInputFields(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
  37. procedure FileMenuClick(Sender: TObject);
  38. procedure CheckEdit(Sender: TObject; var Key: Char; CurEdit:TEdit);
  39. procedure SelectEdit(Sender: TObject; var Key: Word; CurEdit:TEdit);
  40. procedure FormCreate(Sender: TObject);
  41.  
  42. function CheckCells(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
  43. procedure NEditKeyPress(Sender: TObject; var Key: Char);
  44. procedure XGridSetEditText(Sender: TObject; ACol, ARow: Integer;
  45. const Value: string);
  46. procedure NEditChange(Sender: TObject);
  47.  
  48.  
  49.  
  50.  
  51. private
  52. { Private declarations }
  53. public
  54. { Public declarations }
  55. end;
  56.  
  57. Const
  58. ERRORS: Array [TErrorCode] Of String= ('',
  59. 'Некорректный тип данных внутри файла!',
  60. 'Значения не попадают в диапазон!',
  61. 'Файл закрыт для чтения!',
  62. 'Файл закрыт для записи!',
  63. 'Неверное количество данных в файле');
  64. BACKSPACE=#8;
  65. NONE=#0;
  66. DIGITS=['0'..'9'];
  67. MAX_N=90;
  68. MIN_N=3;
  69. MAX_X=1000;
  70. MIN_X=-1000;
  71.  
  72. var
  73. MainForm: TMainForm;
  74.  
  75.  
  76. implementation
  77.  
  78. {$R *.dfm}
  79. Function IsAbleToReading(Var F: TextFile): TErrorCode;
  80. Var
  81. Error: TErrorCode;
  82. Begin
  83. Error:=ecCorrect;
  84. Try
  85. Reset(F);
  86. CloseFile(F);
  87. Except
  88. Error := ecNot_Readable;
  89. End;
  90. IsAbleToReading := Error;
  91. End;
  92. function FindChar(MyText:String; MyChar:Char):Boolean;
  93. Var
  94. N,I, Counter:Integer;
  95. Begin
  96. N:=Length(MyText);
  97. Counter:=0;
  98. for I := 1 to N do
  99. if MyText[I]=MyChar then
  100. Inc(Counter);
  101. if Counter=0 then
  102. FindChar:= False
  103. Else
  104. FindChar:=True;
  105. End;
  106. Function CheckUserArea(Num: Integer ;const MAX, MIN:Integer): Boolean;
  107.  
  108. Var
  109. IsCorrect: Boolean;
  110. Begin
  111. If (Num < MIN) Or (Num > MAX) Then
  112. Begin
  113. IsCorrect := False;
  114. End
  115. Else
  116. IsCorrect := True;
  117. CheckUserArea := IsCorrect;
  118. End;
  119. Function CheckXArea(Num: Double;const MAX, MIN:Real): Boolean;
  120.  
  121. Var
  122. IsCorrect: Boolean;
  123. Begin
  124. If (Num < MIN) Or (Num > MAX) Then
  125. Begin
  126. IsCorrect := False;
  127. End
  128. Else
  129. IsCorrect := True;
  130. CheckXArea := IsCorrect;
  131. End;
  132.  
  133. Function CheckFileData(Var F: TextFile): TErrorCode;
  134. Var
  135. FLine: String;
  136. I, N: Integer;
  137. K,s:Double;
  138. Error: TErrorCode;
  139. Begin
  140. Error:=ecCorrect;
  141. Reset(F);
  142. Readln(F, FLine);
  143. try
  144. N:=StrToInt(FLine);
  145. Except
  146. Error:= ecInvalid_Value;
  147. end;
  148. If (Error=ecCorrect) And Not(CheckUserArea(N,MAX_N,MIN_N)) Then
  149. Error:=ecInvalid_Range;
  150. If (Error=ecCorrect) then
  151. begin
  152. for I := 1 to N do
  153. Begin
  154. Read(F, FLine);
  155. If Not(TryStrToFloat(Fline,s)) Then
  156. Begin
  157. Error:= ecInvalid_Value;
  158. Break;
  159. End;
  160.  
  161. If Not(CheckXArea(K,MAX_X,MIN_X)) Then
  162. Begin
  163. Error:=ecInvalid_Range;
  164. Break;
  165. End;
  166. Readln(F);
  167. end;
  168. If (Error=ecCorrect) And Not (EOF(F)) Then
  169. Error:=ecIncorrect_Amount_lines;
  170. end;
  171. CloseFile(F);
  172. CheckFileData := Error;
  173. End;
  174. procedure TMainForm.DeveloperMenuClick(Sender: TObject);
  175. var
  176. DeveloperForm: TDeveloperForm;
  177. begin
  178. DeveloperForm := TDeveloperForm.Create(Self);
  179. DeveloperForm.ShowModal;
  180. DeveloperForm.Free;
  181. end;
  182.  
  183.  
  184.  
  185. procedure TMainForm.InstructionMenuClick(Sender: TObject);
  186. var
  187. InstructionForm: TInstructionForm;
  188. begin
  189.  
  190. InstructionForm := TInstructionForm.Create(Self);
  191. InstructionForm.ShowModal;
  192. InstructionForm.Free;
  193. end;
  194.  
  195.  
  196.  
  197. procedure TMainForm.NEditChange(Sender: TObject);
  198.  
  199.  
  200. begin
  201. if NEdit.Text='' then
  202. Begin
  203. XGrid.Rows[0].Clear;
  204. XGrid.ColCount:=0;
  205. End
  206. Else
  207. XGrid.ColCount:=StrToInt(NEdit.Text)
  208. end;
  209.  
  210. procedure TMainForm.NEditKeyPress(Sender: TObject; var Key: Char);
  211. begin
  212. CheckEdit(Sender, Key,NEdit);
  213. end;
  214.  
  215. procedure TMainForm.OpenMenuClick(Sender: TObject);
  216. Var
  217. FilePath: String;
  218. F:TextFile;
  219. ErrorCode:TErrorCode;
  220. N1,I:Integer;
  221. N,X:String;
  222. begin
  223. if MyOpenTextFileDialog.Execute then
  224. Begin
  225. FilePath:=MyOpenTextFileDialog.FileName;
  226. AssignFile(F,FilePath);
  227. ErrorCode:=IsAbleToReading(F);
  228. if ErrorCode=ecCorrect then
  229. Begin
  230. ErrorCode:=CheckFileData(F);
  231. if ErrorCode<>ecCorrect then
  232. Application.MessageBox(PChar(ERRORS[ErrorCode]),'Ошибка',MB_OK)
  233. Else
  234. Begin
  235. Reset(F);
  236. Readln(F,N);
  237. NEdit.Text:=N;
  238. N1:=StrToInt(N);
  239. for I := 0 to N1-1 do
  240. Begin
  241. Readln(F,X);
  242. XGrid.Cells[I,0]:=X;
  243. End;
  244. CloseFile(F);
  245. End;
  246. End
  247. Else
  248. Application.MessageBox(PChar(ERRORS[ErrorCode]),'Ошибка',MB_OK);
  249. End;
  250.  
  251. end;
  252. Function DeletBackspace( EditText:String; var KeyChar: Char ):String;
  253. Begin
  254. if (KeyChar=BACKSPACE) then
  255. DeletBackspace:=EditText
  256. Else
  257. DeletBackspace:=EditText+KeyChar;
  258.  
  259. End;
  260.  
  261. procedure TMainForm.CheckEdit(Sender: TObject; var Key: Char; CurEdit:TEdit);
  262. Begin
  263. if Not(Key in DIGITS) And Not(Key=BACKSPACE) Then
  264. Key := NONE
  265. Else
  266. Begin
  267. if (Length(CurEdit.Text)<1) and (Key = '0') then
  268. Key := NONE;
  269. if (Length(CurEdit.Text)>1) and Not(CheckUserArea(StrToInt(DeletBackspace(CurEdit.Text,Key)),MAX_N, MIN_N)) then
  270. Key:=NONE;
  271. End;
  272. End;
  273. procedure TMainForm.SelectEdit(Sender: TObject; var Key: Word; CurEdit:TEdit);
  274. Begin
  275. if (Key = VK_UP) Or (Key=VK_RIGHT)then
  276. SelectNext(CurEdit,False,True)
  277. Else
  278. if (Key = VK_DOWN) Or (Key=VK_LEFT) then
  279. SelectNext(CurEdit,True,True);
  280.  
  281. End;
  282.  
  283.  
  284. function TMainForm.CheckInputFields(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
  285. var
  286. N:Byte;
  287. begin
  288.  
  289. CheckInputFields := True ;
  290. if(curEdit.Text='') then
  291. Begin
  292. CheckInputFields:=false;
  293. CurEdit.SetFocus;
  294. ShowMessage('Введите N!');
  295. End
  296. Else
  297. Begin
  298. N:=StrToInt(curEdit.Text);
  299. If(N<3) then
  300. Begin
  301. CheckInputFields:=false;
  302. CurEdit.Text:='';
  303. CurEdit.SetFocus;
  304. ShowMessage('N не может быть меньше 3!');
  305. End
  306. Else
  307. if Not(CheckCells(Sender,CurEdit,CurStringGrid)) then
  308. Begin
  309. CheckInputFields:=false;
  310. CurStringGrid.SetFocus;
  311. ShowMessage('Заполните таблицу до конца!');
  312. End ;
  313. End
  314.  
  315.  
  316.  
  317. End;
  318.  
  319. Procedure TMainForm.XGridSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
  320. Var
  321. I: Integer;
  322. amount :extended;
  323. begin
  324. for I := 0 to XGrid.ColCount do
  325. begin
  326. if ((Not TryStrToFloat(XGrid.Cells[I, 0], amount)) and
  327. (XGrid.Cells[I, 0] <> '') and (XGrid.Cells[I, 0] <> '-')) then
  328. begin
  329. ShowMessage('Некорректные исходные данные!');
  330. XGrid.Cells[I, 0] := '';
  331. end
  332. Else
  333. if(XGrid.Cells[I, 0] <> '') and Not(CheckXArea(StrToFloat(XGrid.Cells[I, 0]),MAX_X,MIN_X)) then
  334. begin
  335. ShowMessage('Некорректные исходные данные!');
  336. XGrid.Cells[I, 0] := '';
  337. end;
  338. end;
  339.  
  340. end;
  341.  
  342.  
  343. procedure TMainForm.CalcResult(Sender:TObject);
  344. Var
  345. I,Count, N: Integer;
  346.  
  347. Begin
  348. N:=StrToInt(NEdit.Text);
  349. count:=0;
  350. For I := 1 To N - 2 Do
  351. If (XGrid.Cells[I - 1,0] < XGrid.Cells[I,0]) And (XGrid.Cells[I,0] < XGrid.Cells[I + 1,0] ) Then
  352. Count := Count + 1;
  353. ResultEdit.Text:=IntToStr(Count);
  354.  
  355.  
  356. End;
  357. procedure TMainForm.ResultButtonClick(Sender: TObject);
  358. begin
  359. If CheckInputFields(Sender,NEdit, XGrid) Then
  360. CalcResult(Sender);
  361. end;
  362. Var
  363. IsSave:Boolean=False;
  364. procedure TMainForm.SaveMenuClick(Sender: TObject);
  365. Var
  366. FilePath: String;
  367. F: TextFile;
  368. begin
  369. if (ResultEdit.Text<>'') then
  370. Begin
  371. if MySaveTextFileDialog.Execute then
  372. Begin
  373. FilePath:=MySaveTextFileDialog.FileName;
  374. AssignFile(F,FilePath);
  375. If FileIsReadOnly(FilePath) Then
  376. Application.MessageBox(PChar(ERRORS[ecNot_Writeable]),'Ошибка',MB_OK+MB_ICONERROR)
  377. Else
  378. Begin
  379. Rewrite(F);
  380. Write(F,' координаты точки: ()'#13#10'Радиус окружности: Ответ(Принадлежит ли точка окружности): ', ResultEdit.Text);
  381. CloseFile(F);
  382. IsSave:=True;
  383. End;
  384. End;
  385. End;
  386.  
  387.  
  388. end;
  389. procedure TMainForm.FileMenuClick(Sender: TObject);
  390. begin
  391. if ResultButton.Enabled then
  392. SaveMenu.Enabled:=true
  393. Else
  394. SaveMenu.Enabled:=false;
  395. end;
  396.  
  397. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  398. Var
  399. IsExit:Word;
  400. begin
  401. If Not IsSave And (ResultEdit.Text<>'') Then
  402. Begin
  403. IsExit:= Application.MessageBox('Вы не сохранили файл, хотите ли сохранить?','Выход',MB_YESNOCANCEL+MB_ICONQUESTION);
  404. case IsExit of
  405. mrYes:
  406. Begin
  407. CanClose:=False;
  408. FileMenu.Click;
  409. SaveMenu.Click;
  410. End;
  411.  
  412. mrNo:
  413. CanClose:=True;
  414. mrCancel:
  415. CanClose:=False;
  416. end;
  417.  
  418.  
  419. End
  420. Else
  421. Begin
  422. IsExit:= Application.MessageBox('Вы действительно хотите выйти?','Выход',MB_YESNO+MB_ICONQUESTION);
  423. case IsExit of
  424. mrYes:
  425. CanClose:=True;
  426. mrNo:
  427. CanClose:=False;
  428. end;
  429. End;
  430. end;
  431. procedure TMainForm.FormCreate(Sender: TObject);
  432. begin
  433. TaskLabel.Caption:= 'Данная программа подсчитывает количество таких троек'+#13#10+'последовательности х1, х2, …, хn, что xi-1<xi<xi+1';
  434. end;
  435. function TMainForm.CheckCells(Sender: TObject; CurEdit:TEdit;CurStringGrid:TStringGrid):Boolean;
  436. Var
  437. N,I:Integer;
  438. IsNotExist:Boolean;
  439. begin
  440. IsNotExist := true;
  441. for I := 0 to N do
  442. Begin
  443. if(CurStringGrid.Cells[I,0]='') then
  444. Begin
  445. IsNotExist := false;
  446. Break;
  447. End;
  448. End;
  449. CheckCells:=IsNotExist;
  450. end;
  451.  
  452.  
  453. procedure TMainForm.ExitMenuClick(Sender: TObject);
  454. Var
  455. IsExit:Word;
  456. begin
  457. If Not IsSave And (ResultEdit.Text<>'') Then
  458. Begin
  459. IsExit:= Application.MessageBox('Вы не сохранили файл, хотите ли сохранить?','Выход',MB_YESNOCANCEL+MB_ICONQUESTION);
  460. case IsExit of
  461. mrYes:
  462. SaveMenu.Click;
  463. mrNo:
  464. Close;
  465. end;
  466.  
  467.  
  468. End
  469. Else
  470. Begin
  471. IsExit:= Application.MessageBox('Вы действительно хотите выйти?','Выход',MB_YESNO+MB_ICONQUESTION);
  472. case IsExit of
  473. mrYes:
  474. Close;
  475. end;
  476. End;
  477. end;
  478.  
  479. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement