[2022 Aug 18] An enhanced version is now in a later comment.
Code: Select all
' Subroutine Extended Input Subroutine
' Author: Donald S Montaine
' released under the Creative Commons CC-BY license
Sub ExtInput(ByVal StartY as integer, _ ' Column number of first character of entry field
ByVal StartX as integer, _ ' Row number of first character of entry field
ByVal DispLen as integer, _ ' Length of Entry Fild
ByVal OrigForeColor as integer, _ ' Color code of characters entered after entry accepted
ByVal OrigBackColor as integer, _ ' Color code of background after entry accepted
ByVal EditForeColor as integer, _ ' Color code of characters during entry
ByVal EditBackColor as integer, _ ' Color code of background during entry
ByRef EditString as string, _ ' The string being edited
ByRef ExitCode as integer) ' '''key code that caused edit to end
' Navigation Key Codes
' dim CtrlLeftArrow as integer = 28695 ' Ctrl Key + Left Arrow Key Code
' dim CtrlRightArrow as integer = 29951 ' Ctrl Key + Right Arrow Key Code
' dim InsertKey as integer = 21047 ' Insert Key Code
' dim TabKey as integer = 9 ' Tab Key Code
dim LeftArrow as integer = 19455 ' Left Arrow Code
dim RightArrow as integer = 19967 ' Right Arrow Code
dim HomeKey as integer = 18431 ' Home Key Code
dim EndKey as integer = 20479 ' End Key COde
dim BackKey as integer = 8 ' Back Key Code
dim DelKey as integer = 21503 ' Del Key Code
dim EscKey as integer = 27 ' Escape Key Code
dim EnterKey as integer = 13 ' Enter Key Code
dim KeyVal as integer ' The scan code for the last key pressed
dim CursorLoc as integer ' Location of cursor in entry field
locate StartY, StartX
color EditForeColor,EditBackColor
print EditString + space(DispLen-len(EditString)) ;
CursorLoc = len(EditString) + 1
locate StartY, StartX+CursorLoc-1
do
KeyVal = getkey()
select case KeyVal
Case 32 to 127
'handle printable character
if len(EditString) < DispLen then
if CursorLoc <= Len(EditString) then
EditString = Left(EditString,CursorLoc-1) + chr(KeyVal) + Right(EditString,len(EditString)-(CursorLoc)+1)
locate StartY, StartX
color EditForeColor,EditBackColor
print EditString + space(DispLen-len(EditString)) ;
if CursorLoc < DispLen then
CursorLoc += 1
end if
locate StartY, StartX+CursorLoc-1
else
EditString += chr(KeyVal)
if CursorLoc < DispLen then
CursorLoc += 1
end if
print chr(KeyVal);
locate StartY, StartX+CursorLoc-1
end if
end if
case LeftArrow
if CursorLoc > 1 then
CursorLoc -= 1
locate StartY, StartX+CursorLoc-1
end if
case RightArrow
if CursorLoc < len(EditString)+1 and CursorLoc <= DispLen then
CursorLoc += 1
locate StartY, StartX+CursorLoc-1
end if
case HomeKey
CursorLoc = 1
locate StartY, StartX+CursorLoc-1
Case EndKey
CursorLoc = len(EditString)
if CursorLoc = 0 then CursorLoc = 1
IF CursorLoc > DispLen then CursorLoc = DispLen
locate StartY, StartX+CursorLoc-1
case DelKey
EditString = left(EditString,CursorLoc-1) + right(EditString,len(EditString)-(CursorLoc))
locate StartY, StartX
color EditForeColor,EditBackColor
print EditString + space(DispLen-len(EditString)) ;
locate StartY, StartX+CursorLoc-1
case BackKey
if CursorLoc > 1 then
CursorLoc -= 1
EditString = left(EditString,CursorLoc-1) + right(EditString,len(EditString)-(CursorLoc))
locate StartY, StartX
color EditForeColor,EditBackColor
print EditString + space(DispLen-len(EditString)) ;
locate StartY, StartX+CursorLoc-1
end if
end select
loop until KeyVal = EscKey or KeyVal = EnterKey
ExitCode = KeyVal
locate StartY, StartX
color OrigForeColor, OrigBackColor
print space(DispLen) ;
locate StartY, StartX
print EditString ;
End Sub