[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]
unit GS_KeyI;
{ Written by Richard F Griffin
1 December 1988, (Released to the public domain)
1110 Magnolia Circle
Papillion, Nebraska 68128
CIS 75206.231
This unit allows you to set data entry routines quickly and simply.
It also gives the programmer the capability to override the entry
routine and use another procedure to handle function keys.
}
interface
uses crt, dos;
type
GS_KeyI_str80 = string[80];
var
GS_KeyI_Chr : char;
GS_KeyI_Fuc,
GS_KeyI_Esc : boolean;
GS_KeyI_Hlp : pointer;
GS_KeyI_Psn : integer;
Function GS_KeyI_Get : char;
procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);
function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
CVal:GS_KeyI_str80) : GS_KeyI_str80;
function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;
function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
XVal,l,h:real;d:integer) : real;
implementation
var
Big_String : GS_KeyI_str80;
{$F+}
procedure GS_KeyI_Dum;
begin
write(#7);
end;
{$F-}
{
This procedure is an Inline far call. The address is inserted by
GS_KeyI_Call based on the address in GS_KeyI_Hlp. This address is
initially to GS_KeyI_Dum, but may be changed by the using program.
ex: GS_KeyI_Hlp := @MyProcedure
The procedure will be called when a special function key (F1, F2,
Home, RtArrow, etc.) is pressed during data entry. The using procedure
may then use GS_KeyI_Chr to find which key was pressed. It is up to the
using program to ensure the screen and window sizes are properly restored.
The programmer must ensure that the $F+ option is used in the procedure
to force a Far Return.
----------- DO NOT MODIFY THIS ROUTINE ------------
}
procedure GS_KeyI_Jmp;
begin
InLine ($9A/$00/$00/$00/$00); {CALLF [GS_KeyI_Hlp]}
end;
{
Inserts a Far Call address for GS_KeyI_Jmp.
Works in TP 4 and 5.
}
procedure GS_KeyI_Call;
begin
MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+11] := ofs(GS_KeyI_Hlp^);
MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+13] := seg(GS_KeyI_Hlp^);
GS_KeyI_Jmp;
end;
Function GS_KeyI_Get : char;
var ch: char;
begin
Ch := ReadKey;
If (Ch = #0) then { it must be a function key }
begin
Ch := ReadKey;
GS_KeyI_Fuc := true;
end
else GS_KeyI_Fuc := false;
GS_KeyI_Get := Ch;
end;
procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);
Var
Big_S : GS_KeyI_str80;
i : integer;
begin
Big_s := '';
GS_KeyI_Psn := 0;
gotoxy(x,y);
Repeat
GS_KeyI_Chr := GS_KeyI_Get;
GS_KeyI_Esc := false;
if not GS_KeyI_Fuc then
begin
case GS_KeyI_Chr of
#08 : begin
If GS_KeyI_Psn > 0 then
begin
GS_KeyI_Psn := GS_KeyI_Psn - 1;
gotoxy(x+GS_KeyI_Psn,y);
write('_');
gotoxy(x+GS_KeyI_Psn,y);
delete(Big_S,length(Big_S),1);
end else
begin
write('_');
gotoxy(x+GS_KeyI_Psn,y);
end;
end;
' '..'}' : begin
if (GS_KeyI_Psn = Fldcnt) and (wait) then
write(#7)
else begin
if GS_KeyI_Psn = 0 then
begin
for i := 1 to Fldcnt do write('_');
gotoxy(x,y);
end;
GS_KeyI_Psn := GS_KeyI_Psn + 1;
write(GS_KeyI_Chr);
Big_S := Big_S + GS_KeyI_Chr;
end;
end;
#27 : begin
Big_S := ' ';
GS_KeyI_Esc := true;
end;
end;
end else
begin
GS_KeyI_Call;
gotoxy(x+GS_KeyI_Psn,y);
end;
until (GS_KeyI_Chr in [#13,#27]) or ((GS_KeyI_Psn = Fldcnt) and (not wait));
Big_String := Big_S;
end;
{ The GS_KeyI_T function will process an input from the keyboard and display
it on the screen in a specified location. The length of the input field is
given, as well as a default entry. The default entry is optionally shown
on the screen.
Parameter descriptions are:
1 Boolean flag to determine whether to wait for a carriage return
once the field is full.
2 Length of input field.
3 Horizontal location to start.
4 Vertical position to start.
5 Vertical line to place default value. Should be 0 to inhibit
display of default. Will usually be the same as (4).
6 The prompt to place on the screen prior to the data entry field.
Should be '' if no prompt.
7 Default value.
}
function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
CVal:GS_KeyI_str80) : GS_KeyI_str80;
var
i : integer;
begin
GS_KeyI_T := '';
gotoxy(x,y);
write(CTitl);
for i := 1 to Fl do write('_');
if B <> 0 then
begin
gotoxy(x+length(CTitl),B);
write(CVal);
end;
GS_KeyI_Key(waitcr,FL,x+length(CTitl),y);
if Big_String = '' then Big_String := CVal;
if GS_KeyI_Esc then Big_String := ' ';
gotoxy(x+length(CTitl),y);
write(Big_String,'':Fl-length(Big_String));
if (B <> 0) and (B <> Y) then
begin
gotoxy(x+length(CTitl),B);
write('':length(CVal));
end;
GS_KeyI_T := Big_String;
end;
{ The GS_KeyI_I function will accept an integer from the keyboard and display
it on the screen in a specified location. The length of the input field is
given, as well as a default entry. The default entry is optionally shown
on the screen. A range of acceptable values is also specified.
Parameter descriptions are:
1 Boolean flag to determine whether to wait for a carriage return
once the field is full.
2 Length of input field.
3 Horizontal location to start.
4 Vertical position to start.
5 Vertical line to place default value. Should be 0 to inhibit
display of default. Will usually be the same as (4).
6 The prompt to place on the screen prior to the data entry field.
Should be '' if no prompt.
7 Default value.
8 Lowest value acceptable.
9 Highest value acceptable.
}
function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;
Var
Cod, q, i : integer;
CVal : GS_KeyI_str80;
begin
str(XVal:Fl,CVal);
Cod := 1;
while Cod <> 0 do
begin
Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
if GS_KeyI_Esc then
begin
GS_KeyI_I := XVal;
Exit;
end;
if Big_String[length(Big_String)] = ' ' then
Big_String := 'z';
for i := 1 to length(Big_String) do
if Big_String[i] = ' ' then Big_String[i] := '0';
val(Big_String,q,Cod);
if Cod <> 0 then
begin
write(chr(7));
end else
begin
if (q < l) or (q > h) then
begin
Cod := 1;
write(chr(7));
end;
end;
end;
GS_KeyI_I := q;
end;
{ The GS_KeyI_R function will accept a real number from the keyboard and
display it on the screen in a specified location. The length of the
input field is given, as well as a default entry. The default entry
is optionally shown on the screen. A range of acceptable values is
also specified.
Parameter descriptions are:
1 Boolean flag to determine whether to wait for a carriage return
once the field is full.
2 Length of input field.
3 Horizontal location to start.
4 Vertical position to start.
5 Vertical line to place default value. Should be 0 to inhibit
display of default. Will usually be the same as (4).
6 The prompt to place on the screen prior to the data entry field.
Should be '' if no prompt.
7 Default value.
8 Lowest value acceptable.
9 Highest value acceptable.
10 Number of decimal places.
}
function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
XVal,l,h:real;d:integer) : real;
Var
Cod, i : integer;
CVal : GS_KeyI_str80;
r : real;
begin
str(XVal:Fl:d,CVal);
Cod := 1;
while Cod <> 0 do
begin
Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
if GS_KeyI_Esc then
begin
GS_KeyI_R := XVal;
Exit;
end;
if Big_String[length(Big_String)] = ' ' then
Big_String := 'z';
for i := 1 to length(Big_String) do
if Big_String[i] = ' ' then Big_String[i] := '0';
val(Big_String,r,Cod);
if Cod <> 0 then
begin
write(chr(7));
end else
begin
if (r < l) or (r > h) then
begin
Cod := 1;
write(chr(7));
end;
end;
end;
gotoxy(x+length(CTitl),y);
str(r:Fl:d,Big_String);
write(Big_String,'':Fl-length(Big_String));
GS_KeyI_R := r;
end;
begin
GS_KeyI_Hlp := @GS_KeyI_Dum;
end.
{---------------- DEMO PROGRAM ------------------------ }
program KeyIDemo;
uses crt, dos, GS_KeyI;
var
lin : string[80];
numi : integer;
numr : real;
{$F+}
procedure tst;
begin
window(1,20,80,24);
ClrScr;
gotoxy(20,1);
case GS_KeyI_Chr of
#59 : write('Function Key F1 Pressed');
#60 : write('Function Key F2 Pressed');
#61 : write('Function Key F3 Pressed');
#62 : write('Function Key F4 Pressed');
#71 : write('The Home Key was Pressed');
#79 : write('The End Key was Pressed');
else
write(#7);
end;
window(1,1,80,25);
end;
{$F-}
begin
clrscr;
GS_KeyI_Hlp := @tst;
lin := GS_KeyI_T(true, 8,10,1,1,'Enter Text Field: ','empty');
numi := GS_KeyI_I(true, 2,10,2,2,'Enter Integer Field (0-50): ',0,0,50);
numr:= GS_KeyI_R(true, 6,10,3,3,'Enter Real Field (0-99.99): ',0,0,99.99,2);
end.
[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]