Windows Console - Extended Input Subroutine

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dmontaine
Posts: 23
Joined: Mar 15, 2018 7:13

Windows Console - Extended Input Subroutine

Post by dmontaine »

This is an extended input routine for the Windows console. I have tested it using WIndows 10 and the standard US Keyboard.
[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
Last edited by dmontaine on Aug 19, 2022 4:44, edited 2 times in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Windows Console - Extended Input Subroutine

Post by deltarho[1859] »

With such code, it is a good idea to include a usage example and typical output.

Yes, it may be free, but you still have to 'sell it'. :)
dmontaine
Posts: 23
Joined: Mar 15, 2018 7:13

Re: Windows Console - Extended Input Subroutine

Post by dmontaine »

Here is the subroutine included in a program that shows how it works.

Code: Select all

'Program: extInputExample
' This program is an example of how to use the
' Windows console extInput subroutine

'==================================================
' extInptut Subroutine
'==================================================
' Extended Input Subroutine
' copyright 2022 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 ReturnForeColor as integer, _           ' Color code of characters entered after entry accepted
             ByVal ReturnBackColor 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)                    ' The 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 137 
            '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 ReturnForeColor, ReturnBackColor
   print space(DispLen) ; 
   locate StartY, StartX
   print EditString ;  
End Sub

'=======================================
' MAIN PROGRAM
'=======================================

' Set console size and color
width 80,24

' Colors Enumeration (0 - 15) ie Black = 1, Cyan = 4 etc
Enum
   Black : Blue : Green : Cyan : Red : Majenta : Brown : LightGrey : DarkGrey 
   BrightBlue : BrightGreen : BrightCyan : BrightRed : BrightMajenta : Yellow : White
end enum

' Other Variables
dim ExitCode   as integer                              ' The keyboard code that caused entry field to exit
dim InData     as string                               ' Variable used to paas original and receive changed data
dim OldData    as string = "Change Me!"                ' Data before being passed to the subroute

cls                                                    ' Clear the console screen

'this will display an input field at y=10 x=10 with a maximum input of 20 characters
'the input field will be Black lettering on a light grey field
'and after input the entered string will be displayed as yellow on blacok
'existing data can be passed in the InData variable and any changes will be
'returned in the same variable.  The exit code varialbe will return either
'13 for a carriage return ending input or 27 for the escape key ending input
InData = OldData
extInput(10,10,20,Yellow,Black,Black,LightGrey,InData,ExitCode)
locate 12,10
print "The original data was:     " + OldData ;
locate 13,10
print "The entered string is:     " + InData ;
locate 14,10
print "The returned exit code is: " + str(ExitCode) ;
locate 16,10
print "Press any key to exit. " ;

sleep
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Windows Console - Extended Input Subroutine

Post by deltarho[1859] »

I can see quite a few 'buying' that. 8)
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Windows Console - Extended Input Subroutine

Post by Lothar Schirm »

Nice code! Nearly the same as I use it myself for console programs. You can easily extend your code if you do not only use ESC or ENTER as Exitcode, but also the cursor keys UP, DOWN and also TAB and SHIFT TAB so that you can navigate within an arry of input fields. This allows you to enter data into input masks or tables in a comfortable way.
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Windows Console - Extended Input Subroutine

Post by caseih »

Runs fine in a Linux terminal. Also works in a graphics mode window, although no cursor is visible.

I also made a very similar input routine many years ago in TurboBASIC. It's a good way of doing input fields in a procedural way.
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Windows Console - Extended Input Subroutine

Post by fxm »

fxm wrote: Jul 06, 2021 14:33 The following 'myLineInput()' subroutine simulates a simplified 'Line Input' feature but supporting a potential predefined string, by using a looping around the 'Inkey' keyword.
The only supported control keys are 'BkSp', 'Del', 'Right', 'Left', 'Esc' (and 'Enter'), and all this in "insert" mode:

Code: Select all

Sub myLineInput(ByRef prompt As String = "", Byref inputline As String = "", ByVal sleeptime As Integer = 15)
    Dim As String inputchr
    Dim As Integer cursor
    Dim As Integer cursor0
 
    cursor = Len(inputline)
    Locate  , , 0
    Print prompt & " ";
    cursor0 = Pos()
    Print inputline & "_";
    Do
        inputchr = Inkey
        If inputchr <> "" Then
            If inputchr >= Chr(32) And inputchr < Chr(255) Then
                inputline = Left(inputline, cursor) & inputchr & Mid(inputline, cursor + 1)
                cursor += 1
            ElseIf inputchr = Chr(08) And Cursor > 0 Then                         'BkSp
                cursor -= 1
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) & "S" And Cursor < Len(inputline) Then     'Del
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) + "M" And Cursor < Len(inputline) Then     'Right
                Cursor += 1
            ElseIf inputchr = Chr(255) + "K" And Cursor > 0 Then                  'Left
                Cursor -= 1
            End If
            If inputchr = Chr(27) Then                                            'Esc
                Locate  , cursor0
                Print Space(Len(inputline) + 1);
                inputline = ""
                cursor = 0
            End If
            Locate  , cursor0
            Print Left(inputline, cursor) & "_" & Mid(inputline, cursor + 1) & " ";
        End If
        Sleep sleeptime, 1
    Loop Until inputchr = Chr(13)
    Locate  , cursor0
    Print inputline & " "
End Sub

Dim As String s = "FreeBASIC"
myLineInput("Enter a compiler name?", s)  '' or: myLineInput "Enter a compiler name?", s
Print "You entered: '" & s & "'"

Sleep
Also works in graphics mode.
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Windows Console - Extended Input Subroutine

Post by Lothar Schirm »

In graphics mode, I use Draw String ..., "_" to place the text cursor at the right position, in the same way as the Input function. Code:

Code: Select all

Sub TextCursor()
	'Im Grafik-Mode den Cursor setzen. Vorher muss mit View und Window der 
	'Grafikbildschirm in sein ursprüngliches Koordinatensystem zurückgesetzt sein!
  'Hilfsprozedur fuer Editierfunktionen.
	
	Dim As Integer w, h, CharWidth, CharHeight
	Dim As String driver, s
		
	ScreenInfo w, h,,,,,driver
	If driver <> "" Then 
		CharHeight = h \ Hiword(Width)
		CharWidth = w \ Loword(Width)
		Draw String ((Pos - 1) * CharWidth, (Csrlin - 1) * CharHeight), "_"
	End If
						
End Sub
dmontaine
Posts: 23
Joined: Mar 15, 2018 7:13

Re: Windows Console - Extended Input Subroutine

Post by dmontaine »

[2022 Aug 18] Here is an enhanced version of the extended input routine along with a test program.

Added are:
Several more key code captures including next word (CntlRightArrow) and previous word (CntlLeftArrow) capabilities.
Ctrl+Delete to clear the whole field
Insert key toggle to insert or overwrite text
The ability to pass more keys back to the calling program such as UpArrow, DownArrow, etc
The ability to pass the cursor position back to the calling program so that the routine can
be put in a loop structure and only certain exit codes processed (see example program).
Made all but the first four parameters optional.
Moved some functionality into functions

Note that this has been tested on the Windows 11 console (US English) with the consolas font.
Other configurations may require modification.

' Author: Donald S Montaine [ released under the Creative Commons CC-BY license]

Code: Select all

'Program: extInputExample
' This program is an example of how to use the
' Windows console extInput subroutine

Sub ExtPrint(ByVal StartY       as integer,  _
             ByVal StartX             as Integer,  _
             ByVal ForeColor        as Integer,  _
             ByVal BackColor        as Integer,  _
             ByVal PrintString       as string    _
            )
   locate StartY, StartX
   color ForeColor,BackColor
   print PrintString ;
end sub

