[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    unit ESBRtns;

    { Miscellaneous Routines to enhance your 32-bit Delphi
    	Programming including:

    	- 16-bit Bit Lists
    	- Block Operations
    	- various String Routines and Conversions

    	(c) 1997 ESB Consultancy

    	v1.00	First Public Release on 15 Aug 1997 to celebrate our WebSite's
    					First Birthday.

    	These routines are used by ESB Consultancy within the
    	development of their Customised Application.

    	ESB Consultancy retains full copyright.

    	ESB Consultancy grants users of this code royalty free rights
    	to do with this code as they wish.

    	We does ask that if this code helps you in you development
    	that you send as an email mailto:esb@gold.net.au or even
    	a local postcard. It would also be nice if you gave us a
    	mention in your About Box or Help File.

    	ESB Consultancy Home Page: http://www.gold.net.au/~esb

    	Mail Address: PO Box 2259, Boulder, WA 6432 AUSTRALIA
    }

    interface

    const
    	MaxByte: Byte = 255;
    	MaxShortInt: ShortInt = 127;
    	MaxWord: Word = 65535;
    	MaxReal: Real = 1.7e38;
    	MaxSingle: Single = 3.4e38;
    	MaxDouble: Double = 1.7e308;
    	MaxExtended: Extended = 1.1e4932;
    	MaxComp: Comp = 9.2e18;

    	MinByte: Byte = 0;
    	MinShortInt: ShortInt = -128;
    	MinInt: Integer = -32768;
    	MinWord: Word = 0;
    	MinLongInt: LongInt = $80000000;
    	MinReal: Real = 2.9e-39;
    	MinSingle: Single = 1.5e-45;
    	MinDouble: Double = 5.0e-324;
    	MinExtended: Extended = 3.4e-4932;

    const
    	NumPadCh: Char = ' '; // Character to use for Left Hand Padding of Numerics
    //	NumPosSign: Boolean = False; //Signals whether a '+' sign should be shown with positives

    type
    	TBitList = Word; // Used for a Bit List of 16 bits from 15 -> 0

    type
    	String16	=	string [16];

    {*** Bit Manipulation ***}

    procedure ClearAllBits (var Body: TBitList);

    { Sets all Bits to 0 }

    procedure SetAllBits (var Body: TBitList);

    { Sets all Bits to 1 }

    procedure FlipAllBits (var Body: TBitList);

    { Flips all Bits, i.e 1 -> 0 and 0 -> 1 }

    procedure ClearBit (var Body: TBitList; const I: Byte);

    { Sets specified Bit to 0 }

    procedure SetBit (var Body: TBitList; const I: Byte);

    { Sets specified Bit to 1 }

    procedure FlipBit (var Body: TBitList; const I: Byte);

    { Flips specified Bit, i.e. 0 -> 1 and 1 -> 0 }

    function BitIsSet (const Body: TBitList; const I: Byte): Boolean;

    { Returns True if Specified Bit is 1 }

    procedure ReverseBits (var Body: TBitList); register;

    { Reverses the Bit List, i.e. Bit 15 <-> Bit 0, Bit 14 <-> Bit1, etc. }

    function Bits2Str (const Body: TBitList): String16;

    { Converts a Bit list to a string of '1' and '0'. }

    function Str2Bits (const S: String16): TBitList; register;

    { Converts a string of '1' and '0' into a BitList. }

    function BitsSet (const Body: TBitList): Byte; register;

    { Returns a number from 0 -> 16 indicating the number of Bits Set }

    function Booleans2BitList (const B: array of Boolean): TBitList;

    { Converts an Array of Boolean into a BitList }

    {*** Block Operations ***}

    procedure ESBMoveOfs (const Source; const Ofs1: Integer;
    	var Dest; const Ofs2: Integer; const Size: Integer);

    { Moves Size bytes from Source starting at Ofs1 to destination
    	starting at Ofs 2 using fast dword moves. BASM }

    procedure ESBClear (var Dest; const Size: Integer);

    { Fills given structure with specified number of 0 values,
    	effectively clearing it.	}

    procedure ESBSet (var Dest; const Size: Integer);

    { Fills given structure with specified number of $FF values,
    	effectively setting it. }

    {*** String to Integer Types ***}

    function Str2LInt (const S: String): LongInt;

    { Converts a String into a LongInt }

    function Str2Byte (const S: String): Byte;

    { Converts a String into a Byte }

    function Str2SInt (const S: String): ShortInt;

    { Converts a String into a ShortInt }

    function Str2Int (const S: String): Integer;

    { Converts a String into an Integer }

    function Str2Word (const S: String): Word;

    { Converts a String into a Word }

    {*** Integer Types to Strings ***}

    function LInt2Str (const L: LongInt; const Len: Byte): String;

    { Converts a LongInt into a String of length N with
    	NumPadCh Padding to the Left }

    function Byte2Str (const L: LongInt; const Len: Byte): String;

    { Converts a LongInt into a String of length N with
    	NumPadCh Padding to the Left }

    function LInt2ZStr (const L: LongInt; const Len: Byte): String;

    { Converts a LongInt into a String of length N with
    	NumPadCh Padding to the Left }

    function LInt2ZBStr (const L: LongInt; const Len: Byte): String;

    { Converts a LongInt into a String of length N with
    	NumPadCh Padding to the Left, with blanks returned
    	if Value is 0 }

    function LInt2CStr (const L : LongInt; const Len : Byte): string;

    { Convert a LongInt into a Comma'ed String of length Len,
    	with NumPadCh Padding to the Left }

    function LInt2EStr (const L: LongInt): String;

    { Convert a LongInt into an exact String, No Padding }

    function LInt2ZBEStr (const L: LongInt): String;

    { Convert a LongInt into an exact String, No Padding,
    	with null returned if Value is 0 }

    function LInt2CEStr (const L : LongInt): string;

    { Convert a LongInt into a Comma'ed String without Padding }

    {*** Extended Reals to Strings ***}

    function Ext2EStr (const E: Extended; const Decimals: Byte): String;

    { Converts an Extended Real into an exact String, No padding,
    	with given number of Decimal Places }

    function Ext2EStr2 (const E: Extended; const Decimals: Byte): String;

    { Converts an Extended Real into an exact String, No padding,
    	with at most given number of Decimal Places }

    function Ext2CEStr (const E: Extended; const Decimals: Byte): String;

    { Converts an Extended Real into an exact String, No padding,
    	with given number of Decimal Places, with Commas separating
    	thousands }

    function Double2EStr (const D: Double; const Decimals: Byte): String;

    { Converts a Double Real into an exact String, No padding,
    	with given number of Decimal Places }

    function Single2EStr (const S: Single; const Decimals: Byte): String;

    { Converts a Single Real into an exact String, No padding,
    	with given number of Decimal Places }

    function Comp2EStr (const C: Comp): String;

    { Converts a Comp (Integral) Real into an exact String, No padding }

    function Comp2CStr (const C : Comp; const Len : Byte): string;

    { Converts a Comp (Integral) Real into a Comma'ed String of
    	specified Length, Len, NumPadCh used for Left padding }

    function Comp2CEStr (const C : Comp): string;

    { Converts a Comp (Integral) Real into a Comma'ed String
    	without Padding }

    function Ext2Str (const E: Extended; const Len, Decimals: Byte): String;

    { Converts an Extended Real into a String of specified Length, using
    	NumPadCh for Left Padding, and with Specified number of Decimals }

    function Double2Str (const D: Double; const Len, Decimals: Byte): String;

    { Converts a Double Real into a String of specified Length, using
    	NumPadCh for Left Padding, and with Specified number of Decimals }

    function Single2Str (const S: Single; const Len, Decimals: Byte): String;

    { Converts an Single Real into a String of specified Length, using
    	NumPadCh for Left Padding, and with Specified number of Decimals }

    function Comp2Str (const C: Comp; const Len : Byte): String;

    { Converts a Comp (Integral) Real into a String of specified Length, using
    	NumPadCh for Left Padding }

    {*** Strings to Extended Reals ***}

    function Str2Ext (const S: String): Extended;

    { Converts a String into an Extended Real }

    {*** Extra String Operations ***}

    function LeftStr (const S : string; const N : Integer): string;

    { Returns the substring consisting of the first N characters of S.
    	If N > Length (S) then the substring = S. }

    function RightStr (const S : string; const N : Integer): string;

    { Returns the substring consisting of the last N characters of S.
    	If N > Length (S) then the substring = S. }

    function LeftTillStr (const S : string; const Ch : Char): string;

    { Returns the substring consisting of the characters from S
    	up to but not including the specified one.  If the specified
    	character is not found then a null string is returned. }

    function RightAfterStr (const S : String; const N : Integer): String;

    	{ Returns the sub-string to the right AFTER the first
    		N Characters. if N >= Length (S) then a Null string
    		is returned. }

    function RightAfterChStr (const S : String; const Ch : Char): String;

    	{ Returns the sub-string to the right AFTER the first
    		ocurrence of specifiec character.  If Ch not found then
    		a Null String is returned. }

    function StripTChStr (const S : string; const Ch : Char): string;

    { Returns the String with all specified trailing characters	removed. }

    function StripLChStr (const S : string; const Ch : Char): string;

    { Returns the String with all specified leading characters removed. }

    function StripChStr (const S : string; const Ch : Char): string;

    { Returns the String with all specified leading and trailing
    	characters removed. }

    function ReplaceChStr (const S : string; const OldCh, NewCh : Char): string;

    { Returns the String with all occurrences of OldCh character
    	replaced with NewCh character. }

    function FillStr (const Ch : Char; const N : Integer): string;

    { Returns a string composed of N occurrences of Ch. }

    function BlankStr (const N : Integer): string;

    { Returns a string composed of N blank spaces (i.e. #32) }

    function DashStr (const N : Integer): String;

    { Returns a string composed of N occurrences of '-'. }

    function DDashStr (const N : Integer): string;

    { Returns a string composed of N occurrences of '='. }

    function LineStr (const N : Integer): string;

    { Returns a string composed of N occurrences of 'Ä' (196). }

    function DLineStr (const N : Integer): string;

    { Returns a string composed of N occurrences of 'Í' (205). }

    function StarStr (const N : Integer): string;

    { Returns a string composed of N occurrences of '*'. }

    function HashStr (const N : Integer): string;

    { Returns a string composed of N occurrences of '#'. }

    function PadRightStr (const S : string; const Len : Integer): string;

    { Returns a string with blank spaces added to the end of the
    	string until the string is of the given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function PadLeftStr (const S : string; const Len : Integer): string;

    { Returns a string with blank spaces added to the beginning of the
    	string until the string is of the given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function CentreStr (const S : String; const Len : Integer): String;

    { Returns a string with blank spaces added to the beginning and
    	end of the string to in effect centre the string within the
    	given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function PadChRightStr (const S : string; const Ch : Char;
    	const Len : Integer): string;

    { Returns a string with specified characters added to the end of the
    	string until the string is of the given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function PadChLeftStr (const S : string; const Ch : Char;
    	const Len : Integer): string;

    { Returns a string with specified characters added to the beginning of the
    	string until the string is of the given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function CentreChStr (const S : String; const Ch : Char;
    	const Len : Integer): String;

    { Returns a string with specified characters added to the beginning and
    	end of the string to in effect centre the string within the
    	given length.
    	If Length (S) >= Len then NO padding occurs, and S is returned. }

    function LeftAlignStr (const S : string; const N : Integer): string;

    function RightAlignStr (const S : string; const N : Integer): string;

    function Boolean2TF (const B : Boolean): Char;

    { Converts a Boolean Value into the corresponding Character:
    		True 	-> 'T'
    		False 	-> 'F'
    }

    function Boolean2YN (const B : Boolean): Char;

    { Converts a Boolean Value into the corresponding Character:
    		True 	-> 'Y'
    		False 	-> 'N'
     }

    function Boolean2Char (const B : Boolean;
    	TrueChar, FalseChar: Char): Char;

    { Converts a Boolean Value into the corresponding Character:
    		True 	->  TrueChar
    		False 	->  FalseChar
     }

    function TF2Boolean (const Ch : Char): Boolean;

     { Converts a Character Value into its corresponding Boolean value:

    			'T', 't'	-> True
    			Otherwise -> False
     }

    function YN2Boolean (const Ch : Char): Boolean;

     { Converts a Character Value into its corresponding Boolean value:

    			'Y', 'y'	-> True
    			Otherwise -> False
     }

    implementation

    uses
    	SysUtils;

    {**** Bit Manipulation ****}

    procedure ClearAllBits (var Body: TBitList);

    begin
    	Body:= $0000
    end;

    procedure SetAllBits (var Body: TBitList);

    begin
    	Body:= $FFFF
    end;

    procedure FlipAllBits (var Body: TBitList);

    begin
    	Body:= Body xor $FFFF
    end;

    procedure ClearBit (var Body: TBitList; const I: Byte);

    begin
    	Body:= Body and (not ($0001 shl I))
    end;

    procedure SetBit (var Body: TBitList; const I: Byte);

    begin
    	Body:= Body or ($0001 shl I)
    end;

    procedure FlipBit (var Body: TBitList; const I: Byte);

    begin
    	Body:= Body xor ($0001 shl I)
    end;

    function BitIsSet (const Body: TBitList; const I: Byte): Boolean;

    begin
    	Result := (Body and ($0001 shl I)) <> 0
    end;

    function Bits2Str (const Body: TBitList): String16;
    var
    	I: Integer;
    begin
    	SetLength (Result, 16);
    	for I := 0 to 15 do
    		if BitIsSet (Body, I) then
    			Result [I + 1] := '1'
    		else
    			Result [I + 1] := '0';
    end;

    procedure ReverseBits (var Body: TBitList); assembler;
    asm
    		push esi
    		push ebx

    		mov  esi, eax
    		mov  bx, Word Ptr [esi]
    		sub	ax, ax		// clear ax for out going bit list
    		mov	cx, 16		// 16 iterations needed for a word
    		sub	dx, dx		// clear dx for additions

    	@1:
    		shl	ax, 1		// move all of ax right
    		shr	bx, 1		// move lsb into CF
    		adc	ax, dx		// add in the carry bit
    		loop @1

    		mov Word Ptr [esi], ax

    		pop 	ebx
    		pop 	esi
    end;

    function Str2Bits (const S: String16): TBitList; assembler;
    asm
    		push esi
    		push ebx
    		mov	esi, eax

    		lodsb			// Read Length
    		sub	ah, ah
    		mov	cx, ax		// & store in CX
    		sub	bx, bx		// clear BX for bit list construction
    		mov	dl, '0'		// for comparisons

    	@1:	lodsb
    		shl	bx, 1		// mov bx along
    		cmp	al, dl
    		je	@2
    		add	bx, 1		// otherwise add 1
    	@2:	loop @1;
    		mov	ax, bx		// result must be in ax

    		pop 	ebx
    		pop 	esi
    end;

    function BitsSet (const Body: TBitList): Byte; assembler;
    asm
    		mov  dx, ax		// Place BitList into BX
    		xor	ax, ax		// Clear AX
    		mov  cx, 16		// Move 16 into CX
    	@2:	shl  dx, 1		// Shift Left
    		jnc	@1			// if no carry then no increment
    		inc	ax
    	@1:	loop @2
    end;

    function Booleans2BitList (const B: array of Boolean): TBitList;
    var
    	I: Integer;
    begin
    	Result := 0;
    	for I := 0 to High (B) do
    		if B [I] then
    			SetBit (Result, 0);
    end;

    procedure ESBMoveOfs (const Source; const Ofs1: Integer;
    	var Dest; const Ofs2: Integer; const Size: Integer);
    asm
    	   push    esi
    	   push    edi

    	   mov     esi, Source
    	   add	 esi, Ofs1
    	   mov     edi, Dest
    	   add	 edi, Ofs2

    	   mov     eax, Size
    	   mov     ecx, eax

    	   cmp     edi,esi
    	   jg      @@DOWN
    	   je      @@EXIT

    	   sar     ecx,2           //copy count DIV 4 dwords
    	   js      @@EXIT

    	   rep     movsd

    	   mov     ecx,eax
    	   and     ecx,03h
    	   rep     movsb           //copy count MOD 4 bytes
    	   jmp     @@EXIT

    @@DOWN:
    	   lea     esi,[esi+ecx-4] // point ESI to last dword of source
    	   lea     edi,[edi+ecx-4] // point EDI to last dword of dest

    	   sar     ecx,2        	  // copy count DIV 4 dwords
    	   js      @@EXIT
    	   std
    	   rep     movsd

    	   mov     ecx,eax
    	   and     ecx,03h         // Copy count MOD 4 bytes
    	   add     esi,4-1         // point to last byte of rest
    	   add     edi,4-1
    	   rep     movsb
    	   cld
    @@EXIT:
    	   pop     edi
    	   pop     esi
    end;

    procedure ESBClear (var Dest; const Size: Integer);
    begin
    	FillChar (Dest, Size, $00);
    end;

    procedure ESBSet (var Dest; const Size: Integer);
    begin
    	FillChar (Dest, Size, $FF);
    end;

    function Str2LInt (const S: String): LongInt;
    begin
    	try
    		Result := StrToInt (S);
    	except
    		Result := 0;
    	end;
    end;

    function Str2Byte (const S: String): Byte;
    var
    	L: LongInt;
    begin
    	L := Str2LInt (S);
    	if L > MaxByte then
    		Result := MaxByte
    	else if L < MinByte then
    		Result := MinByte
    	else
    		Result := L;
    end;

    function Str2SInt (const S: String): ShortInt;
    var
    	L: LongInt;
    begin
    	L := Str2LInt (S);
    	if L > MaxShortInt then
    		Result := MaxShortInt
    	else if L < MinShortInt then
    		Result := MinShortInt
    	else
    		Result := L;
    end;

    function Str2Int (const S: String): Integer;
    var
    	L: LongInt;
    begin
    	L := Str2LInt (S);
    	if L > MaxInt then
    		Result := MaxInt
    	else if L < MinInt then
    		Result := MinInt
    	else
    		Result := L;
    end;

    function Str2Word (const S: String): Word;
    var
    	L: LongInt;
    begin
    	L := Str2LInt (S);
    	if L > MaxWord then
    		Result := MaxWord
    	else if L < MinWord then
    		Result := MinWord
    	else
    		Result := L;
    end;

    function LInt2EStr (const L: LongInt): String;
    begin
    	try
    		Result := IntToStr (L);
    	except
    		Result := '';
    	end;
    end;

    function LInt2ZBEStr (const L: LongInt): String;
    begin
    	if L = 0 then
    		Result := ''
    	else
    		try
    			Result := IntToStr (L);
    		except
    			Result := '';
    		end;
    end;

    function Ext2EStr (const E: Extended; const Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (E, ffFixed, 18, Decimals)
    	except
    		Result := '';
    	end;
    end;

    function Ext2EStr2 (const E: Extended; const Decimals: Byte): String;
    begin
    	Result := Ext2EStr (E, Decimals);
    	Result := StripTChStr (Result, '0');
    	if Length (Result) > 0 then
    		if Result [Length (Result)] = DecimalSeparator then
    			Result := LeftStr (Result, Length (Result) - 1);
    end;

    function Ext2CEStr (const E: Extended; const Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (E, ffNumber, 18, Decimals)
    	except
    		Result := '';
    	end;
    end;

    function Double2EStr (const D: Double; const Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (D, ffFixed, 15, Decimals)
    	except
    		Result := '';
    	end;
    end;

    function Single2EStr (const S: Single; const Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (S, ffFixed, 7, Decimals)
    	except
    		Result := '';
    	end;
    end;

    function Comp2EStr (const C: Comp): String;
    begin
    	try
    		Result := FloatToStrF (C, ffFixed, 18, 0)
    	except
    		Result := '';
    	end;
    end;

    function Str2Ext (const S: String): Extended;
    begin
    	try
    		Result := StrToFloat (S);
    	except
    		Result := 0;
    	end;
    end;

    function LInt2Str (const L: LongInt; const Len: Byte): String;
    begin
    	try
    		Result := IntToStr (L);
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function Byte2Str (const L: LongInt; const Len: Byte): String;
    begin
    	try
    		Result := IntToStr (L);
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function LInt2ZBStr (const L: LongInt; const Len: Byte): String;
    begin
    	Result := LInt2ZBEStr (L);
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function LInt2ZStr (const L: LongInt; const Len: Byte): String;
    begin
    	Result := LInt2EStr (L);
    	Result := PadChLeftStr (LeftStr (Result, Len), '0', Len);
    end;

    function LInt2CStr (const L : LongInt; const Len : Byte): string;
    begin
    	Result := LInt2CEStr (L);
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function LInt2CEStr (const L : LongInt): string;
    var
    	LS, L2, I : Integer;
    	Temp : string;
    begin
    	Result := LInt2EStr (L);
    	LS := Length (Result);
    	L2 := (LS - 1) div 3;
    	Temp := '';
    	for I := 1 to L2 do
    		Temp :=  ThousandSeparator + Copy (Result, LS - 3 * I + 1, 3) + Temp;
    	Result := Copy (Result, 1, (LS - 1) mod 3 + 1) + Temp;
    end;

    function Comp2CStr (const C : Comp; const Len : Byte): string;
    begin
    	Result := Comp2CEStr (C);
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function Comp2CEStr (const C : Comp): string;
    var
    	LS, L, I : Integer;
    	Temp : string;
    begin
    	Result := Comp2EStr (C);
    	LS := Length (Result);
    	L := (LS - 1) div 3;
    	Temp := '';
    	for I := 1 to L do
    		Temp :=  ThousandSeparator + Copy (Result, LS - 3 * I + 1, 3) + Temp;
    	Result := Copy (Result, 1, (LS - 1) mod 3 + 1) + Temp;
    end;

    function Ext2Str (const E: Extended; const Len, Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (E, ffFixed, 18, Decimals)
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function Double2Str (const D: Double; const Len, Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (D, ffFixed, 15, Decimals)
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function Single2Str (const S: Single; const Len, Decimals: Byte): String;
    begin
    	try
    		Result := FloatToStrF (S, ffFixed, 7, Decimals)
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function Comp2Str (const C: Comp; const Len: Byte): String;
    begin
    	try
    		Result := FloatToStrF (C, ffFixed, 18, 0)
    	except
    		Result := '';
    	end;
    	Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
    end;

    function LeftStr (const S : string; const N : Integer): string;
    begin
    	Result := Copy (S, 1, N);
    end;

    function LeftAlignStr (const S : string; const N : Integer): string;
    begin
    	Result := PadRightStr (Copy (S, 1, N), N);
    end;

    function RightAlignStr (const S : string; const N : Integer): string;
    begin
    	Result := PadLeftStr (Copy (S, 1, N), N);
    end;

    function RightStr (const S : string; const N : Integer): string;
    var
    	M: Integer;
    begin
    	M := Length (S) - N + 1;
    	if M < 1 then
    		M := 1;
    	Result := Copy (S, M, N);
    end;

    function LeftTillStr (const S : string; const Ch : Char): string;
    var
    	M: Integer;
    begin
    	M := Pos (Ch, S);
    	if M < 2 then
    		Result := ''
    	else
    		Result := Copy (S, 1, M - 1);
    end;

    function RightAfterStr (const S : String; const N : Integer): String;
    begin
    	Result := Copy (S, N + 1, Length (S) - N );
    end;

    function RightAfterChStr (const S : String; const Ch : Char): String;
    var
    	M: Integer;
    begin
    	M := Pos (Ch, S);
    	if M = 0 then
    		Result := ''
    	else
    		Result := Copy (S, M + 1, Length (S) - M);
    end;

    function StripChStr (const S : string; const Ch: Char): string;
    begin
    	Result := StripTChStr (StripLChStr (S, Ch), Ch);
    end;

    function StripTChStr (const S : string; const Ch: Char): string;
    var
    	Len: Integer;
    begin
    	Len := Length (S);
    	while (Len > 0) and (S [Len] = Ch) do
    		Dec (Len);
    	if Len = 0 then
    		Result := ''
    	else
    		Result := Copy (S, 1, Len);
    end;

    function StripLChStr (const S : string; const Ch: Char): string;
    var
    	I, Len: Integer;
    begin
    	Len := Length (S);
    	I := 1;
    	while (I <= Len) and (S [I] = Ch) do
    		Inc (I);
    	if (I > Len) then
    		Result := ''
    	else
    		Result := Copy (S, I, Len - I + 1);
    end;

    function ReplaceChStr (const S : string;
    	const OldCh, NewCh : Char): string;
    var
    	I: Integer;
    begin
    	Result := S;
    	if OldCh = NewCh then
    		Exit;
    	for I := 1 to Length (S) do
    		if S [I] = OldCh then
    			Result [I] := NewCh;
    end;

    function FillStr (const Ch : Char; const N : Integer): string;
    begin
    	SetLength (Result, N);
    	FillChar (Result [1], N, Ch);
    end;

    function BlankStr (const N : Integer): string;
    begin
    	Result := FillStr (' ', N);
    end;

    function DashStr (const N : Integer): string;
    begin
    	Result := FillStr ('-', N);
    end;

    function DDashStr (const N : Integer): string;
    begin
    	Result := FillStr ('=', N);
    end;

    function LineStr (const N : Integer): string;
    begin
    	Result := FillStr (#196, N);
    end;

    function DLineStr (const N : Integer): string;
    begin
    	Result := FillStr (#205, N);
    end;

    function StarStr (const N : Integer): string;
    begin
    	Result := FillStr ('*', N);
    end;

    function HashStr (const N : Integer): string;
    begin
    	Result := FillStr ('#', N);
    end;

    function PadRightStr (const S : string; const Len : Integer): string;
    var
    	N: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    		Result := S + BlankStr (Len - N)
    	else
    		Result := S;
    end;

    function PadLeftStr (const S : string; const Len : Integer): string;
    var
    	N: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    		Result := BlankStr (Len - N) + S
    	else
    		Result := S;
    end;

    function CentreStr (const S : String; const Len : Integer): String;
    var
    	N, M: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    	begin
    		M := Len - N;
    		if Odd (M) then
    			Result := BlankStr (M div 2) + S
    				+ BlankStr (M div 2 + 1)
    		else
    			Result := BlankStr (M div 2) + S
    				+ BlankStr (M div 2);
    	end
    	else
    		Result := S;
    end;

    function PadChRightStr (const S : string; const Ch : Char;
    	const Len : Integer): string;
    var
    	N: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    		Result := S + FillStr (Ch, Len - N)
    	else
    		Result := S;
    end;

    function PadChLeftStr (const S : string; const Ch : Char;
    	const Len : Integer): string;
    var
    	N: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    		Result := FillStr (Ch, Len - N) + S
    	else
    		Result := S;
    end;

    function CentreChStr (const S : String; const Ch : Char;
    	const Len : Integer): String;
    var
    	N, M: Integer;
    begin
    	N := Length (S);
    	if N < Len then
    	begin
    		M := Len - N;
    		if Odd (M) then
    			Result := FillStr (Ch, M div 2) + S
    				+ FillStr (Ch, M div 2 + 1)
    		else
    			Result := FillStr (Ch, M div 2) + S
    				+ FillStr (Ch, M div 2);
    	end
    	else
    		Result := S;
    end;

    function Boolean2TF (const B : Boolean): Char;
    begin
    	if B then
    		Result := 'T'
    	else
    		Result := 'F';
    end;

    function Boolean2YN (const B : Boolean): Char;
    begin
    	if B then
    		Result := 'Y'
    	else
    		Result := 'N';
    end;

    function Boolean2Char (const B : Boolean;
    	TrueChar, FalseChar: Char): Char;
    begin
    	if B then
    		Result := TrueChar
    	else
    		Result := FalseChar;
    end;

    function TF2Boolean (const Ch : Char): Boolean;
    begin
    	Result := Ch in ['T', 't'];
    end;

    function YN2Boolean (const Ch : Char): Boolean; assembler;
    begin
    	Result := Ch in ['Y', 'y'];
    end;

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]