[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]
Procedure ReadP (Var NewIn : String; OldIn : String; X,Y,Colr : Byte;
FChar : Char; ValidChars : ChSet; Patrn : String);
(* NewIn = Variable containing data entered by user
OldIn = Default input string
X,Y = Coordinates to begin reading
FChar = Fill character at End-of-String
ValidChars = Set of Char of characters valid for input
(in some cases is redundant)
Patrn = String containing three different chars:
'X's for blank space (no data)
'#'s for numbers only
'@'s for alpha characters only
'%'s for both alpha & numeric
characters *)
(* When calling ReadP, the prompt should already be on-screen. X,Y locates
the point to begin the reading. When ReadP returns a value in NewIn,
please note that a pattern of '###X###X####' will be returned looking like
'##########'. The X's do not denote a space in the final string. ie:
Please Enter Your Phone Number: (403) 123-4567
will be returned in NewIn as 4031234567. The pattern would have resembled
the example above.
** NOTE ** There are functions/procedures required to run this procedure.
They are:
GetCursor (not necessary)
SetCursor (not necessary)
WriteP (pattern-writing routine, see next few
posts, is necessary)
A demo program is included at the bottom of the message.
*)
(* Standard disclaimer: I'm not liable for anything this procedure does
outside the original purpose of the procedure. If
something bad happens, let me know, but that's all
I can do.
*)
Var
CurX, StLen, PatX, NumXs, MaxLen,
Tmp : Byte;
DefChars : Set Of Char;
OldCursor : Word;
Begin
Tmp := 0;
For I := 1 To Length (Patrn) Do
If Patrn[I] = 'X' Then
Inc (Tmp);
If Length (OldIn) > Length (Patrn)-Tmp Then
OldIn := Copy (OldIn,1,Length (Patrn)-Tmp);
WriteP (OldIn,X,Y,HiColr,FChar,Patrn);
InStr := OldIn;
StLen := Length (OldIn);
NumXs := 0;
For I := 1 To StLen Do
If Patrn[I] = 'X' Then
Inc (NumXs);
CurX := StLen+X+NumXs;
PatX := StLen+NumXs+1;
If PatX = 0 Then
Begin
PatX := 1;
CurX := X;
End;
DefChars := ValidChars;
MaxLen := Length (Patrn);
OldCursor := GetCursor;
Repeat
If PatX = 0 Then
Begin
PatX := 1;
CurX := X;
End;
While Patrn[PatX] = 'X' Do
Begin
Inc (PatX);
Inc (CurX);
End;
NumXs := 0;
For I := 1 To PatX Do
If Patrn[I] = 'X' Then
Inc (NumXs);
If InsOn Then
SetCursor (DefaultCursor)
Else
SetCursor (BlockCursor);
GotoXY (CurX,Y);
Case Patrn[PatX] Of
'#': ValidChars := NumChars;
'@': ValidChars := AlphaChars;
'%': ValidChars := NumChars + AlphaChars;
End;
ValidChars := ValidChars + [#8,#13,#210,#211] + HKeySet + FuncKeys +
MenuKeys + ArrowKeys;
Repeat
Ch := ReadKey;
Until Ch In ValidChars;
SetCursor (OldCursor);
Case Ch Of
#8:
Begin
If PatX >= 2 Then
Begin
If Patrn[PatX-1] = 'X' Then
Begin
While (Patrn[PatX-1] = 'X') And (PatX > 1) Do
Begin
Dec (PatX);
Dec (CurX);
End;
Dec (PatX);
Dec (CurX);
End
Else
Begin
Dec (CurX);
Dec (PatX);
End;
If (CurX >= X) And (Length (InStr) > 0) Then
Begin
NumXs := 0;
For I := 1 To PatX Do
If Patrn[I] = 'X' Then
Inc (NumXs);
Delete (InStr,PatX-NumXs,1);
End;
End;
End;
#203: { Left arrow }
Begin
If CurX > X Then
If Patrn[PatX-1] <> 'X' Then
Begin
Dec (CurX);
Dec (PatX);
End
Else
Begin
While Patrn[PatX-1] = 'X' Do
Begin
Dec (CurX);
Dec (PatX);
End;
Dec (CurX);
Dec (PatX);
End;
If PatX < 1 Then
Begin
CurX := X;
PatX := 1;
End;
End;
#205: { Right arrow }
If PatX-NumXs <= Length (InStr) Then
If Patrn[PatX+1] <> 'X' Then
Begin
Inc (CurX);
Inc (PatX);
End
Else
Begin
Inc (CurX);
Inc (PatX);
While Patrn[PatX] = 'X' Do
Begin
Inc (CurX);
Inc (PatX);
End;
End;
#199: { Home }
Begin
CurX := X;
PatX := 1;
End;
#207: { End }
Begin
PatX := Length (InStr)+1;
For I := 1 To PatX Do
If Patrn[I] = 'X' Then
Inc (PatX);
CurX := PatX+X-1;
End;
#210: { Insert }
InsOn := InsOn XOr True;
#211: { Delete }
Delete (InStr,PatX-NumXs,1);
#65..#90,
#97..#122, { Alphabet }
#48..#57, { Numbers }
#91..#96,
#32..#47,
#58..#64: { Other chars }
Begin
If (CurX-X < MaxLen) And (((Length (InStr) < MaxLen) And
(InsOn)) Or ((Not InsOn))) Then
Begin
If InsOn Then
Insert (Ch,InStr,PatX-NumXs)
Else
Begin
If PatX-NumXs > Length (InStr) Then
Insert (Ch,InStr,PatX-NumXs)
Else
InStr[PatX-NumXs] := Ch;
End;
Inc (CurX);
Inc (PatX);
End;
End;
End;
If Length (InStr) > Length (Patrn) Then
InStr[0] := Chr (Length (Patrn));
WriteP (InStr,X,Y,Colr,FChar,Patrn);
Until (Ch = #13) Or (Ch = #27);
If Ch = #27 Then
NewIn := '';
If Ch = #13 Then
NewIn := InStr;
End;
[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]