home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitToken.pas < prev    next >
Pascal/Delphi Source File  |  2003-06-05  |  3KB  |  114 lines
  1. unit UnitToken;
  2. {
  3.     Purpose:
  4.         String utils related to tokenization.
  5.         Just look at all the bad naming conventions - shamefull.
  6.  
  7.     Updates:
  8.         Included apostropes in wordChars for words like
  9.         "Can't" and "Don't".
  10.  
  11. }
  12.  
  13. interface
  14.  
  15. function TokenString(var s: string; delim: string) : string;
  16. function clipOneChar(s : string) : string;
  17. function clipManyChars(s : string; clip : string) : string; overload;
  18. function clipManyChars(s : string; count : cardinal) : string; overload;
  19. function CharCount(s : string; c : char) : cardinal;
  20. function CutWord(var s: string; WordChars: string) : string;
  21. function CapitalizeWords(s : string) : string;
  22.  
  23. implementation
  24.  
  25. uses strutils, sysutils;
  26.  
  27.  
  28. function CharCount(s : string; c : char) : cardinal;
  29. var i : integer;
  30. begin
  31.     result := 0;
  32.     for i := 1 to length(s) do begin
  33.         if  s[i] = c then inc(Result);
  34.     end;
  35. end;
  36.  
  37. function CapitalizeWords(s : string) : string;
  38. var word : string;
  39.     letter : string;
  40. const wordChars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRTSUVWXYZ0123456789''';
  41. begin
  42.     result := '';
  43.  
  44.     while (s <> '') do begin
  45.         word := CutWord(s, wordchars);
  46.         if (word <> '') then begin
  47.             letter := UpperCase(word[1]);
  48.             word[1] := letter[1];
  49.         end;
  50.  
  51.         result := result + word;
  52.     end;
  53. end;
  54. function CutWord(var s: string; WordChars: string) : string;
  55. var i : longint;
  56. begin
  57.     i := 1;
  58.  
  59.     // find a "word"
  60.     while (i < length(s))
  61.         and (pos(s[i],WordChars) > 0) do begin
  62.         inc(i);
  63.     end;
  64.  
  65.     // find all chars leading up to the next word
  66.     // stop before getting to the next word
  67.     while ((i+1) < length(s))
  68.         and (pos(s[i+1],WordChars) = 0) do begin
  69.         inc(i);
  70.     end;
  71.  
  72.     // cut off the word and trailing delimiters
  73.     result := LeftStr(s, i);
  74.     s := rightstr(s, length(s) - i);
  75. end;
  76.  
  77.  
  78. function TokenString(var s: string; delim: string) : string;
  79. var delimPos: integer;
  80. begin
  81.     s := trimleft(s);
  82.  
  83.     delimPos := pos(delim, s);
  84.     If (delimPos > 0) Then begin
  85.         //'-- cut off first token and ditch the delimiter
  86.         result := Leftstr(s, (delimPos - 1));
  87.         s := rightstr(s,  length(s) - (length(delim) + length(result)));
  88.     end Else begin
  89.         //'-- return last token
  90.         result := s;
  91.         s := '';
  92.     End;
  93.  
  94. end;
  95.  
  96.  
  97. function clipOneChar(s : string) : string;
  98. begin
  99.     result := rightstr(s, length(s) - 1);
  100. end;
  101.  
  102. function clipManyChars(s : string; clip : string) : string;
  103. begin
  104.     result := rightstr(s, length(s) - length(clip));
  105. end;
  106.  
  107. function clipManyChars(s : string; count : cardinal) : string;
  108. begin
  109.     result := rightstr(s, cardinal(length(s)) - count);
  110. end;
  111.  
  112.  
  113. end.
  114.