Function WordJump(ByVal Direction   as string, _
                  ByVal CurrLoc     as integer, _
                  ByVal DispLen     as integer, _
                  ByVal TheString  as string _
                 ) as integer
   
   dim StringLength  as integer = len(TheString)  
   dim SpaceFound    as boolean    
   dim Ctr                 as integer   
   dim RetVal            as integer = CurrLoc
   dim WordStart      as integer  
   dim CurrChar        as string
   dim LastChar        as string
   Dim SpaceCnt       as integer
   Dim Spaces          as integer
   dim StartLoc        as integer
                 
   if Direction = "+" then
      if CurrLoc < StringLength then
         for Ctr = CurrLoc to StringLength
            CurrChar = mid(TheString,Ctr,1)
            if  CurrChar = " " then
               SpaceFound = True
            end if
            if SpaceFound = True and CurrChar <> " " then 
               RetVal = Ctr
               exit for
            end if 
            if Ctr = StringLength then 
               if Ctr < DispLen then
                  RetVal = StringLength + 1
               else
                  RetVal = StringLength
               end if 
            end if
         next Ctr          
      end if           
   elseif Direction = "-" then       
      if CurrLoc > 1 then  
         StartLoc = CurrLoc-1  
         for Ctr = StartLoc to 1 step -1
            CurrChar = mid(TheString,Ctr,1)
            LastChar = mid(TheString,Ctr+1,1)
            If Ctr = StartLoc then
               if CurrChar <> " " and LastChar <> " " then 
                  Spaces = 1
               else
                  if CurrChar = " " and LastChar = " " then
                     Spaces = 1
                  elseif CurrChar <> " " and LastChar = " " then
                     Spaces = 1
                  else
                     Spaces = 2
                  end if
               end if 
            end if
            if CurrChar = " " and LastChar <> " " then
               SpaceCnt += 1
               if SpaceCnt = Spaces then
                  RetVal = Ctr + 1
                  exit for
               end if
            end if
            if Ctr = 1 then RetVal = 1
         next Ctr
      else
         RetVal = CurrLoc      
      end if               
   end if
   Return RetVal 
end function

Function 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
                  ByRef EditString              as string,           _     ' The string being edited
                  ByVal ReturnForeColor     as integer = 15,  _     ' Color code of characters entered after entry accepted (default White)
                  ByVal ReturnBackColor     as integer = 0,    _     ' Color code of background after entry accepted (default Black)
                  ByVal EditForeColor         as integer = 0,    _     ' Color code of characters during entry (default Black)
                  ByVal EditBackColor         as integer = 15,  _     ' Color code of background during entry (default White)
                  ByRef CursorLoc              as integer = 0     _     ' The location of the cursor in the EditString
                 ) as integer         
   
   'Error Checks   
   dim ExitCode   as integer = 0                           ' Return Value (if negative, error code -- if Positive keyscan value)
   dim TermY      as integer = HiWord(Width())     ' The height of the console screen    
   dim TermX      as integer = LoWord(Width())     ' The width of the console screen 
 
   if StartY <= 0 or StartY > TermY then 
      ExitCode = -1                                           ' Invalid StartY Value
   elseif StartX <= 0 or StartX > TermX then
      ExitCode = -2                                           ' Invalid StartX Value
   elseif DispLen < 1 or DispLen > TermY then
      ExitCode = -3                                           ' Invalid Display Length Value
   elseif (StartY + DispLen)-1 > TermX then
      ExitCode = -4                                            ' Console width overflow
   elseif len(EditString) > DispLen then
      ExitCode = -5                                            ' Edit string length too long
   end if

   ' Navigation Key Codes
   dim CtrlLeftArrow     as integer = 29695       ' Ctrl Key + Left Arrow Key Code
   dim CtrlRightArrow   as integer = 29951       ' Ctrl Key + Right Arrow Key Code
   dim InsertKey           as integer = 21247       ' Insert Key Code
   dim TabKey              as integer = 9               ' Tab Key Code (possible return value)
   dim ShiftTabKey       as integer = 4095          ' Shift + Tab Key (possible return value)
   dim UpArrow            as integer = 18687        ' Up Arrow Key (possible return value)
   dim DownArrow        as integer = 20735        ' Down Arrow Key (possible return value)
   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 CtrlDel               as integer = 37887 
   'Other Variables 
   dim KeyVal           as integer                      ' The scan code for the last key pressed
   dim Overwrite        as boolean                   ' Insert characters in string or overwrite existing characters
      
   extPrint(StartY,StartX,EditForeColor,EditBackColor,EditString + space(DispLen-len(EditString)))  
   if CursorLoc = 0 then 
      if len(EditString) = DispLen then
         CursorLoc = len(EditString)                ' Set to last character of EditString
      else
         CursorLoc = len(EditString) + 1          ' Set to space after the end of the edit string
      end if
   end if
   locate StartY, StartX+CursorLoc-1                              

   if ExitCode >= 0 then 
      do
         KeyVal = getkey()
         select case KeyVal
            Case 32 to 126 
               'handle printable character
               if len(EditString) < DispLen then
                  if CursorLoc <= Len(EditString) then              
                     if OverWrite = 0 then
                        EditString = Left(EditString,CursorLoc-1) + chr(KeyVal) + Right(EditString,len(EditString)-(CursorLoc)+1)
                     else
                        EditString = Left(EditString,CursorLoc-1) + chr(KeyVal) + Mid(EditString,CursorLoc+1)
                     end if
                     ExtPrint( StartY,StartX,EditForeColor,EditBackColor, EditString + space(DispLen-len(EditString)) )
                     if CursorLoc < DispLen then CursorLoc += 1
                     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))
              ExtPrint(StartY,StartX,EditForeColor,EditBackColor, 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))
                 ExtPrint(StartY,StartX,EditForeColor,EditBackColor, EditString + space(DispLen-len(EditString)))
                 locate StartY, StartX+CursorLoc-1              
              end if  
           case InsertKey
              if Overwrite = False then Overwrite = True else Overwrite = False        
           case CtrlLeftArrow
              CursorLoc = WordJump("-",CursorLoc,DispLen,EditString)
              locate StartY, StartX+CursorLoc-1
           case CtrlRightArrow
              CursorLoc = WordJump("+",CursorLoc,DispLen,EditString)
              locate StartY, StartX+CursorLoc-1
           case CtrlDel
              EditString = ""
              CursorLoc = 1
              ExtPrint(StartY,StartX,EditForeColor,EditBackColor, EditString + space(DispLen-len(EditString)))
              Locate StartY,StartX
         end select
      loop until KeyVal = EscKey or KeyVal = EnterKey or KeyVal = UpArrow or KeyVal = DownArrow or KeyVal = TabKey or KeyVal = ShiftTabKey
      ExitCode = KeyVal
   end if

   ' reprint the field with the changed colors to indicate no longer in edit mode 
   ExtPrint(StartY,StartX,ReturnForeColor,ReturnBackColor, EditString + space(DispLen-len(EditString)))
   return ExitCode
end Function

'=======================================
' MAIN PROGRAM
'=======================================

' Set console size
width 80,24

' Colors Enumeration (0 - 15) ie Black = 1, Cyan = 4 etc
Enum
   _Black : _Blue : _Green : _Cyan : _Red : _Majenta : _Brown : _LightGrey : _DarkGrey 
   _BrightBlue : _BrightGreen : _BrightCyan : _BrightRed : _BrightMajenta : _Yellow : _White
end enum

' Other Variables
dim ExitCode   as integer                                         ' The keyboard code that caused entry field to exit
dim InData     as string                                            ' Variable used to paas original and receive changed data
dim OrigString as string = "Change  Me  Please"        ' Original content of field
dim CurLoc     as integer
cls                                                                          ' Clear the console screen

'this will display an input field at y=10 x=10 with a maximum input of 20 characters
'the input field will be Black lettering on a light grey field
'and after input the entered string will be displayed as yellow on black
'existing data can be passed in the InData variable and any changes will be
'returned in the same variable.  The exit code variable will return
'a negative value for error conditions
const _CR           as integer  = 13
const _Esc          as integer  = 27 
const _Tab          as integer  = 9
const _ShftTab    as integer  = 4095
const _UpArrow   as integer  = 18687
const _DnArrow   as integer  = 20735

InData = OrigString
CurLoc = 1
do
   ExitCode = extInput(10,10,20,InData,_Yellow,_Black,_Black,_LightGrey,CurLoc)
loop until ExitCode = _CR

'Short version of extInput with default values for colors and cursor location
'when not used in a loop
'ExitCode = extInput(10,10,20,InData)

extPrint(13,10,_Red,_Black,  "Original string: " + """" + OrigString + """")
extPrint(14,10,_Yellow,_Black,  "Returned string: " + """" + InData + """")
extPrint(15,10,_Green,_Black,  "Exit code:       " + str(ExitCode))
extPrint(17,10,_Red,_Black,     "Press any key to exit. ")

sleep
Last edited by dmontaine on Apr 23, 2023 7:40, edited 1 time in total.
jgrillout
Posts: 2
Joined: Dec 20, 2022 1:39

Re: Windows Console - Extended Input Subroutine

Post by jgrillout »

awesome works "as is" on ubuntu 22.04
Post Reply