Advertisement
green1ant

form 1_1

Dec 20th, 2018
223
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.89 KB | None | 0 0
  1. unit Unit1;
  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.StdCtrls, Vcl.Menus, Vcl.ExtDlgs;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. lblInstruction: TLabel;
  12. edtName: TEdit;
  13. lblValidity: TLabel;
  14. lblResult: TLabel;
  15. mnMain: TMainMenu;
  16. mnItmHelp: TMenuItem;
  17. mnItmFile: TMenuItem;
  18. mnSbItemInputFromFile: TMenuItem;
  19. OpenTextFileDialog: TOpenTextFileDialog;
  20. SaveTextFileDialog: TSaveTextFileDialog;
  21. mnSbItmSaveToFile: TMenuItem;
  22. procedure edtNameChange(Sender: TObject);
  23. procedure edtNameKeyPress(Sender: TObject; var Key: Char);
  24. procedure mnItmHelpClick(Sender: TObject);
  25. procedure FormCreate(Sender: TObject);
  26. procedure mnSbItemInputFromFileClick(Sender: TObject);
  27. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  28. procedure mnSbItmSaveToFileClick(Sender: TObject);
  29. procedure edtNameKeyDown(Sender: TObject; var Key: Word;
  30. Shift: TShiftState);
  31. private
  32. { Private declarations }
  33. public
  34. { Public declarations }
  35. end;
  36.  
  37. var
  38. Form1: TForm1;
  39.  
  40. implementation
  41.  
  42. {$R *.dfm}
  43.  
  44. procedure ValidateInput(Name: string; out TextMessage: string);
  45. var
  46. Letters: set of Char;
  47. i: Integer;
  48. IsValid: Boolean;
  49. begin
  50. IsValid := True;
  51. Letters := ['a'..'z', 'A'..'Z'];
  52. for i := 1 to Length(Name) do
  53. if not (Name[i] in Letters) then
  54. IsValid := False;
  55.  
  56. TextMessage := '';
  57. if Name <> '' then
  58. if IsValid and (UpperCase(Name[1]) = Name[1]) then
  59. TextMessage := ''
  60. else
  61. TextMessage := 'Name should contain only letters (first letter should be uppercase)'
  62. else
  63. TextMessage := 'Name should contain only letters (first letter should be uppercase)';
  64. end;
  65.  
  66. procedure TForm1.edtNameChange(Sender: TObject);
  67. var
  68. s, ErrorMessage : string;
  69. Letters: set of Char;
  70. i: Integer;
  71. IsValid: Boolean;
  72. begin
  73. s := edtName.Text;
  74. ValidateInput(s, ErrorMessage);
  75. lblValidity.Caption := ErrorMessage;
  76. end;
  77.  
  78.  
  79. procedure TForm1.edtNameKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
  80. begin
  81. if ((ssCtrl in Shift) AND (Key = ord('V'))) then
  82. Key := 0;
  83. end;
  84.  
  85. procedure TForm1.edtNameKeyPress(Sender: TObject; var Key: Char);
  86. var
  87. Name: string;
  88. begin
  89. Name := edtName.Text;
  90. if key = #13 then
  91. if lblValidity.Caption = '' then
  92. if Name = 'Lynn' then
  93. lblResult.Caption := 'Hello Carolyn!'
  94. else
  95. if Name = 'Mike' then
  96. lblResult.Caption := 'Hello Michael!'
  97. else
  98. if Name = 'Bob' then
  99. lblResult.Caption := 'Hello Robert!'
  100. else
  101. if Name = 'Liz' then
  102. lblResult.Caption := 'Hello Elizabeth!'
  103. else
  104. if Name = 'Peg' then
  105. lblResult.Caption := 'Hello Margaret!'
  106. else
  107. lblResult.Caption := 'I DON''T KNOW YOU!';
  108. end;
  109.  
  110. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  111. var
  112. Answer: Integer;
  113. begin
  114. Answer := MessageBox(Handle, PChar('Вы действительно хотите выйти?'), PChar('Выйти?'), MB_OKCANCEL);
  115. if Answer = 2 then
  116. Action := TCloseAction.caNone
  117. end;
  118.  
  119. procedure TForm1.FormCreate(Sender: TObject);
  120. begin
  121. lblValidity.Caption := 'Name should contain only letters (first letter should be uppercase)';
  122. end;
  123.  
  124. procedure TForm1.mnSbItemInputFromFileClick(Sender: TObject);
  125. var
  126. InputFilePath, ErrorMessage: string;
  127. InputFile: TextFile;
  128. Input: string;
  129. begin
  130. OpenTextFileDialog.InitialDir := GetCurrentDir();
  131. OpenTextFileDialog.Title := 'Choose file to input data from';
  132. if OpenTextFileDialog.Execute then
  133. begin
  134. AssignFile(InputFile, OpenTextFileDialog.FileName);
  135. Reset(InputFile);
  136.  
  137. Read(InputFile, Input);
  138. ValidateInput(Input, ErrorMessage);
  139.  
  140. if ErrorMessage = '' then
  141. edtName.Text := Input
  142. else
  143. MessageDlg(ErrorMessage, mtError, [mbOk], 0);
  144.  
  145. CloseFile(InputFile);
  146. end;
  147. end;
  148.  
  149. procedure TForm1.mnSbItmSaveToFileClick(Sender: TObject);
  150. var
  151. OutputFile: TextFile;
  152. Greeting: string;
  153. begin
  154. SaveTextFileDialog.InitialDir := GetCurrentDir();
  155. SaveTextFileDialog.Title := 'Choose file to save data in';
  156.  
  157. if lblResult.Caption = '' then
  158. MessageDlg('You can''t output data cause of empty result', mtWarning, [mbOk], 0)
  159. else
  160.  
  161. if SaveTextFileDialog.Execute then
  162. begin
  163. AssignFile(OutputFile, SaveTextFileDialog.FileName);
  164. Rewrite(OutputFile);
  165.  
  166. Greeting := lblResult.Caption;
  167. Write(OutputFile, Greeting);
  168. CloseFile(OutputFile);
  169. end;
  170. end;
  171.  
  172. procedure TForm1.mnItmHelpClick(Sender: TObject);
  173. begin
  174. MessageDlg('This program can recognize and greet one of 5 friends', mtInformation, [mbOk], 0);
  175. end;
  176.  
  177. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement