Advertisement
Amorf

Untitled

Mar 16th, 2021
130
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.15 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.     Form1.ClientHeight := 108;
  55.     LabelText.Caption := '';
  56.     LabelOfResult.Caption := '';
  57.     if EditOfText.Text <> '' then
  58.         CalculateButton.Enabled := true
  59.     else
  60.         CalculateButton.Enabled := false;
  61. end;
  62.  
  63. procedure TForm1.EditOfTextKeyDown(Sender: TObject; var Key: Word;
  64.   Shift: TShiftState);
  65. begin
  66.     if ((Key = ord('V')) and (ssCtrl in Shift)) or (Key = vk_insert) then
  67.         key := 0;
  68. end;
  69.  
  70. procedure TForm1.EditOfTextKeyPress(Sender: TObject; var Key: Char);
  71. begin
  72.     if NOT (Key in ['A','B','C',#8]) then
  73.         Key:=#0
  74. end;
  75.  
  76. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  77. begin
  78.     if MessageDlg('Вы действительно хотите выйти?',mtConfirmation,[mbYes,mbNo], 0) = mrYes then
  79.         CanClose := true
  80.     else
  81.         CanClose := false;
  82. end;
  83.  
  84. procedure TForm1.N1Click(Sender: TObject);
  85. begin
  86.     MessageDlg('Строка символов состоит из букв А, В и С.' + #13#10 + 'Разработать рекурсивную процедуру, преобразующую данную строку по правилам:' + #13#10 + 'а) удаляет четыре подряд идущих букв А;' + #13#10 + 'б) удаляет из последовательности ВАВА одну пару ВА;' + #13#10 + 'в) удаляет комбинацию АВС.' + #13#10 + 'Преобразования выполнять до тех пор, пока ни одной из перечисленных комбинаций не останется.', mtInformation, [mbOK], 0)
  87. end;
  88.  
  89. procedure TForm1.N3Click(Sender: TObject);
  90. begin
  91.     MessageDlg('Ввод текста' + #13#10 + #13#10 + 'Длина текста не должна превышать 20 символов.' + #13#10 + 'Строка не должна состоять только из пробелов', mtInformation, [mbOK], 0)
  92. end;
  93.  
  94. procedure TForm1.N4Click(Sender: TObject);
  95. begin
  96.     Form1.Close;
  97. end;
  98. procedure TForm1.changeString (str : String);
  99. begin
  100.     if Pos('AAAA',str) <> 0 then
  101.     begin
  102.         Delete(str,Pos('AAAA',str),4);
  103.         changeString (str);
  104.     end
  105.     else if Pos('BABA',str) <> 0 then
  106.     begin
  107.         Delete(str,Pos('BABA',str),2);
  108.         changeString (str);
  109.     end
  110.     else if Pos('ABC',str) <> 0 then
  111.     begin
  112.         Delete(str,Pos('ABC',str),3);
  113.         changeString (str);
  114.     end
  115.     else if length(str) = 0 then
  116.         LabelText.Caption := 'Строка пуста'
  117.     else
  118.     begin
  119.         LabelText.Caption := 'Строка после преобразований имеет вид:';
  120.         LabelOfResult.Caption := str;
  121.     end;
  122. end;
  123. procedure TForm1.CalculateButtonClick(Sender: TObject);
  124. var
  125.     str : String;
  126. begin
  127.     str := EditOfText.Text;
  128.     changeString(str);
  129.     Form1.ClientHeight := 155;
  130.     N6.Enabled := true;
  131. end;
  132.  
  133. function TForm1.checkFile(path: string) : boolean;
  134. var
  135.     myFile: TextFile;
  136.     temp,temp2 : String;
  137.     isCorrect : boolean;
  138.     i : integer;
  139.  
  140. begin
  141.     isCorrect := True;
  142.     try
  143.         AssignFile(myFile, path);
  144.         Reset(myFile);
  145.     except
  146.         isCorrect := False;
  147.         MessageDlg('Ошибка доступа к файлу с записями. Измените атрибуты в свойствах файла', mtError, [mbOK], 0);
  148.     end;
  149.     if isCorrect and seekEOF(MyFile) then
  150.     Begin
  151.         isCorrect := False;
  152.         MessageDlg('Файл пуст. Выберите другой файл или введите данные вручную', mtError, [mbOK], 0);
  153.     End;
  154.     if isCorrect then
  155.     begin
  156.         read(myFile,temp);
  157.         if length(temp) > 20 then
  158.         begin
  159.             isCorrect := false;
  160.             MessageDlg('Данные в файле некорректны. Выберите другой файл или введите данные вручную', mtError, [mbOK], 0);
  161.         end;
  162.         i := 1;
  163.         while IsCorrect and (i < length(temp)) do
  164.         begin
  165.             if (temp[i] <> 'A') and (temp[i] <> 'B') and (temp[i] <> 'C') then
  166.             begin
  167.                 IsCorrect := false;
  168.                 MessageDlg('Данные в файле некорректны. Выберите другой файл или введите данные вручную', mtError, [mbOK], 0);
  169.             end;
  170.             inc(i);
  171.         end;
  172.     end;
  173.     closeFile(myFile);
  174.     checkFile := isCorrect;
  175. End;
  176.  
  177. procedure TForm1.N5Click(Sender: TObject);
  178. var
  179.     myFile: TextFile;
  180.     str : String;
  181.     isCorrect : boolean;
  182. begin
  183.     LabelText.Caption := '';
  184.     LabelOfResult.Caption := '';
  185.     EditOfText.Text := '';
  186.     if OpenDialog1.Execute then
  187.     begin
  188.         isCorrect := checkFile(OpenDialog1.FileName);
  189.         if isCorrect then
  190.         Begin
  191.             AssignFile(myFile, OpenDialog1.FileName);
  192.             Reset(myFile);
  193.             Readln(myFile, str);
  194.             EditOfText.Text := str;
  195.         End;
  196.     end;
  197. end;
  198.  
  199. procedure TForm1.N6Click(Sender: TObject);
  200. var
  201.     myFile: TextFile;
  202.     isCorrect : boolean;
  203. begin
  204.     isCorrect := true;
  205.     if SaveDialog1.Execute then
  206.     begin
  207.         try
  208.             AssignFile(myFile, SaveDialog1.FileName);
  209.             Rewrite(myFile);
  210.         except
  211.             isCorrect := False;
  212.             MessageDlg('Ошибка доступа к файлу с записями. Измените атрибуты в свойствах файла', mtError, [mbOK], 0);
  213.         end;
  214.         if isCorrect then
  215.         begin
  216.             write(MyFile,LabelText.Caption + LabelOfResult.Caption);
  217.             MessageDlg('Данные записаны в файл', mtInformation, [mbOK], 0);
  218.             closeFile(myFile);
  219.         end;
  220.     end;
  221. end;
  222.  
  223. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement