home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / strings / strfunc / strfunct.pas < prev   
Pascal/Delphi Source File  |  1988-01-19  |  5KB  |  200 lines
  1. Unit StrFunct;
  2.  { A set of string functions placed in     }
  3.  { the public domain by:                   }
  4.  { John Wood                               }
  5.  { 14720 Karyl Drive                       }
  6.  { Minnetonka, MN  55345                   }
  7.  {                                         }
  8.  { Please send any comments, suggestions   }
  9.  { or additions to my address.             }
  10.  {                                         }
  11.  
  12. Interface
  13. Uses Dos,Crt;
  14. {$V-}
  15. Type
  16.   RowType = 1..25;
  17.  
  18. Function Upper(S:String):String;
  19. Function Lower(S:String):String;
  20. Function Strip(S:String;Ch:Char):String;
  21. Function StripR(S:String;Ch:Char):String;
  22. Function Copies(Ch:Char;N:Integer):String;
  23. Procedure CtrStr(S:String;Row:RowType);
  24. Function Left(S:String;Width:Integer;Pad:Char):String;
  25. Function Right(S:String;Width:Integer;Pad:Char):String;
  26. Function Normalize(S:String):String;
  27. Function Words(S:String):Integer;
  28. Function FirstCap(S:String):String;
  29. Function OneCap(S:String):String;
  30. Function AllCap(S:String):String;
  31. Function Comma(Form:Char;Number:Real;Field:Integer;Dec:Integer):String;
  32.  
  33. Implementation
  34.  
  35.  
  36. Function Upper(S:String):String;
  37. Var
  38.   I : Integer;
  39. Begin
  40.   For I:= 1 TO Length(S) do S[I]:= UpCase(S[I]);
  41.   Upper:= S;
  42. End;
  43.  
  44. Function Lower(S:String):String;
  45. Var
  46.   I : Integer;
  47. Begin
  48.   For I := 1 TO Length(S) do
  49.     If S[I] In ['A'..'Z'] Then S[I]:= Chr(Ord(S[I])+$20);
  50.   Lower:= S;
  51. End;
  52.  
  53. Function Strip(S:String;Ch:Char):String;
  54. Var
  55.   I,J : ShortInt;
  56. Begin
  57.   I:= Length(S);
  58.   J:= 1;
  59.   While (S[I] = Ch) and (I > 0) do I:= I-1;
  60.   While (S[J] = Ch) and (J < I) do J:= J+1;
  61.   S:= Copy(S,J,I-J+1);
  62.   S[0]:= Chr(I-J+1);
  63.   Strip:= S;
  64. End;
  65.  
  66. Function StripR(S:String;Ch:Char):String;
  67. Var
  68.   I : ShortInt;
  69. Begin
  70.   I:= Length(S);
  71.   While (S[I] = Ch) and (I > 0) do I:= I-1;
  72.   S[0]:= Chr(I);
  73.   StripR:= S;
  74. End;
  75.  
  76. Function Copies(Ch:Char;N:Integer):String;
  77. Var
  78.   I : Integer;
  79.   S : String;
  80. Begin
  81.   S:='';
  82.   FillChar(S[1],N,Ch);
  83.   S[0]:= Chr(N);
  84.   Copies:= S;
  85. End;
  86.  
  87. Procedure CtrStr(S:String;Row:RowType);
  88. Var
  89.   I : ShortInt;
  90. Begin
  91.   I:= (80 - Length(S)) div 2;
  92.   GotoXY(I,Row);Write(S);
  93. End;
  94.  
  95. Function Left(S:String;Width:Integer;Pad:Char):String;
  96. Begin
  97.   S:= Strip(S,#32);
  98.   While Length(S) < Width do S:= S+Pad;              {fill out str length}
  99.   While Length(S) > Width do Delete(S,Length(S),1);  {chop str down to size}
  100.   Left:= S;
  101. End;
  102.  
  103. Function Right(S:String;Width:Integer;Pad:Char):String;
  104. Begin
  105.   S:= Strip(S,#32);        {left justify the string}
  106.   While Length(S) < Width do Insert(Pad,S,1);       {pad str on the left}
  107.   While Length(S) > Width do Delete(S,Length(S),1); {chop str down to size}
  108.   Right:= S;
  109. End;
  110.  
  111. Function Normalize(S:String):String;
  112. Var
  113.   Len, I : Integer;
  114. Begin
  115.   S:= Strip(S,#32);        {left justify the string}
  116.   If Length(S) > 1 Then
  117.   Begin
  118.     I:= 2;
  119.     While I < Length(S) do
  120.     Begin
  121.       While (S[I]=#32) and (S[I+1]=#32) do Delete(S,I+1,1);
  122.       Inc(I);
  123.     End;
  124.   End;
  125.   Normalize:= S;
  126. End;
  127.  
  128. Function Words(S:String):Integer;
  129. Var
  130.   Len, I, J : Integer;
  131. Begin
  132.   S:= Normalize(S);
  133.   J:= 1;
  134.   Len:= Length(S);
  135.   If Len > 0 Then
  136.   Begin
  137.     For I:= 2 to Len do If S[I] = #32 Then Inc(J);
  138.   End
  139.   Else J:= 0;
  140.   Words:= J;
  141. End;
  142.  
  143. Function FirstCap(S:String):String;
  144. Var
  145.   Str              : String;
  146.   LtrPos,I,NumWord : Integer;
  147. Begin
  148.   S:= Normalize(S);                      {left justify & normalize the string}
  149.   S:= Lower(S);                          { put entire string in lowercase }
  150.   NumWord:= Words(S);                    { determine no. of words in string }
  151.   S[1]:= UpCase(S[1]);
  152.   LtrPos:= 2;
  153.   For I:= 2 to NumWord do
  154.   Begin
  155.     While S[LtrPos] <> #32 do Inc(LtrPos);
  156.     S[LtrPos+1]:= UpCase(S[LtrPos+1]);
  157.     Inc(LtrPos);
  158.   End;
  159.   FirstCap:= S;
  160. End {FirstCap};
  161.  
  162.  
  163. Function OneCap(S:String):String;
  164. Begin
  165.   S:= Normalize(S);
  166.   S:= Lower(S);
  167.   S[1]:= UpCase(S[1]);
  168.   OneCap:= S;
  169. End;
  170.  
  171. Function AllCap(S:String):String;
  172. Begin
  173.   S:= Normalize(S);
  174.   S:= Upper(S);
  175.   AllCap:= S;
  176. End;
  177.  
  178. Function Comma(Form:Char;Number:Real;Field:Integer;Dec:Integer):String;
  179. Var
  180.   Hold : String;
  181.   I    : Integer;
  182. Begin
  183.   Str (Number:Field:Dec, Hold);
  184.   If Dec > 0 Then Dec := Dec + 1;
  185.   For I := 1 to (Field - Dec - 3) do
  186.     If ((Field - Dec - I) Mod 3 = 0) And (Hold[I] <> ' ')
  187.     And (Hold[I] <> '-') Then
  188.     Begin
  189.       Delete (Hold,1,1); Insert (',', Hold, I);
  190.     End;
  191.   Case Form of
  192.     '$' : Comma:= '$'+ Strip(Hold,' ');
  193.     '#' : Comma:= Strip(Hold,' ');
  194.     '%' : Comma:= Strip(Hold,' ')+' %';
  195.   End;
  196. End;
  197.  
  198.  
  199. End{Unit}.
  200.