home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
basic
/
baswiz18.zip
/
BW$BAS.ZIP
/
WINPUT.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-08-29
|
6KB
|
160 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990-1992 Thomas G. Hanlin III |
' | |
' | The BASIC Wizard's Library |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB WCursor (BYVAL Handle%, BYVAL CSize%)
DECLARE SUB WGetCursor (BYVAL Handle%, CSize%)
DECLARE SUB WGetLocate (BYVAL Handle%, Row%, Column%)
DECLARE SUB WGetSize (BYVAL Handle%, Rows%, Columns%)
DECLARE SUB WGetView (BYVAL Handle%, Row%, Column%)
DECLARE SUB WGetVSize (BYVAL Handle%, Rows%, Columns%)
DECLARE SUB WGetTop (Handle%)
DECLARE SUB WLocate (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
DECLARE SUB WTop (BYVAL Handle%)
DECLARE SUB WUpdate ()
DECLARE SUB WView (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
DECLARE SUB WWrite (BYVAL Handle%, St$)
DEFINT A-Z
SUB WInput (Handle, Valid$, ExitCode$, ExtExitCode$, MaxLength, St$, ExitKey$)
DEF SEG = 0
OldInsert = (PEEK(&H417) AND &H80)
WGetCursor Handle, OldCSize
WGetLocate Handle, StartRow, StartCol
WGetSize Handle, WinRows, WinCols
WGetVSize Handle, VirtRows, VirtCols
IF MaxLength > VirtCols - StartCol OR MaxLength < 1 THEN
MaxLen = VirtCols - StartCol
ELSE
MaxLen = MaxLength
END IF
IF MaxLen = 0 THEN EXIT SUB
St$ = LEFT$(St$, MaxLen)
InputCol = 0
ExitKey$ = ""
WGetTop TopHandle
IF Handle <> TopHandle THEN WTop Handle
WWrite Handle, St$
WLocate Handle, StartRow, StartCol
GOSUB InsureVisible
DO
DO
Ky$ = INKEY$
LOOP UNTIL LEN(Ky$)
SELECT CASE LEN(Ky$)
CASE 1: IF INSTR(ExitCode$, Ky$) THEN ExitKey$ = Ky$
CASE 2: IF INSTR(ExtExitCode$, RIGHT$(Ky$, 1)) THEN ExitKey$ = Ky$
END SELECT
IF LEN(ExitKey$) = 0 THEN
IF LEN(Ky$) = 2 THEN
SELECT CASE ASC(RIGHT$(Ky$, 1))
CASE 71: GOSUB ToStart ' move to line start
CASE 75: GOSUB LeftOnce ' left by one char
CASE 77: GOSUB RightOnce ' right by one char
CASE 79: GOSUB ToEnd ' move to line end
CASE 82: GOSUB InsureVisible ' toggle insert mode
CASE 83: GOSUB DeleteChr ' delete char
CASE ELSE
END SELECT
ELSEIF Ky$ < " " THEN
SELECT CASE CHR$(ASC(Ky$) + 64)
CASE "D": GOSUB RightOnce ' right by one char
CASE "G": GOSUB DeleteChr ' delete char
CASE "H": GOSUB Backspace ' backspace
CASE "S": GOSUB LeftOnce ' left by one char
CASE "V": POKE &H417, PEEK(&H417) XOR &H80 ' toggle insert mode
GOSUB InsureVisible
CASE ELSE
END SELECT
ELSEIF LEN(St$) < MaxLen THEN
IF LEN(Valid$) = 0 OR INSTR(Valid$, Ky$) > 0 THEN
IF PEEK(&H417) AND &H80 THEN
St$ = LEFT$(St$, InputCol) + Ky$ + MID$(St$, InputCol + 1)
ELSEIF LEN(MID$(St$, InputCol + 1, 1)) THEN
MID$(St$, InputCol + 1, 1) = Ky$
ELSE
St$ = St$ + Ky$
END IF
WLocate Handle, StartRow, StartCol
WWrite Handle, St$
InputCol = InputCol + 1
WLocate Handle, StartRow, StartCol + InputCol
GOSUB InsureVisible
END IF
END IF
WUpdate
END IF
LOOP UNTIL LEN(ExitKey$)
WCursor Handle, OldCSize
WUpdate
POKE &H417, PEEK(&H417) AND &H7F OR OldInsert
EXIT SUB
InsureVisible:
WGetView Handle, WinRow, WinCol
IF StartCol + InputCol < WinCol THEN
WView Handle, WinRow, StartCol + InputCol
ELSEIF StartCol + InputCol > WinCol + WinCols - 1 THEN
WView Handle, WinRow, StartCol + InputCol - WinCols + 1
END IF
IF PEEK(&H417) AND &H80 THEN
WCursor Handle, 3
ELSE
WCursor Handle, 1
END IF
WUpdate
RETURN
LeftOnce:
IF InputCol THEN
InputCol = InputCol - 1
WLocate Handle, StartRow, StartCol + InputCol
GOSUB InsureVisible
END IF
RETURN
ToStart:
InputCol = 0
WLocate Handle, StartRow, StartCol
GOSUB InsureVisible
RETURN
RightOnce:
IF InputCol < LEN(St$) THEN
InputCol = InputCol + 1
WLocate Handle, StartRow, StartCol + InputCol
GOSUB InsureVisible
END IF
RETURN
ToEnd:
InputCol = LEN(St$)
WLocate Handle, StartRow, StartCol + InputCol
GOSUB InsureVisible
RETURN
Backspace:
IF InputCol THEN
InputCol = InputCol - 1
WLocate Handle, StartRow, StartCol + InputCol
GOSUB DeleteChr
END IF
RETURN
DeleteChr:
IF LEN(St$) THEN
St$ = LEFT$(St$, InputCol) + MID$(St$, InputCol + 2)
WLocate Handle, StartRow, StartCol
WWrite Handle, St$ + " "
WLocate Handle, StartRow, StartCol + InputCol
GOSUB InsureVisible
END IF
RETURN
END SUB