home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPDB311.ZIP / TPDBSTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-14  |  4.2 KB  |  186 lines
  1. {$A+,B-,D+,E+,F+,I+,L+,N-,O+,R+,S+,V-}
  2.  
  3. UNIT TPDBStr;
  4. {Turbo Pascal Tools for dBASE - Version 3.1}
  5. {String handling unit}
  6. {Copyright 1989 Brian Corll}
  7.  
  8. INTERFACE
  9.  
  10. CONST
  11.     {Tables for translating foreign characters into English
  12.      characters during sorting and indexing.}
  13.     ForTable = 'ÇüéâäàåçêëèïîìÄÅÉæÆôöòùÿÖ܃íóúñÑ';
  14.     EngTable = 'CueaaaaceeeiiiAAEefooouyOUfiounN';
  15.  
  16. TYPE
  17.     TslTable = String;
  18.     DBKey = String[254];
  19.  
  20. FUNCTION For2Eng(StrToConvert : String;TslTable1,
  21.             TslTable2 : TslTable) : DBKey;
  22.     {Translates any string using a specified translation table.
  23.      Intended for use with ForTable and EngTable, declared above, for
  24.      translating extended ASCII characters to normal alphabetic characters
  25.      for indexin and sorting, but will work with any user-defined
  26.      translation tables.}
  27.  
  28. FUNCTION Substr(BigStr : String;Start,Len : Byte) : String;
  29.     {Same as dBASE's Substr function.}
  30.  
  31. FUNCTION ReverseStr(StrToReverse : String) : String;
  32.     {Reverses the order of characters in a string.}
  33.  
  34. FUNCTION  JustL(InpStr: String; FieldLen: Integer): String;
  35. {Left justify a string.}
  36.  
  37. FUNCTION Lower(InpStr : string) : string;
  38.  
  39. FUNCTION  LTrim(InpStr: String): String;
  40. {Trim leading blanks from a string.}
  41.  
  42. FUNCTION  PadL(InpStr: String; FieldLen: Integer): String;
  43. {Pad a string with blanks on the left.}
  44.  
  45. FUNCTION  PadR(InpStr: String; FieldLen: Integer): String;
  46. {Pad a string with blanks on the right.}
  47.  
  48. FUNCTION  Replicate(Ch : Char;Count : word) : String;
  49. {Create a string of a specified number of a character.}
  50.  
  51. FUNCTION  RTrim(InpStr: String): String;
  52. {Trim trailing blanks from a string.}
  53.  
  54.  
  55. FUNCTION  Upper(InpStr: String): String;
  56. {Convert a string to upper case.}
  57.  
  58. IMPLEMENTATION
  59. {$F+}
  60.     {All string functions are far calls for use in indexing and sorting.}
  61.  
  62.     FUNCTION For2Eng(StrToConvert : String;TslTable1,TslTable2 : TslTable) : DBKey;
  63.     VAR
  64.         OutStr : String;
  65.         I : Byte;
  66.         OutChar : Char;
  67.  
  68.             PROCEDURE ScanTable;
  69.             VAR
  70.                 J : Byte;
  71.             BEGIN
  72.                 FOR J := 1 TO Length(TslTable1) DO
  73.                 IF StrToConvert[I] = TslTable1[J] THEN
  74.                 BEGIN
  75.                     OutChar := TslTable2[J];
  76.                     Exit;
  77.                 END
  78.                 ELSE
  79.                     OutChar := StrToConvert[I];
  80.             END;
  81.     BEGIN
  82.         OutStr := '';
  83.         FOR I := 1 to Length(StrToConvert) DO
  84.         BEGIN
  85.             ScanTable;
  86.             OutStr := OutStr + OutChar;
  87.         END;
  88.         For2Eng := OutStr;
  89.     END;
  90.  
  91.     FUNCTION Substr(BigStr : String;Start,Len : Byte) : String;
  92.     VAR
  93.         OutStr : String;
  94.     BEGIN
  95.          OutStr := Copy(BigStr,Start,Len);
  96.          Substr := OutStr;
  97.     END;
  98.  
  99.     FUNCTION ReverseStr(StrToReverse : String) : String;
  100.     VAR
  101.         OutStr : String;
  102.         I : Byte;
  103.     BEGIN
  104.         OutStr := '';
  105.         FOR I := Length(StrToReverse) DOWNTO 1 DO
  106.             OutStr := OutStr + StrToReverse[I];
  107.         ReverseStr := OutStr;
  108.     END;
  109.  
  110.  
  111.  
  112. FUNCTION JustL(InpStr: String; FieldLen: Integer): String;
  113. BEGIN
  114.      JustL := PadR(LTrim(InpStr),FieldLen)
  115. END;
  116.  
  117. FUNCTION LTrim(InpStr: String): String;
  118. VAR i,len : Integer;
  119. BEGIN
  120.      len := length(InpStr);
  121.      i := 1;
  122.      While (i <= len) and (InpStr[i] = ' ') do
  123.            i := i + 1;
  124.      LTrim := Copy(InpStr,i,len-i+1)
  125. END;
  126.  
  127.  
  128. FUNCTION PadL(InpStr: String; FieldLen: Integer): String;
  129. VAR
  130.    STemp : String;
  131.    i : Integer;
  132. BEGIN
  133.    If FieldLen >= SizeOF(InpStr) then
  134.       FieldLen := SizeOf(InpStr)-1;
  135.    If length(InpStr) > FieldLen then
  136.       PadL := Copy(InpStr,1,FieldLen)
  137.    Else
  138.       BEGIN
  139.         STemp := InpStr;
  140.         For i := Length(STemp)+1 to FieldLen do
  141.            Insert(' ',STemp,1);
  142.         PadL := STemp
  143.       END
  144. END;{PadL}
  145.  
  146. FUNCTION PadR(InpStr: String; FieldLen: Integer): String;
  147. VAR
  148.    STemp : String;
  149.    i : Integer;
  150. BEGIN
  151.    If FieldLen >= SizeOF(InpStr) then
  152.       FieldLen := SizeOf(InpStr)-1;
  153.    If length(InpStr) > FieldLen then
  154.       PadR := Copy(InpStr,1,FieldLen)
  155.    Else
  156.       BEGIN
  157.         STemp := InpStr;
  158.         For i := Length(STemp)+1 to FieldLen do
  159.            STemp := STemp + ' ';
  160.         PadR := STemp
  161.       END
  162. END;{PadR}
  163.  
  164. {$L tpdb.obj}
  165.  
  166. FUNCTION Lower;external;
  167.  
  168. FUNCTION Replicate;external;
  169.  
  170. FUNCTION Upper;external;
  171.  
  172.  
  173. FUNCTION RTrim(InpStr: String): String;
  174. VAR
  175.    i : Integer;
  176. BEGIN
  177.    i := length(InpStr);
  178.    While (i >= 1) and (InpStr[i] = ' ') do
  179.       i := i - 1;
  180.    RTrim := Copy(InpStr,1,i)
  181. END;{RTrim}
  182.  
  183. {$F-}
  184. BEGIN
  185. END.
  186.