[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]