Amorf

Untitled

Mar 16th, 2021
122
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 6.79 KB | None | 0 0
  1. unit Laba4_2;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     N1: TMenuItem;
  13.     N2: TMenuItem;
  14.     N5: TMenuItem;
  15.     N6: TMenuItem;
  16.     N3: TMenuItem;
  17.     N4: TMenuItem;
  18.     SaveDialog1: TSaveDialog;
  19.     OpenDialog1: TOpenDialog;
  20.     Label1: TLabel;
  21.     EditOfText: TEdit;
  22.     CalculateButton: TBitBtn;
  23.     LabelText: TLabel;
  24.     LabelOfResult: TLabel;
  25.     procedure N1Click(Sender: TObject);
  26.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  27.     procedure N3Click(Sender: TObject);
  28.     procedure N4Click(Sender: TObject);
  29.     procedure EditOfTextChange(Sender: TObject);
  30.     procedure EditOfTextKeyDown(Sender: TObject; var Key: Word;
  31.       Shift: TShiftState);
  32.     procedure EditOfTextKeyPress(Sender: TObject; var Key: Char);
  33.     procedure N6Click(Sender: TObject);
  34.     procedure N5Click(Sender: TObject);
  35.     function checkFile(path: string) : boolean;
  36.     procedure CalculateButtonClick(Sender: TObject);
  37.     procedure changeString (str : String);
  38.   private
  39.     { Private declarations }
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.  
  47. implementation
  48.  
  49. {$R *.dfm}
  50.  
  51. procedure TForm1.EditOfTextChange(Sender: TObject);
  52. begin
  53.     N6.Enabled := false;
  54.     LabelText.Caption := '';
  55.     LabelOfResult.Caption := '';
  56.     if EditOfText.Text <> '' then
  57.         CalculateButton.Enabled := true
  58.     else
  59.         CalculateButton.Enabled := false;
  60. end;
  61.  
  62. procedure TForm1.EditOfTextKeyDown(Sender: TObject; var Key: Word;
  63.   Shift: TShiftState);
  64. begin
  65.     if ((Key = ord('V')) and (ssCtrl in Shift)) or (Key = vk_insert) then
  66.         key := 0;
  67. end;
  68.  
  69. procedure TForm1.EditOfTextKeyPress(Sender: TObject; var Key: Char);
  70. begin
  71.     if NOT (Key in ['A','B','C',#8]) then
  72.         Key:=#0
  73. end;
  74.  
  75. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  76. begin
  77.     if MessageDlg('Вы действительно хотите выйти?',mtConfirmation,[mbYes,mbNo], 0) = mrYes then
  78.         CanClose := true
  79.     else
  80.         CanClose := false;
  81. end;
  82.  
  83. procedure TForm1.N1Click(Sender: TObject);
  84. begin
  85.     MessageDlg('Строка символов состоит из букв А, В и С.' + #13#10 + 'Разработать рекурсивную процедуру, преобразующую данную строку по правилам:' + #13#10 + 'а) удаляет четыре подряд идущих букв А;' + #13#10 + 'б) удаляет из последовательности ВАВА одну пару ВА;' + #13#10 + 'в) удаляет комбинацию АВС.' + #13#10 + 'Преобразования выполнять до тех пор, пока ни одной из перечисленных комбинаций не останется.', mtInformation, [mbOK], 0)
  86. end;
  87.  
  88. procedure TForm1.N3Click(Sender: TObject);
  89. begin
  90.     MessageDlg('Ввод текста' + #13#10 + #13#10 + 'Длина текста не должна превышать 20 символов.' + #13#10 + 'Строка не должна состоять только из пробелов', mtInformation, [mbOK], 0)
  91. end;
  92.  
  93. procedure TForm1.N4Click(Sender: TObject);
  94. begin
  95.     Form1.Close;
  96. end;
  97. procedure TForm1.changeString (str : String);
  98. begin
  99.     if Pos('AAAA',str) <> 0 then
  100.     begin
  101.         Delete(str,Pos('AAAA',str),4);
  102.         changeString (str);
  103.     end
  104.     else if Pos('BABA',str) <> 0 then
  105.     begin
  106.         Delete(str,Pos('BABA',str),2);
  107.         changeString (str);
  108.     end
  109.     else if Pos('ABC',str) <> 0 then
  110.     begin
  111.         Delete(str,Pos('ABC',str),3);
  112.         changeString (str);
  113.     end
  114.     else
  115.     begin
  116.         LabelText.Caption := 'Строка после преобразований имеет вид:';
  117.         LabelOfResult.Caption := str;
  118.     end;
  119. end;
  120. procedure TForm1.CalculateButtonClick(Sender: TObject);
  121. var
  122.     str : String;
  123. begin
  124.     str := EditOfText.Text;
  125.     changeString(str);
  126.     N6.Enabled := true;
  127. end;
  128.  
  129. function TForm1.checkFile(path: string) : boolean;
  130. var
  131.     myFile: TextFile;
  132.     temp : String;
  133.     isCorrect : boolean;
  134.     i : integer;
  135.  
  136. begin
  137.     isCorrect := True;
  138.     try
  139.         AssignFile(myFile, path);
  140.         Reset(myFile);
  141.     except
  142.         isCorrect := False;
  143.         MessageDlg('Ошибка доступа к файлу с записями. Измените атрибуты в свойствах файла', mtError, [mbOK], 0);
  144.     end;
  145.     if isCorrect and seekEOF(MyFile) then
  146.     Begin
  147.         isCorrect := False;
  148.         MessageDlg('Файл пуст. Выберите другой файл или введите данные вручную', mtError, [mbOK], 0);
  149.     End;
  150.     if isCorrect then
  151.     begin
  152.         read(myFile,temp);
  153.         if length(temp) > 20 then
  154.         begin
  155.             isCorrect := false;
  156.             MessageDlg('Данные в файле некорректны. Выберите другой файл или введите данные вручную', mtError, [mbOK], 0);
  157.         end;
  158.         i := 0;
  159.         while IsCorrect and (i < length(temp)) do
  160.         begin
  161.             if (temp[i] <> 'A') or (temp[i] <> 'B') or (temp[i] <> 'C') then
  162.                 IsCorrect := false;
  163.             inc(i);
  164.         end;
  165.  
  166.     end;
  167.     closeFile(myFile);
  168.     checkFile := isCorrect;
  169. End;
  170.  
  171. procedure TForm1.N5Click(Sender: TObject);
  172. var
  173.     myFile: TextFile;
  174.     str : String;
  175.     isCorrect : boolean;
  176. begin
  177.     LabelText.Caption := '';
  178.     LabelOfResult.Caption := '';
  179.     EditOfText.Text := '';
  180.     if OpenDialog1.Execute then
  181.     begin
  182.         isCorrect := checkFile(OpenDialog1.FileName);
  183.         if isCorrect then
  184.         Begin
  185.             AssignFile(myFile, OpenDialog1.FileName);
  186.             Reset(myFile);
  187.             Readln(myFile, str);
  188.             EditOfText.Text := str;
  189.         End;
  190.         closeFile(myFile);
  191.     end;
  192. end;
  193.  
  194. procedure TForm1.N6Click(Sender: TObject);
  195. var
  196.     myFile: TextFile;
  197.     isCorrect : boolean;
  198. begin
  199.     isCorrect := true;
  200.     if SaveDialog1.Execute then
  201.     begin
  202.         try
  203.             AssignFile(myFile, SaveDialog1.FileName);
  204.             Rewrite(myFile);
  205.         except
  206.             isCorrect := False;
  207.             MessageDlg('Ошибка доступа к файлу с записями. Измените атрибуты в свойствах файла', mtError, [mbOK], 0);
  208.         end;
  209.         if isCorrect then
  210.         begin
  211.             write(MyFile,LabelText.Caption + LabelOfResult.Caption);
  212.             MessageDlg('Данные записаны в файл', mtInformation, [mbOK], 0);
  213.             closeFile(myFile);
  214.         end;
  215.     end;
  216. end;
  217.  
  218. end.
Advertisement
Add Comment
Please, Sign In to add comment