home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue149 / delphi / copydelp.exe / StrPrj / strtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-27  |  6.4 KB  |  227 lines
  1. unit Strtest;
  2.  
  3. (* PC Plus sample application illustrating some Delphi string-handling
  4.    routines. Some of these are standard functions. Others are included in
  5.    our unit, Strutils, which has been added to the 'uses' section.
  6.  
  7.    Note: This project is compatible with all versions of Delphi
  8.    from Delphi 1 on...
  9. *)
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, StdCtrls,
  15.   Strutils, ExtCtrls;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     Panel1: TPanel;
  20.     Label9: TLabel;
  21.     InputEdit: TEdit;
  22.     Label1: TLabel;
  23.     OutputEdit: TEdit;
  24.     Panel2: TPanel;
  25.     trimLeftBtn: TButton;
  26.     trimRightBtn: TButton;
  27.     trimEndsBtn: TButton;
  28.     firstrestBtn: TButton;
  29.     LengthPasBtn: TButton;
  30.     UpperCaseBtn: TButton;
  31.     LowerCaseBtn: TButton;
  32.     InitialCapBtn: TButton;
  33.     LowLeftBtn: TButton;
  34.     UpRightBtn: TButton;
  35.     ToggleTextBtn: TButton;
  36.     CloseBtn: TButton;
  37.     EncryptBtn: TButton;
  38.     DecryptBtn: TButton;
  39.     ParseBtn: TButton;
  40.     ChangeCaseBtn: TButton;
  41.     TrimLSpacesBtn: TButton;
  42.     TrimRPunctuationBtn: TButton;
  43.     procedure trimLeftBtnClick(Sender: TObject);
  44.     procedure trimRightBtnClick(Sender: TObject);
  45.     procedure trimEndsBtnClick(Sender: TObject);
  46.     procedure LengthPasBtnClick(Sender: TObject);
  47.     procedure UpperCaseBtnClick(Sender: TObject);
  48.     procedure LowerCaseBtnClick(Sender: TObject);
  49.     procedure firstrestBtnClick(Sender: TObject);
  50.     procedure InitialCapBtnClick(Sender: TObject);
  51.     procedure CloseBtnClick(Sender: TObject);
  52.     procedure ToggleTextBtnClick(Sender: TObject);
  53.     procedure UpRightBtnClick(Sender: TObject);
  54.     procedure LowLeftBtnClick(Sender: TObject);
  55.     procedure FormActivate(Sender: TObject);
  56.     procedure EncryptBtnClick(Sender: TObject);
  57.     procedure DecryptBtnClick(Sender: TObject);
  58.     procedure ParseBtnClick(Sender: TObject);
  59.     procedure ChangeCaseBtnClick(Sender: TObject);
  60.     procedure TrimLSpacesBtnClick(Sender: TObject);
  61.     procedure TrimRPunctuationBtnClick(Sender: TObject);
  62.   private
  63.     { Private declarations }
  64.   public
  65.     { Public declarations }
  66.   end;
  67.  
  68. var
  69.   Form1: TForm1;
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74.  
  75. procedure TForm1.trimLeftBtnClick(Sender: TObject);
  76. begin
  77.   OutputEdit.Text := '"' + trimLeftStr(InputEdit.Text) + '"';
  78. end;
  79.  
  80. procedure TForm1.trimRightBtnClick(Sender: TObject);
  81. begin
  82.   OutputEdit.Text := '"' + trimRightStr(InputEdit.Text) + '"';
  83. end;
  84.  
  85. procedure TForm1.trimEndsBtnClick(Sender: TObject);
  86. begin
  87.   OutputEdit.Text := '"' + trimEndsStr(InputEdit.Text) + '"';
  88. end;
  89.  
  90. procedure TForm1.LengthPasBtnClick(Sender: TObject);
  91. { Length is a standard function }
  92. var
  93.   s : string;
  94. begin
  95.   s := InputEdit.Text;
  96.   MessageDlg('INFORMATION!'  { Note: CRLF Const is defined in StrUtils unit }
  97.          + CRLF + 'Length of "' + s + '" is: ' + IntToStr(Length(s)) + '.',
  98.   mtConfirmation, [mbOK], 0);
  99. end;
  100.  
  101. procedure TForm1.UpperCaseBtnClick(Sender: TObject);
  102. { Uppercase is a standard function }
  103. begin
  104.   OutputEdit.Text := '"' + UpperCase(InputEdit.Text) + '"';
  105. end;
  106.  
  107. procedure TForm1.LowerCaseBtnClick(Sender: TObject);
  108. { Lowercase is a standard function }
  109. begin
  110.   OutputEdit.Text := '"' + LowerCase(InputEdit.Text) + '"';
  111. end;
  112.  
  113. procedure TForm1.firstrestBtnClick(Sender: TObject);
  114. { The firstrestStr function is in StrUtils.pas }
  115. var
  116.   s, f, r : string;
  117. begin
  118.   s := InputEdit.text;
  119.   firstrestStr( s, f, r );
  120.   OutputEdit.text := 'first="' + f + '" Rest="' + r + '"';
  121. end;
  122.  
  123. procedure TForm1.InitialCapBtnClick(Sender: TObject);
  124. { uses our firstrestStr function to parse the words from a string.
  125.   each word is then capitalised and copied into a new string. }
  126. var
  127.    inputStr, outputStr, f, r : string;
  128. begin
  129.    inputStr := TrimEndsStr(InputEdit.Text);
  130.    outputStr := '';
  131.      { loop through string, until there are no more words to be parsed }
  132.    while inputStr <> '' do
  133.    begin
  134.      firstrestStr(inputStr, f, r );   { parse 1st word, f, from string }
  135.      f[1] := UpCase(f[1]);            { capitalise initial char of f   }
  136.      outputStr := outputStr + f;      { append f to output string      }
  137.      inputStr := r;
  138.      if inputStr <> '' then           { place spaces between the words }
  139.         outputStr := outputStr + ' '; { we copy to the output string   }
  140.    end;
  141.    OutputEdit.Text := '"' + outputStr + '"';
  142. end;
  143.  
  144. procedure TForm1.CloseBtnClick(Sender: TObject);
  145. begin
  146.   Close;
  147. end;
  148.  
  149. procedure TForm1.ToggleTextBtnClick(Sender: TObject);
  150. { place some text into InputEdit for testing purposes }
  151. const
  152.   TestText = '   . !Hello, to  ALL; our Readers  .!?';
  153. begin
  154.   if InputEdit.Text = TestText then
  155.   begin
  156.      InputEdit.Text := '';
  157.      ToggleTextBtn.Caption := 'Fill &Input';
  158.   end
  159.   else
  160.   begin
  161.     InputEdit.Text := TestText;
  162.     ToggleTextBtn.Caption := 'Clear &Input';
  163.   end;
  164. end;
  165.  
  166. procedure TForm1.UpRightBtnClick(Sender: TObject);
  167. begin
  168.   OutputEdit.text := '"' + UpperCase(trimRightStr(InputEdit.text)) + '"';
  169. end;
  170.  
  171. procedure TForm1.LowLeftBtnClick(Sender: TObject);
  172. begin
  173.   OutputEdit.text := '"' + LowerCase(trimLeftStr(InputEdit.text)) + '"';
  174. end;
  175.  
  176. procedure TForm1.FormActivate(Sender: TObject);
  177. begin
  178.   ToggleTextBtnClick(Sender);
  179. end;
  180.  
  181. procedure TForm1.EncryptBtnClick(Sender: TObject);
  182. begin
  183.    OutputEdit.Text := Encrypt(InputEdit.Text, 7);
  184. end;
  185.  
  186. procedure TForm1.DecryptBtnClick(Sender: TObject);
  187. begin
  188.    OutputEdit.Text := Decrypt(OutputEdit.Text, 7);
  189. end;
  190.  
  191. procedure TForm1.ParseBtnClick(Sender: TObject);
  192. { Important: You must create a valid string list before
  193.   calling the parse() function. See the notes in
  194.   StrUtils.pas }
  195. var
  196.    ts : TStringList;
  197.    msg : string;
  198.    i : integer;
  199. begin
  200.    ts := TStringList.Create;
  201.    msg := '';
  202.    parse( InputEdit.Text, ts );
  203.    if ts.Count > 0 then
  204.    for i := 0 to ts.Count - 1 do
  205.        msg := msg + ' [' + ts[i] + '] '
  206.    else ShowMessage( 'No strings were parsed!' );
  207.    ts.Free;
  208.    OutputEdit.Text := msg;
  209. end;
  210.  
  211. procedure TForm1.ChangeCaseBtnClick(Sender: TObject);
  212. begin
  213.   OutputEdit.Text := ChangeCase( InputEdit.Text );
  214. end;
  215.  
  216. procedure TForm1.TrimLSpacesBtnClick(Sender: TObject);
  217. begin
  218.    OutputEdit.Text := '"' + removeLeadChars( InputEdit.Text, [' ',#8] ) + '"';
  219. end;
  220.  
  221. procedure TForm1.TrimRPunctuationBtnClick(Sender: TObject);
  222. begin
  223.    OutputEdit.Text := '"' + removeTrailingChars( InputEdit.Text, ['!','.','?'] ) + '"';
  224. end;
  225.  
  226. end.
  227.