home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / unity / d3456 / JBSTR.ZIP / TESTSTR1.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2000-07-09  |  13.7 KB  |  468 lines
  1. unit TestStr1;
  2.  
  3. {
  4. (c) 1998-99 Jaro Benes, All Right Reserved
  5.  
  6. Test program for specific routines from jbStr.Pas module
  7. }
  8.  
  9. interface
  10.  
  11. uses
  12.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  13.   Forms, Dialogs, StdCtrls, ExtCtrls;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     Panel1: TPanel;
  18.     _ShortPath: TButton;
  19.     _ShortFileName: TButton;
  20.     _FileNameOnly: TButton;
  21.     _TrimRight: TButton;
  22.     _TrimBoth: TButton;
  23.     _TrimLeft: TButton;
  24.     _PadRight: TButton;
  25.     _Center: TButton;
  26.     _PadLeft: TButton;
  27.     _ExtensionOnly: TButton;
  28.     _NameOnly: TButton;
  29.     _PathOnly: TButton;
  30.     _Capitalize: TButton;
  31.     _StrLoCase: TButton;
  32.     _StrUpCase: TButton;
  33.     Label2: TLabel;
  34.     Label1: TLabel;
  35.     Label3: TLabel;
  36.     Button3: TButton;
  37.     Bevel1: TBevel;
  38.     Bevel2: TBevel;
  39.     Label4: TLabel;
  40.     _Zip: TButton;
  41.     _Smash: TButton;
  42.     _Change: TButton;
  43.     _Form: TButton;
  44.     _Strip: TButton;
  45.     _InsertWord: TButton;
  46.     _Push: TButton;
  47.     _Hash: TButton;
  48.     _MaskAndZeroClip: TButton;
  49.     _Count: TButton;
  50.     _PopWord: TButton;
  51.     _ExtractWord: TButton;
  52.     _GetPosition: TButton;
  53.     _GetEnd: TButton;
  54.     _WordCount: TButton;
  55.     _ChangeWord: TButton;
  56.     _GetLastWord: TButton;
  57.     _GetFirstWord: TButton;
  58.     _Romanum: TButton;
  59.     _ExtractEmail: TButton;
  60.     Label5: TLabel;
  61.     _Alter: TButton;
  62.     _Reduce: TButton;
  63.     _ExtractNumber: TButton;
  64.     _FindWord: TButton;
  65.     _JoinTo: TButton;
  66.     Panel2: TPanel;
  67.     procedure _StrUpCaseClick(Sender: TObject);
  68.     procedure _StrLoCaseClick(Sender: TObject);
  69.     procedure _CapitalizeClick(Sender: TObject);
  70.     procedure _PathOnlyClick(Sender: TObject);
  71.     procedure _NameOnlyClick(Sender: TObject);
  72.     procedure _ExtensionOnlyClick(Sender: TObject);
  73.     procedure _FileNameOnlyClick(Sender: TObject);
  74.     procedure _ShortPathClick(Sender: TObject);
  75.     procedure _ShortFileNameClick(Sender: TObject);
  76.     procedure Button3Click(Sender: TObject);
  77.     procedure _TrimLeftClick(Sender: TObject);
  78.     procedure _TrimBothClick(Sender: TObject);
  79.     procedure _TrimRightClick(Sender: TObject);
  80.     procedure _PadLeftClick(Sender: TObject);
  81.     procedure _CenterClick(Sender: TObject);
  82.     procedure _PadRightClick(Sender: TObject);
  83.     procedure _ZipClick(Sender: TObject);
  84.     procedure _ChangeClick(Sender: TObject);
  85.     procedure _SmashClick(Sender: TObject);
  86.     procedure _StripClick(Sender: TObject);
  87.     procedure _FormClick(Sender: TObject);
  88.     procedure _InsertWordClick(Sender: TObject);
  89.     procedure _PushClick(Sender: TObject);
  90.     procedure _HashClick(Sender: TObject);
  91.     procedure _MaskAndZeroClipClick(Sender: TObject);
  92.     procedure _CountClick(Sender: TObject);
  93.     procedure _ExtractWordClick(Sender: TObject);
  94.     procedure _PopWordClick(Sender: TObject);
  95.     procedure _GetPositionClick(Sender: TObject);
  96.     procedure _GetEndClick(Sender: TObject);
  97.     procedure _WordCountClick(Sender: TObject);
  98.     procedure _ChangeWordClick(Sender: TObject);
  99.     procedure _GetLastWordClick(Sender: TObject);
  100.     procedure _GetFirstWordClick(Sender: TObject);
  101.     procedure _RomanumClick(Sender: TObject);
  102.     procedure _ExtractEmailClick(Sender: TObject);
  103.     procedure _AlterClick(Sender: TObject);
  104.     procedure _ReduceClick(Sender: TObject);
  105.     procedure _ExtractNumberClick(Sender: TObject);
  106.     procedure _FindWordClick(Sender: TObject);
  107.     procedure _JoinToClick(Sender: TObject);
  108.   private
  109.     { Private declarations }
  110.   public
  111.     { Public declarations }
  112.   end;
  113.  
  114. var
  115.   Form1: TForm1;
  116.  
  117. implementation
  118.  
  119. {$R *.DFM}
  120.  
  121. Uses JbStr;
  122.  
  123. procedure TForm1.Button3Click(Sender: TObject);
  124. begin
  125.   Close
  126. end;
  127.  
  128. {using constant for test pass}
  129. {Czech code is possible change, table definition is included in pascal text
  130.  and size is 8*128 byte on data}
  131. Const
  132.   cname='Joachim Abraham èikula °eΦen² èamÜuliΦφ°φnek';
  133.   sname=#1#1#1#1#1#1#1#1#1#1'Joachim èikula'+#1#1#1#1#1#1#1#1#1#1;
  134.   fname='c:\upro\libr\great\test\m1y\set\as\test\my.doc';
  135.  
  136. procedure TForm1._StrUpCaseClick(Sender: TObject);
  137. begin
  138.   Label4.Caption:=cname;
  139.   Label3.Caption:='"'+Label4.Caption+'"';
  140.   Label4.Caption:='"'+StrUpCase(Label4.Caption)+'"';
  141.   Label5.Caption:='Mask ()';
  142. end;
  143.  
  144. procedure TForm1._StrLoCaseClick(Sender: TObject);
  145. begin
  146.   Label4.Caption:=cname;
  147.   Label3.Caption:='"'+Label4.Caption+'"';
  148.   Label4.Caption:='"'+StrLoCase(Label4.Caption)+'"';
  149.   Label5.Caption:='Mask ('+''+')'
  150. end;
  151.  
  152. procedure TForm1._CapitalizeClick(Sender: TObject);
  153. begin
  154.   Label4.Caption:=StrLoCase(sname);
  155.   Label3.Caption:='"'+Trim(Label4.Caption)+'"';
  156.   Label4.Caption:='"'+CapitalizeWord(Trim(Label4.Caption))+'"';
  157.   Label5.Caption:='Mask ('+''+')';
  158. end;
  159.  
  160. procedure TForm1._PathOnlyClick(Sender: TObject);
  161. begin
  162.   Label4.Caption := fname;
  163.   Label3.Caption:='"'+Label4.Caption+'"';
  164.   Label4.Caption:='"'+JustPathName(Label4.Caption)+'"';
  165.   Label5.Caption:='Mask ('+''+')';
  166. end;
  167.  
  168. procedure TForm1._NameOnlyClick(Sender: TObject);
  169. begin
  170.   Label4.Caption := fname;
  171.   Label3.Caption:='"'+Label4.Caption+'"';
  172.   Label4.Caption:='"'+JustName(Label4.Caption)+'"';
  173.   Label5.Caption:='Mask ('+''+')';
  174. end;
  175.  
  176. procedure TForm1._ExtensionOnlyClick(Sender: TObject);
  177. begin
  178.   Label4.Caption := fname;
  179.   Label3.Caption:='"'+Label4.Caption+'"';
  180.   Label4.Caption:='"'+JustExtension(Label4.Caption)+'"';
  181.   Label5.Caption:='Mask ('+''+')';
  182. end;
  183.  
  184. procedure TForm1._FileNameOnlyClick(Sender: TObject);
  185. begin
  186.   Label4.Caption := fname;
  187.   Label3.Caption:='"'+Label4.Caption+'"';
  188.   Label4.Caption:='"'+JustFileName(Label4.Caption)+'"';
  189.   Label5.Caption:='Mask ('+''+')';
  190. end;
  191.  
  192. procedure TForm1._ShortPathClick(Sender: TObject);
  193. begin
  194.   Label4.Caption := fname;
  195.   Label3.Caption:='"'+Label4.Caption+'"';
  196.   Label4.Caption:='"'+ShortDirName(25,Label4.Caption)+'"';
  197.   Label5.Caption:='Mask ('+''+')';
  198. end;
  199.  
  200. procedure TForm1._ShortFileNameClick(Sender: TObject);
  201. begin
  202.   Label4.CAPTION := fname;
  203.   Label3.Caption:='"'+Label4.Caption+'"';
  204.   Label4.Caption:='"'+ShortFileName(25,Label4.Caption)+'"';
  205.   Label5.Caption:='Mask ('+''+')';
  206. end;
  207.  
  208.  
  209. procedure TForm1._TrimLeftClick(Sender: TObject);
  210. begin
  211.   Label4.Caption:=sname;
  212.   Label3.Caption:='"'+Label4.Caption+'"';
  213.   Label4.Caption:='"'+TrimLead(Label4.Caption)+'"';
  214.   Label5.Caption:='Mask ('+''+')';
  215. end;
  216.  
  217. procedure TForm1._TrimBothClick(Sender: TObject);
  218. begin
  219.   Label4.Caption:=sname;
  220.   Label3.Caption:='"'+Label4.Caption+'"';
  221.   Label4.Caption:='"'+Trim(Label4.Caption)+'"';
  222.   Label5.Caption:='Mask ('+''+')';
  223. end;
  224.  
  225. procedure TForm1._TrimRightClick(Sender: TObject);
  226. begin
  227.   Label4.Caption:=sname;
  228.   Label3.Caption:='"'+Label4.Caption+'"';
  229.   Label4.Caption:='"'+TrimTrail(Label4.Caption)+'"';
  230.   Label5.Caption:='Mask ('+''+')';
  231. end;
  232.  
  233. procedure TForm1._PadLeftClick(Sender: TObject);
  234. begin
  235.   Label4.Caption:=Trim(sname);
  236.   Label3.Caption:='"'+Label4.Caption+'"';
  237.   Label4.Caption:='"'+LeftPadCh(Label4.Caption,'_',24)+'"';
  238.   Label5.Caption:='Mask ('+''+')';
  239. end;
  240.  
  241. procedure TForm1._CenterClick(Sender: TObject);
  242. begin
  243.   Label4.Caption:=Trim(sname);
  244.   Label3.Caption:='"'+Label4.Caption+'"';
  245.   Label4.Caption:=CenterCh(Label4.Caption,'_',34);
  246.   Label5.Caption:='Mask ('+''+')';
  247. end;
  248.  
  249. procedure TForm1._PadRightClick(Sender: TObject);
  250. begin
  251.   Label4.Caption:=Trim(sname);
  252.   Label3.Caption:='"'+Label4.Caption+'"';
  253.   Label4.Caption:=PadCh(Label4.Caption,'_',24);
  254.   Label5.Caption:='Mask ('+''+')';
  255. end;
  256.  
  257. procedure TForm1._ZipClick(Sender: TObject);
  258. begin
  259.   Label4.Caption:='1234567899955881236AH33';
  260.   Label3.Caption:='"'+Label4.Caption+'"';
  261.   Label4.Caption:='"'+Zip('XXX,XXX,XXX $ XX.XX.XX/XX XX - XX-XX',Label4.Caption)+'"';
  262.   Label5.Caption:='Mask ('+'"XXX,XXX,XXX $ XX.XX.XX/XX XX - XX-XX"'+')';
  263. end;
  264.  
  265. procedure TForm1._ChangeClick(Sender: TObject);
  266. begin
  267.   Label4.Caption:='Kokorokokoo';
  268.   Label3.Caption:='"'+Label4.Caption+'"';
  269.   Label4.Caption:='"'+Change(Label4.Caption,'o','u')+'"';
  270.   Label5.Caption:='Mask ('+'"o"-->"u"'+')';
  271. end;
  272.  
  273. procedure TForm1._SmashClick(Sender: TObject);
  274. begin
  275.   Label4.Caption:='     CU     11  A.  123456   , 11';
  276.   Label3.Caption:='"'+Label4.Caption+'"';
  277.   Label4.Caption:='"'+Smash(' ',Label4.Caption)+'"';
  278.   Label5.Caption:='Mask ('+'" "'+')';
  279. end;
  280.  
  281. procedure TForm1._StripClick(Sender: TObject);
  282. begin
  283.   Label4.Caption:='sedesCU.....11.aA.--123456 as,L11';
  284.   Label3.Caption:='"'+Label4.Caption+'"';
  285.   Label4.Caption:='"'+Strip('     XX     XX  XX  XXXXXX   X XX',Label4.Caption)+'"';
  286.   Label5.Caption:='Mask ('+'"     XX     XX  XX  XXXXXX   X XX"'+')';
  287. end;
  288.  
  289. procedure TForm1._FormClick(Sender: TObject);
  290. begin
  291.   Label3.Caption:='"0.15639"';
  292.   Label4.Caption:='"'+Form('XX.XXXX',0.15639)+'"';
  293.   Label5.Caption:='Mask ('+'XX.XXXX'+')';
  294. end;
  295.  
  296. procedure TForm1._InsertWordClick(Sender: TObject);
  297. begin
  298.   Label3.Caption:='"Lidaeip"';
  299.   Label4.Caption:='"'+InsWord('aei','oo','Lidaeip')+'"';
  300.   Label5.Caption:='Mask ('+'"aei"-->"oo"'+')';
  301. end;
  302.  
  303. procedure TForm1._PushClick(Sender: TObject);
  304. begin
  305.   Label3.Caption:='"Lidoop"';
  306.   Label4.Caption:='"'+Push(12,'Paar','Lidoop')+'"';
  307.   Label5.Caption:='Mask ('+''+')';
  308. end;
  309.  
  310. procedure TForm1._HashClick(Sender: TObject);
  311. begin
  312.   Label3.Caption:='"Lidoop"';
  313.   Label4.Caption:='"'+Long2Str(Hash('Lidoop'))+'"';
  314.   Label5.Caption:='Mask ('+''+')';
  315. end;
  316.  
  317. procedure TForm1._MaskAndZeroClipClick(Sender: TObject);
  318. Var Next:Byte;
  319. begin
  320.   Next:=1;
  321.   Label3.Caption:='"JEDN-0031-12345"';
  322.   Label4.Caption:='"'+
  323.     ZeroClip(Mask('y','uuuu-yyyy=iiiii','JEDN-0031-12345',Next))+'"';
  324.   Label5.Caption:='Mask ('+'uuuu-yyyy=iiiii'+')';
  325. end;
  326.  
  327. procedure TForm1._CountClick(Sender: TObject);
  328. Var S,S1,S2:String;
  329.   Posic,Len:Byte;
  330. begin
  331.   S := 'This is string for "change" or "store".';
  332.   S1:='';S2:='';
  333.   Label3.Caption:='"'+S+'"';
  334.   Posic := 0;
  335.   {Note: this is use for special scanning for telecomunicacions servicies}
  336.   While Count('"',S,Posic,Len) Do Begin
  337.      If S1='' Then Begin
  338.        S1:=Copy(Copy(S,Posic+Len,255),1,Pos('"',Copy(S,Posic+Len,255))-1);
  339.        Inc(Posic,Length(S1)+1);
  340.      End
  341.      Else
  342.        If S2='' Then Begin
  343.          S2:=Copy(Copy(S,Posic+Len,255),1,Pos('"',Copy(S,Posic+Len,255))-1);
  344.          Break;
  345.        End;
  346.      Inc(Posic,Len) {for skip over "}
  347.   End;
  348.   {standard string manipulation}
  349.   Posic:=Pos(S1,S);
  350.   Len:=Pos(S2,S);
  351.   Delete(S,Len,Length(S2));
  352.   Insert(S1,S,Len);
  353.   Delete(S,Posic,Length(S1));
  354.   Insert(S2,S,Posic);
  355.   Label4.Caption:='"'+S+'"';
  356.   Label5.Caption:='Mask ('+''+')';
  357. end;
  358.  
  359. procedure TForm1._ExtractWordClick(Sender: TObject);
  360. begin
  361.   Label3.Caption:='"Honest Abe Lincoln"';
  362.   Label4.Caption:='"'+ExtractWord(2,'Honest Abe Lincoln',[' '])+'"';
  363.   Label5.Caption:='Mask ('+''+')';
  364. end;
  365.  
  366. procedure TForm1._PopWordClick(Sender: TObject);
  367. Var S:String;
  368. begin
  369.   S:='"Honest Abe Lincoln"';
  370.   Label4.Caption:='"'+PopWord(2,S,[' '])+'"';
  371.   Label3.Caption:=S;
  372.   Label5.Caption:='Mask ('+'"Honest Abe Lincoln"'+')';
  373. end;
  374.  
  375. procedure TForm1._GetPositionClick(Sender: TObject);
  376. begin
  377.   Label3.Caption:='"Honest Abe Lincoln"';
  378.   Label4.Caption:='"'+Long2Str(GetPos(2,'Honest Abe Lincoln',[' ']))+'"';
  379.   Label5.Caption:='Mask ('+'of "Abe"'+')';
  380. end;
  381.  
  382. procedure TForm1._GetEndClick(Sender: TObject);
  383. begin
  384.   Label3.Caption:='"Honest Abe Lincoln"';
  385.   Label4.Caption:='"'+Long2Str(GetEnd(2,'Honest Abe Lincoln',[' ']))+'"';
  386.   Label5.Caption:='Mask ('+'of "Abe"'+')';
  387. end;
  388.  
  389. procedure TForm1._WordCountClick(Sender: TObject);
  390. begin
  391.   Label3.Caption:='"Honest Abe Lincoln"';
  392.   Label4.Caption:='"'+Long2Str(WordCount('Honest Abe Lincoln',[' ']))+'"';
  393.   Label5.Caption:='Mask ('+''+')';
  394. end;
  395.  
  396. procedure TForm1._ChangeWordClick(Sender: TObject);
  397. begin
  398.   Label3.Caption:='"Anna Hana Jana Dana Marcela Petra"';
  399.   Label4.Caption:=ChangeWord(3,'Kamila',Label3.Caption,[' ']);
  400.   Label5.Caption:='Mask ('+'"Jana"-->"Kamila"'+')';
  401. end;
  402.  
  403. procedure TForm1._GetLastWordClick(Sender: TObject);
  404. begin
  405.   Label3.Caption:='"Anna Hana Jana Dana Marcela Petra"';
  406.   Label4.Caption:='"'+GetLastWord(Label3.Caption,[' ']);
  407.   Label5.Caption:='Mask ('+''+')';
  408. end;
  409.  
  410. procedure TForm1._GetFirstWordClick(Sender: TObject);
  411. begin
  412.   Label3.Caption:='"Anna Hana Jana Dana Marcela Petra"';
  413.   Label4.Caption:=GetFirstWord(Label3.Caption,[' '])+'"';
  414.   Label5.Caption:='Mask ('+''+')';
  415. end;
  416.  
  417. procedure TForm1._RomanumClick(Sender: TObject);
  418. begin
  419.   Label3.Caption:='"4568" "MDCIX"';
  420.   Label4.Caption:='"'+Int2Roman(4568)+'" "'+IntToStr(Roman2Int('MDCIX'))+'"';
  421.   Label5.Caption:='Mask ('+''+')';
  422. end;
  423.  
  424. procedure TForm1._ExtractEmailClick(Sender: TObject);
  425. begin
  426.   Label3.Caption:=StrLoCase('<A HREF="mailto:micrel@micrel.cz"><IMG BORDER=0 SRC="email.gif"></A>');
  427.   Label4.Caption:=htmlSrcEmail(Label3.Caption);
  428.   Label5.Caption:='Mask ('+''+')';
  429. end;
  430.  
  431. procedure TForm1._AlterClick(Sender: TObject);
  432. begin
  433.   Label3.Caption:='Orig : '#1+'    Alternative : Joachim';
  434.   Label4.Caption:=Alter(Trim(#1),'Joachim');
  435.   Label5.Caption:='';
  436. end;
  437.  
  438. procedure TForm1._ReduceClick(Sender: TObject);
  439. begin
  440.   Label3.Caption:='"Anna Hana Jana Dana Marcela Petra"';
  441.   Label4.Caption:='"'+Reduce('Anna Hana Jana Dana Marcela Petra',6)+'"';
  442.   Label5.Caption:='Reduce(S,6)';
  443. end;
  444.  
  445. procedure TForm1._ExtractNumberClick(Sender: TObject);
  446. begin
  447.   Label3.Caption:='"dgg4fdg7g4h7rt4h4rt7h4t"';
  448.   Label4.Caption:='"'+ExtractNumber('dgg4fdg7g4h7rt4h4rt7h4t')+'"';
  449.   Label5.Caption:='';
  450. end;
  451.  
  452. procedure TForm1._FindWordClick(Sender: TObject);
  453. begin
  454.   Label3.Caption:='"Anna Hana Jana Dana Marcela Petra"';
  455.   If FindWord ('Dana','Anna Hana Jana Dana Marcela Petra',[' ']) Then
  456.   Label4.Caption:='"Dana"';
  457.   Label5.Caption:='FindWord(''Dana'',S,['' ''])=True';
  458. end;
  459.  
  460. procedure TForm1._JoinToClick(Sender: TObject);
  461. begin
  462.   Label3.Caption:='First: "Anna" Second: "Hana"';
  463.   Label4.Caption:='"'+JoinTo('Anna',',','Hana')+'"';
  464.   Label5.Caption:='Delims = ['','']';
  465. end;
  466.  
  467. end.
  468.