[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]
{ Version 1.5 of...
Yet Another, Quite General Input Routine (YA-QGIR, pronounced YA-QJUGEER)
--------------------------------------------------------------------------
This one is (C)1993,1994 Eddy Jansson, P.I - No Rights Reserved.
The following routines may be used in your own programs, as long as
you promise to modify them to meet your own needs.
Ofcourse I take *NO* responsability for any injuries inflicted on man
or animal or cause of dataloss from these routines. These routines
may NOT be used in whole, or in part, in any life supporting, nuclear
or weapon related systems.
// Eddy Jansson FidoNet: 2:206/406
InterNet: eddy.jansson@haricot.ct.se
Usage of the Input Routine:
Function Input(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos:
Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):
String;
X,Y Where on screen to put the input.
StartStr Default input string.
BackG Background Character, eg ' ' or '°' etc.
PassChar If defined this character will be displyed instead of the input
stream.MaxLen MaxLen of Input.
StartPos Where in input string to place the cursor, -1 = End of StartStr
AcceptSet Which characters should be accepted as input, often [#32..#255]
NOTE: if you include #8 in this mask, you cannot use delete.
Ins Begin in INSERT or OVERWRITE mode (Boolean)
InputStatus Upon exit from the input routine this variable will hold:
13 = Input terminated with Enter.
27 = Input terminated with ESC.
72 = User pressed UpArrow
80 = User pressed DownArrow
73 = User pressed Page Up
81 = User pressed Page Down
etc...
Next Version: Window (ie; edit 255 chars in a 16 char window)
ExitChar Mask
}
Uses Crt;
type
CharSet = Set of #0..#255; { This MUST be present for the routine to work }
var
S :String[80];
IS :Byte;
{ ------ START OF GENERAL ROUTINES ------ }
Function Left(s: String;nr: byte): String;
begin
Delete(s,nr+1,length(s));
Left:=s;
end;
Function Mid(s: String;nr,nr2: byte): String;
begin
Delete(s,1,nr-1);
Delete(s,nr2+1,length(s));
Mid:=s;
end;
Procedure WriteXY(x,y: Byte;s: String);
var
loop: Word;
begin (* This can be _higly_ optimized *)
for loop:=x to x+length(s)-1 do
Mem[$B800:(loop-1)*2+(y-1)*160]:=Ord(S[loop-x+1]);end;
Function RepeatChar(s: String;antal: byte): String;
var
temp: String;
begin
temp:=s[1];
While Length(temp)<Antal do Insert(s[1],temp,1);
RepeatChar:=Temp;
end;
Procedure NormalCursor; Assembler;
asm
mov ah,1
mov ch,6
mov cl,7
int $10
end;
Procedure BlockCursor; Assembler;
asm
mov ah,1
mov ch,0
mov cl,7
int $10
end;
{ ------ END OF GENERAL ROUTINES ------ }
Function Input(X,Y: Byte;StartStr,BackG,PassChar: String;MaxLen,StartPos:
Integer;AcceptSet: CharSet;Ins: Boolean;var InputStatus: Byte):
String;{Version 1.5}
Var
P :Byte;
Exit :Boolean;
ch :Char;
ext :Char;
s :String;
t :String[1];
begin
Exit:=False; { Don't quit on me yet! }
if Length(PassChar)>1 then PassChar:=PassChar[1]; { Just in Case... ;-) }
if Length(BackG)>1 then BackG:=BackG[1];
if Length(BackG)=0 then BackG:=' ';
if Length(StartStr)>MaxLen then StartStr:=Left(StartStr,MaxLen);
if StartPos>Length(StartStr) then StartPos:=Length(StartStr);
if StartPos=-1 then StartPos:=Length(StartStr);
If StartPos>=MaxLen then StartPos:=MaxLen-1;
s:=StartStr; { Put StartStr into Edit Buffer }
WriteXY(X,Y,RepeatChar(BackG,MaxLen));
if StartStr<>'' then begin
if passchar='' then WriteXY(X,Y,StartStr) else
WriteXY(X,Y,RepeatChar(PassChar,Length(StartStr)));
end;
p:=StartPos;
GotoXY(X+StartPos,Y);
repeat
if Ins then NormalCursor else BlockCursor;
ext:=#0;
ch:=ReadKey;
if ch=#0 then ext:=ReadKey;
if ch=#27 then begin
InputStatus:=27;
Exit:=True;
end;
{ (ch<#255) and (ch>#31) }
if ch in AcceptSet then
begin { Welcome to the jungle...}
t:=ch;
if (p=length(s)) and (Length(s)<MaxLen) then
begin
s:=s+t;
if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar);
Inc(p);
end else
if length(s)<MaxLen then begin
if Ins then Insert(T,S,P+1) else s[p+1]:=Ch;
if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(S))) else
WriteXY(X+Length(S)-1,Y,PassChar); Inc(p);
end else if (Length(s)=MaxLen) and (not Ins) then
begin
s[p+1]:=ch;
if PassChar='' then WriteXY(X+P,Y,T) else WriteXY(X+P,Y,PassChar);
Inc(p);
end;
ch:=#0;
if p>MaxLen-1 then p:=MaxLen-1;
GotoXY(X+P,Y);
end else begin
case ch of { CTRL-Y }
#25: begin
WriteXY(X,Y,RepeatChar(BackG,Length(S)));
P:=0;
S:='';
GotoXY(X,Y);
end;
{Backspace}
#8: If (P>0) then
begin
if (p+1=MaxLen) and (p<length(s)) then Ext:=#83 else
begin
Delete(S,P,1);
Dec(P);
GotoXY(X+P,Y);
if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else
if P>0 then WriteXY(X+Length(s)-1,Y,PassChar+BackG) else
WriteXY(X+Length(s),Y,BackG);
end;
end;
#9: begin { Exit on TAB }
InputStatus:=9;
Exit:=True;
end;
#13: begin
InputStatus:=13;
Exit:=True;
end;
end; { Case CH of }
case ext of
#75: if P>0 then begin
{Left Arrow} Dec(P);
GotoXY(X+P,Y);
end;
#77: if (P<Length(s)) and (P+1<MaxLen) then begin
{Right Arrow} Inc(P);
GotoXY(X+P,Y);
end;
#82: Ins:=Not(Ins); {Insert}
{Delete}
#83: If P<Length(s) then
begin
Delete(S,P+1,1);
if PassChar='' then WriteXY(X+P,Y,Copy(S,P+1,Length(s))+BackG) else
if p>0 then WriteXY(X+Length(S)-1,Y,PassChar+BackG) else
WriteXY(X+Length(S),Y,BackG);
end;
#71: begin
p:=0;
GotoXY(X+P,Y);
end;
#79: begin
p:=Length(s);
if p>=MaxLen then P:=MaxLen-1;
GotoXY(X+P,Y);
end;
#72,#73,#80,#81,#59..#68:
begin
InputStatus:=Ord(Ext);
Exit:=True;
end;
end; {Case of EXT }
end; { if not normal char }
until Exit;
Input:=S;
end;
BEGIN
Write('Enter Your Name: ');
S:=Input(WhereX,WhereY,'KLoPPeR','°','',35,-1,[#32..#175],True,IS);
WriteLn;
WriteLn('Hello '+S+', have a nice day today!');
END.
[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]