Category : Pascal Source Code
Archive   : TPDB311.ZIP
Filename : TPDBSTR.PAS

{$A+,B-,D+,E+,F+,I+,L+,N-,O+,R+,S+,V-}

UNIT TPDBStr;
{Turbo Pascal Tools for dBASE - Version 3.1}
{String handling unit}
{Copyright 1989 Brian Corll}

INTERFACE

CONST
{Tables for translating foreign characters into English
characters during sorting and indexing.}
ForTable = '€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•—˜™šŸ¡¢£¤¥';
EngTable = 'CueaaaaceeeiiiAAEefooouyOUfiounN';

TYPE
TslTable = String;
DBKey = String[254];

FUNCTION For2Eng(StrToConvert : String;TslTable1,
TslTable2 : TslTable) : DBKey;
{Translates any string using a specified translation table.
Intended for use with ForTable and EngTable, declared above, for
translating extended ASCII characters to normal alphabetic characters
for indexin and sorting, but will work with any user-defined
translation tables.}

FUNCTION Substr(BigStr : String;Start,Len : Byte) : String;
{Same as dBASE's Substr function.}

FUNCTION ReverseStr(StrToReverse : String) : String;
{Reverses the order of characters in a string.}

FUNCTION JustL(InpStr: String; FieldLen: Integer): String;
{Left justify a string.}

FUNCTION Lower(InpStr : string) : string;

FUNCTION LTrim(InpStr: String): String;
{Trim leading blanks from a string.}

FUNCTION PadL(InpStr: String; FieldLen: Integer): String;
{Pad a string with blanks on the left.}

FUNCTION PadR(InpStr: String; FieldLen: Integer): String;
{Pad a string with blanks on the right.}

FUNCTION Replicate(Ch : Char;Count : word) : String;
{Create a string of a specified number of a character.}

FUNCTION RTrim(InpStr: String): String;
{Trim trailing blanks from a string.}


FUNCTION Upper(InpStr: String): String;
{Convert a string to upper case.}

IMPLEMENTATION
{$F+}
{All string functions are far calls for use in indexing and sorting.}

FUNCTION For2Eng(StrToConvert : String;TslTable1,TslTable2 : TslTable) : DBKey;
VAR
OutStr : String;
I : Byte;
OutChar : Char;

PROCEDURE ScanTable;
VAR
J : Byte;
BEGIN
FOR J := 1 TO Length(TslTable1) DO
IF StrToConvert[I] = TslTable1[J] THEN
BEGIN
OutChar := TslTable2[J];
Exit;
END
ELSE
OutChar := StrToConvert[I];
END;
BEGIN
OutStr := '';
FOR I := 1 to Length(StrToConvert) DO
BEGIN
ScanTable;
OutStr := OutStr + OutChar;
END;
For2Eng := OutStr;
END;

FUNCTION Substr(BigStr : String;Start,Len : Byte) : String;
VAR
OutStr : String;
BEGIN
OutStr := Copy(BigStr,Start,Len);
Substr := OutStr;
END;

FUNCTION ReverseStr(StrToReverse : String) : String;
VAR
OutStr : String;
I : Byte;
BEGIN
OutStr := '';
FOR I := Length(StrToReverse) DOWNTO 1 DO
OutStr := OutStr + StrToReverse[I];
ReverseStr := OutStr;
END;



FUNCTION JustL(InpStr: String; FieldLen: Integer): String;
BEGIN
JustL := PadR(LTrim(InpStr),FieldLen)
END;

FUNCTION LTrim(InpStr: String): String;
VAR i,len : Integer;
BEGIN
len := length(InpStr);
i := 1;
While (i <= len) and (InpStr[i] = ' ') do
i := i + 1;
LTrim := Copy(InpStr,i,len-i+1)
END;


FUNCTION PadL(InpStr: String; FieldLen: Integer): String;
VAR
STemp : String;
i : Integer;
BEGIN
If FieldLen >= SizeOF(InpStr) then
FieldLen := SizeOf(InpStr)-1;
If length(InpStr) > FieldLen then
PadL := Copy(InpStr,1,FieldLen)
Else
BEGIN
STemp := InpStr;
For i := Length(STemp)+1 to FieldLen do
Insert(' ',STemp,1);
PadL := STemp
END
END;{PadL}

FUNCTION PadR(InpStr: String; FieldLen: Integer): String;
VAR
STemp : String;
i : Integer;
BEGIN
If FieldLen >= SizeOF(InpStr) then
FieldLen := SizeOf(InpStr)-1;
If length(InpStr) > FieldLen then
PadR := Copy(InpStr,1,FieldLen)
Else
BEGIN
STemp := InpStr;
For i := Length(STemp)+1 to FieldLen do
STemp := STemp + ' ';
PadR := STemp
END
END;{PadR}

{$L tpdb.obj}

FUNCTION Lower;external;

FUNCTION Replicate;external;

FUNCTION Upper;external;


FUNCTION RTrim(InpStr: String): String;
VAR
i : Integer;
BEGIN
i := length(InpStr);
While (i >= 1) and (InpStr[i] = ' ') do
i := i - 1;
RTrim := Copy(InpStr,1,i)
END;{RTrim}

{$F-}
BEGIN
END.