home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / DSKCACHE / EVALCACH.ZIP / STRUTIL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-10-26  |  4.4 KB  |  170 lines
  1. {
  2. **************************************************************************
  3. STRUTIL.PAS -- Turbo Pascal String Utilities
  4. Copyright 1989 L. Brett Glass -- All rights reserved.
  5. **************************************************************************
  6. }
  7. unit StrUtil;
  8.  
  9. interface
  10.  
  11. type
  12.   Str11 = String[11];
  13.   Str12 = String[12];
  14.  
  15. procedure AllUpper (var st);
  16.   { Make a string all uppercase }
  17.  
  18. procedure TrimLeading(var st);
  19.   { Remove leading blanks from string }
  20.  
  21. procedure TrimTrailing(var st);
  22.   { Remove trailing blanks from string }
  23.  
  24. procedure Pad(var st; ch : Char; newLen : Byte);
  25.   { Pad st with blanks to newLen }
  26.  
  27. function IntString(i : Longint; cols : Word) : Str12;
  28.   { Convert an integer to a string }
  29.  
  30. procedure Ellipsis(var st; maxLen : Word);
  31.   { If string is longer than maxLen, truncate and add an ellipsis }
  32.  
  33. procedure ReplaceAll(var st; oldChar, newChar : Char);
  34.   { Replace all occurrences of oldChar in a string with newChar. }
  35.  
  36. procedure DeleteAll(var st; delChar : Char);
  37.   { Delete all occurrences of delChar in a string. }
  38.  
  39. function HexStr(var num; byteCount : Byte) : String;
  40.   { General-purpose hex conversion routine. The bytes at num are
  41.     converted to a string of hex digits of length (byteCount*2).
  42.     If byteCount is greater than 127, the least significant
  43.     digits of the number will be truncated. }
  44.  
  45. function HexPtr(p : Pointer) : Str11;
  46.   { Return a string representing p in the format $XXXX:$XXXX }
  47.  
  48. implementation
  49.  
  50. procedure AllUpper (var st);
  51.   var
  52.     i           : Word;
  53.     s           : String absolute st;
  54.   begin {AllUpper}
  55.   for i := 1 to Length(s) do
  56.     s[i] := UpCase(s[i]);
  57.   end;  {AllUpper}
  58.  
  59. procedure TrimLeading(var st);
  60.   var
  61.     first       : Word;
  62.     s           : String absolute st;
  63.     len         : Byte absolute st; {Used to assign length directly}
  64.   begin {TrimLeading}
  65.   if len = 0 then Exit;
  66.   first := 1;
  67.   while (s[first] = ' ') and (first <= len) do
  68.     first := Succ(first);
  69.   len := Succ(len - first);
  70.   if (first > 1) and (len > 0) then
  71.     Move(s[first], s[1], len);
  72.   end; {TrimLeading}
  73.  
  74. procedure TrimTrailing(var st);
  75.   var
  76.     s           : String absolute st;
  77.     len         : Byte absolute st;
  78.   begin {TrimTrailing}
  79.   while (s[len] = ' ') and (len > 0) do
  80.     len := Pred(len);
  81.   end; {TrimTrailing}
  82.  
  83. procedure Pad(var st; ch : Char; newLen : Byte);
  84.   var
  85.     s   : String absolute st;
  86.     len : Byte absolute st;
  87.   begin {Pad}
  88.   if newLen <= len then
  89.     Exit;
  90.   FillChar(s[Succ(len)], newlen - len, ch);
  91.   len := newLen;
  92.   end;  {Pad}
  93.  
  94. function IntString(i : LongInt; cols : Word) : Str12;
  95.   {Make an integer into a string}
  96.   var
  97.     tempStr : String[6];
  98.   begin {IntString}
  99.   Str(i:cols,tempStr);
  100.   IntString := tempStr
  101.   end;  {IntString}
  102.  
  103. procedure Ellipsis(var st; maxLen : Word);
  104.   var
  105.     s : String absolute st;
  106.     len : Byte absolute st;
  107.   begin {Ellipsis}
  108.   if maxLen < 3 then
  109.     Exit;
  110.   if len > maxLen then
  111.     begin
  112.     len := maxLen;
  113.     FillChar(s[maxLen-2],3,'.')
  114.     end
  115.   end;  {Ellipsis}
  116.  
  117. procedure ReplaceAll(var st; oldChar, newChar : Char);
  118.   var
  119.     s : String absolute st;
  120.     p : Word;
  121.   begin {ReplaceAll}
  122.   repeat
  123.     p := Pos(oldChar,s);
  124.     if p = 0 then
  125.       Exit;
  126.     s[p] := newChar
  127.     until FALSE
  128.   end;  {ReplaceAll}
  129.  
  130. procedure DeleteAll(var st; delChar : Char);
  131.   var
  132.     s : String absolute st;
  133.     p : Word;
  134.   begin {DeleteAll}
  135.   repeat
  136.     p := Pos(delChar,s);
  137.     if p = 0 then
  138.       Exit;
  139.     Delete(s,p,1)
  140.     until FALSE
  141.   end;  {DeleteAll}
  142.  
  143. function HexStr(var num; byteCount : Byte) : String;
  144.   const
  145.     hexChars : array [0..$F] of Char = '0123456789ABCDEF';
  146.   var
  147.     numArray : array [Byte] of Byte absolute num; {Access bytes of num}
  148.     tempStr : String; {Holds result}
  149.     tempLen : Byte absolute tempStr; {Length of result}
  150.   begin {HexStr}
  151.   tempLen := 0;
  152.   for byteCount := Pred(byteCount) downto 0 do {numArray is 0-based}
  153.     tempStr := tempStr +                               {Add:    }
  154.                hexChars[numArray[byteCount] shr 4]  +  {Hi digit}
  155.                hexChars[numArray[byteCount] and $F];   {Lo digit}
  156.   HexStr := tempStr
  157.   end; {HexStr}
  158.  
  159. function HexPtr(p : Pointer) : Str11;
  160.   var
  161.     ad : record
  162.       o,s : Word
  163.       end absolute p;
  164.   begin {HexPtr}
  165.   HexPtr := '$' + HexStr(ad.s,2) + ':$' + HexStr(ad.o,2)
  166.   end;  {HexPtr}
  167.  
  168. end.
  169.  
  170.