[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]
{ *** Handles string in/output and various conversion routines
***
}
Unit StrIO;
INTERFACE
Uses Vars;
FUNCTION StatusBar(total, amt, barlength: longint): St80;
{FUNCTION StatusBar(total, amt : longint): St80;}
FUNCTION ITOA(i: longint): St40;
FUNCTION ATOI(s: St40): LongInt;
FUNCTION UpCase(c: Char): Char;
FUNCTION UCase(s: String): String;
FUNCTION RepStr(Times: Byte; Which: Char): String;
FUNCTION Strip_Path(Fullfilename: String): String;
FUNCTION Leading_Zero(Number: String; Digits: Byte): String;
FUNCTION Read_Str(StrLen : Byte;
InputFg,
InputBg : Integer;
Hidden,
Spaces : Char;
SpinWanted,
Display,
Upper,
OnlyNumbers,
AutoReturn : Boolean;
Default : String): String;
PROCEDURE Flush_Keyboard_Buffer;
FUNCTION Right_Pad(s: String; MaxLength: Word): String;
FUNCTION Right_Strip(s: String): String;
FUNCTION Right_Justify(s: String; sl: Byte): String;
FUNCTION CommaNum (I : LongInt): String;
FUNCTION Strip_Filename(S: String): String;
CONST
Str_Yes : String = 'Yes';
Str_No : String = 'No';
IMPLEMENTATION
Uses Crt;
FUNCTION CharStr(HowMuch: Byte; WithWhatChar: Char): String;
{
*** fills charStr with withwhatchar to the howmuch
***
}
Var
j : Integer;
TempStr : St80;
Begin
TempStr := '';
For J := 1 To HowMuch Do
Insert(WithWhatChar, TempStr, J);
CharStr := TempStr;
End;
FUNCTION StatusBar(total, amt, barlength: longint): St80;
{ Const
BarLength = 30;}
Var
a,
b,
c,
d : longint;
sD : String; {for conversion}
percent : real;
st : string;
Begin
If (total = 0) OR (amt = 0) Then
Begin
StatusBar := '';
Exit;
End;
If (Amt > Total) Then
amt := total;
Percent := Amt / Total * (Barlength * 10);
a := trunc(percent);
b := a div 10;
c := 1;
percent := amt / total * 100;
d := trunc(percent);
Str(d, sD);
st := ' (' + sD + '%)';
StatusBar := CharStr(b * c, #219) + CharStr(Barlength - (b * c), #176) + st;
End;
FUNCTION ITOA(i: longint): St40;
{
*** Converts integers into alphanumericals or strings
***
}
Var
stTemp: St20;
Begin
Str(i, stTemp);
ITOA := stTemp;
End;
FUNCTION ATOI(s: St40): LongInt;
{
*** Converts a string into a integer/real
***
}
Var
Code: Integer;
lTemp: LongInt;
rTemp: Real;
Begin
Val(s, rTemp, Code);
If (Code <> 0) Then
rTemp := 0;
lTemp := Trunc(rTemp);
ATOI := lTemp;
End;
FUNCTION UpCase(C: Char): Char; Assembler; { will replace TP's built-in upcase }
ASM
MOV DL, C
MOV AX, $6520
INT $21
MOV AL, DL { function result in AL }
END;
FUNCTION UCase(s: String): String;
{
*** Converts any string(s) into upper case letters
***
}
Var
J : Integer;
Begin
For J := 1 to Length(s) Do
s[J] := StrIo.UpCase(s[J]);
UCase := S;
End;
FUNCTION RepStr(Times: Byte; Which: Char): String;
Var
J : Byte;
tString : String;
Begin
tString := '';
For J := 1 To Times Do
tString := tString + Which;
RepStr := tString;
End;
FUNCTION Strip_Path(Fullfilename: String): String;
Var
tString: String;
Begin
tString := FullFilename;
While (Pos('\', tString) <> 0) Do
Delete(tString, 1, Pos('\', tString));
Strip_Path := tString;
End;
{
Makes sure that NUMBER is DIGITS digits. Ie if DIGITS = 10 and NUMBER = 29
the result is 0000000029, 10 DIGITS :) Simple hugh?
}
FUNCTION Leading_Zero(Number: String; Digits: Byte): String;
Var
tString : String; {temporary zero holding spot}
NeedZeros : Integer; {Number of zeros needed}
J : Byte; {for the FOR-LOOP}
Begin
tString := '';
NeedZeros := Digits - Length(Number);
If (NeedZeros > 0) Then
Begin
for J := 1 TO NeedZeros Do
tString := tString + '0';
tString := tString + Number;
End
Else
tString := Number;
Leading_Zero := tString;
End;
FUNCTION Read_Str(StrLen : Byte;
InputFg,
InputBg : Integer;
Hidden,
Spaces : Char;
SpinWanted,
Display,
Upper,
OnlyNumbers,
AutoReturn : Boolean;
Default : String): String;
{
*** Gets string from local/remote
StrLen - String length
InputFg - Foreground for input
InputBg - Background for input
Hidden - character to display instead of entered characters or #0
Spaces - Character to display where nothing is written.
Display - Display output
Upper - force upper case
OnlyNumbers - Characters between 0-9 are allowed, nothing else
AutoReturn - Wheter to hig enter automatically after STRLENth character
SpinWanted - Wheter or not to spin a character
Default - Text displayed as if user/modem typed it in.
***
}
Var
ChIn : Char; {character read in}
StrCount: Integer; {current location in string}
J : Integer; {used in For-loop combo}
TempStr : String; {temporary string}
OldX,
OldY,
OldFg,
OldBg : Word; {save coordinates}
SpinCount: Byte;
Const
Spin : Array [1..4] Of Char = ('|', '/', '-', '\');
Begin
TempStr := '';
ChIn := #0;
StrCount := 0;
SpinCount := 0;
if Default <> #0 Then
Begin
TempStr := Default;
StrCount := Length(TempStr);
End;
If Display Then
Begin
OldX := WhereX;
OldY := WhereY;
OldFg := TextAttr MOD 16;
OldBg := TextAttr SHR 4;
TextColor(InputFg); TextBackground(InputBg);
if (Spaces < #32) Then
Spaces := #32;
For J := 1 to StrLen Do
Write(Spaces);
GotoXY(OldX, OldY);
If (Default <> #0) Then
Begin
For J := 1 to Length(Default) Do
If (Hidden <> #0) Then
Write(Hidden)
Else
Write(Default[J]);
End
End;
Repeat
Repeat
If SpinWanted Then
Begin
Inc(SpinCount);
If (SpinCount > 4) Then
SpinCount := 1;
Write(Spin[SpinCount]);
GotoXY(WhereX - 1, WhereY);
Delay(30);
Write(' ');
GotoXY(WhereX - 1, WhereY);
End;
Until Keypressed;
ChIn := Readkey;
If (ChIn = #0) Then
Exit;
If Upper then
ChIn := Upcase(ChIn);
Case UpCase(ChIn) Of
#19: Begin {left arrow}
If (StrCount > 1) Then
Begin
Dec(StrCount, 1);
If Display Then
GotoXY(WhereX - 1, WhereY);
End;
End;
#4: Begin {right arrow}
If (StrCount < StrLen) Then
Begin
Inc(StrCount, 1);
Insert(#32, TempStr, StrCount);
If Display Then
GotoXY(WhereX + 1, WhereY);
End;
End;
#8: Begin
If (StrCount > 0) Then
Begin
Dec(StrCount, 1);
If Display Then
Begin
GotoXY(WhereX - 1, WhereY);
Write(Spaces);
GotoXY(WhereX - 1, WhereY);
End;
Delete(TempStr, Length(TempStr), 1);
End;
ChIn := #0;
End;
#13: Begin
If Display Then
GotoXY(1, WhereY + 1);
End;
#32..#255: Begin
If (StrCount < StrLen) Then
Begin
If OnlyNumbers Then
Begin
Case ChIn Of
'0'..'9', '.': Begin
Inc(StrCount);
Insert(ChIn, TempStr, StrCount);
End;
Else {anything except numbers}
ChIn := #0;
End;
End {if onlynumbers then}
Else
Begin
Inc(StrCount);
Insert(ChIn, TempStr, StrCount);
End;
End
Else
ChIn := #0;
End;
Else
ChIn := #0;
End; {case}
If (StrCount = StrLen) Then
Begin
If AutoReturn Then
Begin
ChIn := #13;
GotoXY(1, WhereY + 1);
End;
End;
If Display AND (ChIn <> #0) Then
if (Hidden > #32) Then {space or no pw}
Write(Hidden)
Else
Write(ChIn);
Until (ChIn = #13) OR (ChIn = #27);
If Display Then
Begin
TextColor(OldFg);
TextBackground(OldBg);
End;
Read_Str := TempStr;
End;
PROCEDURE Flush_Keyboard_Buffer;
Var
ChIn : Char; {for clearing the keyboard buffer}
Begin
While Keypressed Do
ChIn := ReadKey;
End;
FUNCTION Right_Pad(s: String; MaxLength: Word): String;
Const
tString : String = '';
HowMany : Byte = 0;
J : Byte = 0;
Begin
J := 0;
HowMany := 0;
tString := '';
{check for greater then number strings}
If (Length(s) > MaxLength) Then
Begin
tString := Copy(s, 1, MaxLength);
Exit;
End
Else
Begin
HowMany := (MaxLength - Length(s));
Repeat
Inc(J);
tString := tString + #32;
Until J >= HowMany;
tString := s + tString;
End;
Right_Pad := tString;
End;
FUNCTION Right_Strip(s: String): String;
Var
StrLen,
Count : Byte;
Begin
StrLen := Length(s);
Count := StrLen + 1;
Repeat
Dec(Count);
Until (s[Count] <> #32);
Delete(s, Count + 1, StrLen - Count);
Right_Strip := S;
End;
FUNCTION Right_Justify(s: String; sl: Byte): String;
Var
tString2,
tString: String;
Where,
HowMuch: Byte;
Begin
tString := '';
tString2 := '';
tString := s;
If Length(tString) > Sl Then
Begin
tString2 := Copy(tString, 1, Sl);
Right_Justify := tString2;
Exit;
End;
Where := 1;
Where := sl - Length(tString);
FillChar(tString2, Where, #32);
Insert(tString, tString2, Where);
Delete(tString2, Where + Length(tString), Length(tString2) - (Where + Length(tString)) + 1);
Right_Justify := tString2;
End;
Function CommaNum (I : LongInt): String;
Var
TmpString : String;
Counter, Tester : Byte;
Begin
TmpString := '';
Counter := 0;
Tester := 0;
Str (i, TmpString);
For Counter := Length (TmpString) Downto 1 Do
Begin
Inc (Tester);
If Tester = 3 Then
Begin
Tester := 0;
Dec (Counter);
TmpString := Copy (TmpString, 1, Counter) + ','
+ Copy (TmpString, Counter + 1, Length (TmpString) );
Inc (Counter);
End;
End;
If TmpString[1] = ',' THEN DELETE(TmpString,1,1);
CommaNum := TmpString;
End;
{Returns the path from C:\BLOB\SHOOT\DIS.THD would give you C:\BLOB\SHOOT}
FUNCTION Strip_Filename(S: String): String;
Var
SlashPos : Byte;
tString : String;
Begin
tString := '';
SlashPos := Pos('\', S);
If SlashPos = 0 Then
Begin
Strip_Filename := '';
Exit;
End;
Repeat
SlashPos := Pos('\', S);
tString := tString + Copy(S, 1, SlashPos);
Delete(s, 1, SlashPos);
Until SlashPos = 0;
Strip_FIlename := tString;
End;
BEGIN
END.
[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]