Is there existing an inputroutine?

Jawade · Post by **Jawade** » Nov 25, 2018 17:44

Thanks to all. But a routine with Backspace did I have made by myself.

And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.

My ideal wish is a routine who can handle Backspace, left and right Arrow,
Insert and Delete. And using my printoutine. I'm busy with one, but
it's hard to do.

jj2007 · Post by **jj2007** » Nov 25, 2018 18:24

Jawade wrote:And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.

Am I right that you are a little bit lazy? Otherwise you would have read the two following posts, too.

Munair · Post by **Munair** » Nov 25, 2018 18:37

Here is a set of routines from my old QuickBASIC days. This code does NOT compile because some things are missing. But it might serve as a skeleton, especially the DoText procedure shows you how to catch keyboard codes and what to do with them. You might also want to write your own text modification procedure. Mine (Modify) may be a bit over the top for what you want. Keep in mind that in QuickBASIC passing parameters to procedures was BYREF by default.

Code: Select all

FUNCTION TcRight$ (expr AS STRING, limit AS INTEGER, spacefill AS INTEGER)

' Right-truncates string expr$ at limit. If expr is smaller than
' limit and spacefill is non-zero, expr is padded with spaces.

DIM length AS INTEGER
DIM result AS STRING

   length = LEN(expr)
   IF length > limit THEN
      result = LEFT$(expr, limit)
   ELSEIF spacefill = True AND length < limit THEN
      result = expr + SPACE$(limit - length)
   ELSE
      result = expr
   END IF
   TcRight = result

END FUNCTION

SUB Modify (expr1 AS STRING, expr2 AS STRING, length AS INTEGER, position AS INTEGER)

' Modifies a string.
'
' expr1     - string to be modified
' expr2     - string to be inserted
' length    - number of characters in source$ to be replaced
' position  - position in source$ from where to insert/replace
'
' If length = 0 expr2 is inserted, otherwise the number of characters
' specified by length are replaced by expr2.

DIM leftpos AS INTEGER
DIM leftpart AS STRING
DIM rightpos AS INTEGER
DIM rightpart AS STRING

   leftpos = position - 1                    'left from position
   rightpos = position + length              'right from position
   leftpart = TcRight$(expr1, leftpos, -1)   'left string part (fills spaces)
   rightpart = MID$(expr1, rightpos)         'right string part
   expr1 = leftpart + expr2 + rightpart      'modified string

END SUB


SUB DoText (TText AS TextType, text AS STRING, TKeyb AS KeyboardType)

'Single line text editor.

DIM TCursor AS CursorType
DIM ssline AS INTEGER ' start scan line

   SaveCursor TCursor

   IF TText.insert = False THEN
      ssline = 6
   END IF

   TText.selected = True
   TText.seleft = 1
   TText.seright = LEN(text)
   TText.index = TText.seright + 1

   LOCATE , , 0

   DO
      ShowText TText, text
      LOCATE , , 1, ssline, 7
      GetKey TKeyb
      LOCATE , , 0
      IF TKeyb.ascii THEN
         SELECT CASE TKeyb.shift
         CASE 0 TO 3, 8 ' include shift and alt
            SELECT CASE TKeyb.ascii
            CASE 8 'backspace
               IF TText.index > 1 THEN
                  TText.index = TText.index - 1
                  Modify text, "", 1, TText.index
               END IF
               TText.selected = False
            CASE 9, 13, 27
               EXIT DO
            CASE IS > 31
               IF TText.fucase = True THEN
                  TKeyb.achar = UCASE$(TKeyb.achar)
               ELSEIF TText.flcase = True THEN
                  TKeyb.achar = LCASE$(TKeyb.achar)
               END IF
               IF TText.selected = True THEN
                  Modify text, TKeyb.achar, TText.sewidth, TText.seleft
                  TText.index = TText.seleft + 1
                  TText.selected = False
               ELSEIF TText.indices < TText.limit OR TText.index <= TText.limit AND TText.insert = 1 THEN
                  Modify text, TKeyb.achar, TText.insert, TText.index
                  TText.index = TText.index + 1
                  IF TText.index > TText.limit THEN
                     IF TText.autotab = True THEN
                        TKeyb.alcase = 0
                        EXIT DO
                     END IF
                  END IF
               END IF
            END SELECT
         CASE 4 ' Ctrl
            IF TKeyb.ascii = 3 THEN 'Ctrl+C=Copy
               GOSUB DoTextCopy
            ELSEIF TKeyb.ascii = 22 THEN 'Ctrl+V=Paste
               GOSUB DoTextPaste
            END IF
         END SELECT
      ELSE
         SELECT CASE TKeyb.shift
         CASE 0 'no shift code
            SELECT CASE TKeyb.scan
            CASE 71 'home
               TText.index = 1
            CASE 72, 75 'left
               TText.index = TText.index - 1
            CASE 77, 80 'right
               TText.index = TText.index + 1
            CASE 79 'end
               TText.index = TText.indices + 1
            CASE 82 'insert
               TText.insert = TText.insert XOR 1
               ssline% = -((ssline% XOR 1) - 7)
            CASE 83 'delete
               IF TText.selected = True THEN
                  Modify text, "", TText.sewidth, TText.seleft
                  TText.index = TText.seleft
               ELSEIF TText.index <= TText.indices THEN
                  Modify text, "", 1, TText.index
               END IF
            CASE ELSE 'possible function key
               EXIT DO
            END SELECT
            TText.selected = False
         CASE 1, 2, 3 'shift
            SELECT CASE TKeyb.scan
            CASE 71 'shift+home
               IF TText.selected = False THEN
                  TText.seright = TText.index - 1
               ELSEIF TText.seleft < TText.index THEN
                  TText.seright = TText.seleft - 1
               END IF
               TText.index = 1
               TText.seleft = TText.index
               TText.selected = True
            CASE 72, 75 'shift+left
               IF TText.selected = False THEN
                  TText.seleft = TText.index - 1
                  TText.seright = TText.index - 1
               ELSEIF TText.seleft = TText.index THEN
                  TText.seleft = TText.seleft - 1
               ELSE
                  TText.seright = TText.seright - 1
               END IF
               TText.index = TText.index - 1
               TText.selected = True
            CASE 77, 80 'shift+right
               IF TText.selected = False THEN
                  TText.seleft = TText.index
                  TText.seright = TText.index
               ELSEIF TText.seright < TText.index THEN
                  TText.seright = TText.seright + 1
               ELSE
                  TText.seleft = TText.seleft + 1
               END IF
               TText.index = TText.index + 1
               TText.selected = True
            CASE 79 'shift+end
               IF TText.selected = False THEN
                  TText.seleft = TText.index
               ELSEIF TText.seleft = TText.index THEN
                  TText.seleft = TText.seright + 1
               END IF
               TText.seright = TText.indices
               TText.index = TText.indices + 1
               TText.selected = True
            CASE 82 'shift+insert=Paste
               GOSUB DoTextPaste
            CASE ELSE 'possible function key
               EXIT DO
            END SELECT
         CASE 4 'ctrl
            IF TKeyb.scan = 146 THEN 'ctrl+insert=copy
               GOSUB DoTextCopy
            END IF
         CASE 8 'alt
            EXIT DO
         END SELECT
      END IF
   LOOP

   TText.selected = False
   TText.index = TText.indices + 1
   ShowText TText, text
   LoadCursor TCursor
   EXIT SUB

DoTextCopy:
   IF TText.selected = True THEN
      Interface.Clipboard = MID$(text, TText.seleft, TText.sewidth)
   END IF
   RETURN

DoTextPaste:
   IF LEN(Interface.Clipboard) + TText.indices <= TText.limit THEN
      Modify text, Interface.Clipboard, 0, TText.index
   END IF
   TText.selected = False
   RETURN

END SUB

Munair · Post by **Munair** » Nov 25, 2018 18:38

jj2007 wrote:
Jawade wrote:And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.
Am I right that you are a little bit lazy? Otherwise you would have read the two following posts, too.

Oops, posts crossed.

Jawade · Post by **Jawade** » Nov 25, 2018 19:53

Here is mine, it has only Backspace but everything is printable. What I want
is also the use of Arrow left/right, Insert and Delete. But I know it's not
simply. The best way I think is the use of a buffer.

Code: Select all

Dim Shared star As Integer
Dim Shared i_ak As Integer
Dim Shared i_ix As Integer
Dim Shared i_iy As Integer
Dim Shared i_le As Integer
Dim Shared i_vk As Integer
Dim Shared i_xx As Integer
Dim Shared i_yy As Integer
Dim Shared i_aa As String
Dim Shared i_bb As String


Declare Sub Inpot()


putin:
    Cls: Locate , , 0
    Locate 2, 2: Print " User name:"
    i_ak = -1: i_vk = 0: i_yy = 4: i_xx = 3: i_le = 58
    star = 0: Inpot()
?:?"  ";i_bb
    Locate 6, 2: Print " Password:"
    i_ak = -1: i_vk = 0: i_yy = 8: i_xx = 3: i_le = 12
    star = 1: Inpot()
?:?"  ";i_bb
    Locate , , 1
System


Sub Inpot()
    i_bb = String$(i_le + 1, " "): i_ix = 1
    Do
        Locate i_yy, i_xx: Color i_ak, i_vk: Print " ";
        Do: i_aa = InKey$: Sleep 3: Loop Until i_aa <> ""
        If Len(i_aa) = 2 Then If Mid$(i_aa, 2) = "k" Then System
        If Len(i_aa) = 1 Then
            If Asc(i_aa) = 8 Then
                Mid$(i_bb, i_ix - 1, 1) = " "
                If i_ix > 1 Then
                    Locate i_yy, i_xx: Color i_vk, i_ak
                    Print " ";
                    i_ix = i_ix - 1: i_xx = i_xx - 1
                End If
            End If
            If Asc(i_aa) > 31 Then
                If i_ix < i_le + 1 Then
                    Mid$(i_bb, i_ix, 1) = i_aa
                    Locate i_yy, i_xx: Color i_vk, i_ak
                    If star Then Print "*"; Else Print i_aa;
                    i_ix = i_ix + 1: i_xx = i_xx + 1
                End If
            End If
        End If
    Loop Until i_aa = Chr$(13) Or i_aa = Chr$(27)
    Locate i_yy, i_xx: Color i_vk, i_ak: Print " ";
    Do
      i_bb = Left$(i_bb, Len(i_bb) - 1)
    Loop Until Right$(i_bb, 1) <> " "
End Sub

Munair · Post by **Munair** » Nov 25, 2018 20:59

Jawade wrote:Here is mine, it has only Backspace but everything is printable. What I want
is also the use of Arrow left/right, Insert and Delete. But I know it's not
simply. The best way I think is the use of a buffer.

Code: Select all

Dim Shared star As Integer
Dim Shared i_ak As Integer
Dim Shared i_ix As Integer
Dim Shared i_iy As Integer
Dim Shared i_le As Integer
Dim Shared i_vk As Integer
Dim Shared i_xx As Integer
Dim Shared i_yy As Integer
Dim Shared i_aa As String
Dim Shared i_bb As String


Declare Sub Inpot()


putin:
    Cls: Locate , , 0
    Locate 2, 2: Print " User name:"
    i_ak = -1: i_vk = 0: i_yy = 4: i_xx = 3: i_le = 58
    star = 0: Inpot()
?:?"  ";i_bb
    Locate 6, 2: Print " Password:"
    i_ak = -1: i_vk = 0: i_yy = 8: i_xx = 3: i_le = 12
    star = 1: Inpot()
?:?"  ";i_bb
    Locate , , 1
System


Sub Inpot()
    i_bb = String$(i_le + 1, " "): i_ix = 1
    Do
        Locate i_yy, i_xx: Color i_ak, i_vk: Print " ";
        Do: i_aa = InKey$: Sleep 3: Loop Until i_aa <> ""
        If Len(i_aa) = 2 Then If Mid$(i_aa, 2) = "k" Then System
        If Len(i_aa) = 1 Then
            If Asc(i_aa) = 8 Then
                Mid$(i_bb, i_ix - 1, 1) = " "
                If i_ix > 1 Then
                    Locate i_yy, i_xx: Color i_vk, i_ak
                    Print " ";
                    i_ix = i_ix - 1: i_xx = i_xx - 1
                End If
            End If
            If Asc(i_aa) > 31 Then
                If i_ix < i_le + 1 Then
                    Mid$(i_bb, i_ix, 1) = i_aa
                    Locate i_yy, i_xx: Color i_vk, i_ak
                    If star Then Print "*"; Else Print i_aa;
                    i_ix = i_ix + 1: i_xx = i_xx + 1
                End If
            End If
        End If
    Loop Until i_aa = Chr$(13) Or i_aa = Chr$(27)
    Locate i_yy, i_xx: Color i_vk, i_ak: Print " ";
    Do
      i_bb = Left$(i_bb, Len(i_bb) - 1)
    Loop Until Right$(i_bb, 1) <> " "
End Sub

I think there are several great examples given to you of how to accomplish what you want, including the backspace and arrow keys. My example even shows how text selection works with shift keys and upon entry. Carefully look at those examples. They are very useful.

dodicat · Post by **dodicat** » Nov 25, 2018 22:54

backspace,esc,right and left arrows.

edit: hid the password,used a better cursor, chr(223), which might or might not be a filled block, depending on the codepage I suppose.

Code: Select all

 

Sub _input(st As String,message As String,byref fin as long=0,hide as long=0)
    #macro split(stri)
    If p<>0 Then
        Var e=Len(j)-p
        var1=Mid(stri,1,e)
        var2=Mid(stri,e+1)
    Else
        var1=stri
    End If
    #endmacro
    #define condition Right(i,1)<>"M" And Right(i,1)<>"K"
    Dim As String i=""
    Static As Long k=1
    Static As String j,blink
    Static As Double t
    Static As Long p
    Static As String var1,var2,copy
    while len(i)<>0:wend  
    i=Inkey
    If p=0 Then
        If Left(i,1)=Chr(08) Then j=Mid(j,1,Len(j)-1)
    Else
        If Left(i,1)=Chr(08) Then var1=Mid(var1,1,Len(var1)-1)
    End If
    
    If p=0 Then  
        If Left(i,1)<>Chr(08) And condition Then j=j+Left(i,1)
    End If
    If i= Chr(255) + "M"  Then j+=" "
    If i= Chr(255) + "K"  Then: p+=1:split(j):End If
    if p>len(j) then p=len(j)
    split(j)
    If p  And condition Then j=var1+Left(i,1)+var2
    
    If Timer-t>.5 Then
        t=Timer
        k=-k
        If k=1 Then blink=" " Else blink=Chr(223)
    End If
    
    If Left(i,1)=Chr(27) Then j=""
    If i<>Chr(13) Then
        if hide =0 then
        Print st & j;
        Locate Csrlin+1,Pos-p
        Print blink
        copy=j
    else
       Print st & string(len(j),"*");
        Locate Csrlin+1,Pos-p
        Print blink
        copy=j 
        end if
    Else
        copy=Rtrim(copy,Chr(13))
        message=copy
        j=""
        p=0
        var1=""
        var2=""
        copy=""
        fin=0
    End If
    
End Sub


sub userloop(flag as long,s as string)
dim as long fin=1,c=csrlin,p=pos
Do
cls
    Locate c,p,0
    if flag=1 then _input("Enter username   ",s,fin)
    if flag=2 then _input("Enter password   ",s,fin,1)
    Sleep 20,1
Loop Until fin=0
end sub

dim as string username,password

locate 5,,0
userloop(1,username)

userloop(2,password)

print "Username ";username
print "Password  ";password

sleep

grindstone · Post by **grindstone** » Nov 26, 2018 0:30

Jawade wrote:Thanks to all. But a routine with Backspace did I have made by myself.

And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.

My ideal wish is a routine who can handle Backspace, left and right Arrow,
Insert and Delete. And using my printoutine. I'm busy with one, but
it's hard to do.

Of course it does nothing by itself. It's a library.

See https://freebasic.net/forum/viewtopic.p ... 48#p250630 for a working example. And what exactly do you want to print?

grindstone · Post by **grindstone** » Nov 26, 2018 1:12

Added a password mode.

stringmod.bi:

Code: Select all

Type tJoyBack
	up_ As String
	right_ As String
	down_ As String
	left_ As String
End Type
Dim Shared tJoyBackZero As tJoyBack

Declare Operator = (jr1 As tJoyBack, jr2 As tJoyBack) As Integer
Operator = (r1 As tJoyBack, r2 As tJoyBack) As Integer
	If r1.up_ <> r2.up_ Then Return 0
	If r1.right_ <> r2.right_ Then Return 0
	If r1.down_ <> r2.down_ Then Return 0
	If r1.left_ <> r2.left_ Then Return 0
	Return -1
End Operator

Operator <> (r1 As tJoyBack, r2 As tJoyBack) As Integer
	If r1.up_ <> r2.up_ Then Return -1
	If r1.right_ <> r2.right_ Then Return -1
	If r1.down_ <> r2.down_ Then Return -1
	If r1.left_ <> r2.left_ Then Return -1
	Return 0
End Operator

Type tMouseBack
	left_ As String
	middle_ As String
	right_ As String
	forward_ As String
	back_ As string
End Type
Dim Shared tMouseBackZero As tMouseBack	

Operator = (r1 As tMouseBack, r2 As tMouseBack) As Integer
	If r1.left_ <> r2.left_ Then Return 0
	If r1.middle_ <> r2.middle_ Then Return 0
	If r1.right_ <> r2.right_ Then Return 0
	If r1.forward_ <> r2.forward_ Then Return 0
	If r1.back_ <> r2.back_ Then Return 0
	Return -1
End Operator

Operator <> (r1 As tMouseBack, r2 As tMouseBack) As Integer
	If r1.left_ <> r2.left_ Then Return -1
	If r1.middle_ <> r2.middle_ Then Return -1
	If r1.right_ <> r2.right_ Then Return -1
	If r1.forward_ <> r2.forward_ Then Return -1
	If r1.back_ <> r2.back_ Then Return -1
	Return 0
End Operator

Declare Function stringmod(text As String = "", mode As Integer = 0, _
                           mouseback As tMouseBack = tMouseBackZero, _
                           joyback As tJoyBack = tJoyBackZero, _
                           callback As Any Ptr = 0) As String
Declare Function joysubst OverLoad () As Integer
Declare Function joysubst (top_ As String, right_ As String, _
                           left_ As String, bottom_ As String) As String
Declare Function joysubst (joyback As tJoyBack) As String
Declare Function mousesubst OverLoad (left_ As String = "", middle_ As String = "", _
                                     right_ As String = "", forward_ As String = "", _
                                     back_ As String = "" ) As String
Declare Function mousesubst(mouseback As tMouseBack) As String

Function stringmod(text As String = "", mode As Integer = 0, _
                           mouseback As tMouseBack = tMouseBackZero, _
                           joyback As tJoyBack = tJoyBackZero, _
                           callback As Any Ptr = 0) As String
'the submission of 'mode' is optional, default is 0
'mode0 --> normal function
'mode1 --> returns after 'arrow up', 'arrow down', 'screen up' and 'screen down'
'mode2 --> treats joystick movements like arrow keys (up, down, right, left)
'mode4 --> only sets the variable 'lasttext' and returns
'mode8 --> adds a Chr(27) at the beginning of the retrun string if 'esc' key is pressed 
'mode16 --> password mode. prints asterisks instead of the characters of the text

'if  'mouseback' is submitted as a 6-character string (each 2 characters for left/mid/right),
' mouseklicks are treated like keystrokes.

'if a pointer to a callback routine is submitted, the input loop is redirected to this 
' routine, which can optional return a string that is treated like a keyboard input afterwards.
    
  Dim As Integer ze, sp, co, gi, lock_, ms, mz, wheel, buttons, length
  Dim As Single joyx, joyy
  Dim As String g, remember, txt
  Dim plugin As Sub (address As Any Ptr, length As Any Ptr)
    
  Static As String lasttext, g_back
  Static As Integer mousewheel
     
  If (mode And 4) Then
  	lasttext = text + " "
  	Return text
  EndIf
  
  If lasttext = "" Then
  	lasttext = " "
  EndIf
  
  txt = text + " "
  remember = txt
  co = Pos 'cursor offset
  ze = CsrLin
  sp = Len(txt) 'pointer to the character under the cursor
  lock_ = 0
      
  Locate ze, co, 1
 	Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
  Locate ze, sp+co-1, 1
  
  
  Do
    'input
    plugin = callback 'set pointer to the plugin
    If (callback <> 0) And (g_back = "") Then 'call plugin
    	g_back = String(200,Chr(0)) 'allocate memory for the return string
    	length = Len(g_back) 'max length of the return string
    	plugin(StrPtr(g_back),@length) 'call plugin
      g_back = Left(g_back,length) 'write return string to buffer
    EndIf
    
    If (mouseback <> tMouseBackZero) Then
  		g_back += mousesubst(mouseback)
    EndIf
		     
  	If (joyback <> tJoyBackZero) Then 'treats joystick like keys
	    g_back += joysubst(joyback)
  	EndIf
           
    If g_back = "" Then
    	g = InKey
    Else 'process return string
    	If Left(g_back,1) = Chr(255) Then 'control character
    		g = Left(g_back,2) 'imitated keystroke
    		g_back = Mid(g_back,3) 'shorten return string
    	Else 'normal character
    		g = Left(g_back,1) 'imitated keystroke
    		g_back = Mid(g_back,2) 'shorten return string
    	EndIf
    EndIf
        
    If Len(g) = 1 Then 'normal character
    	If g[0] > 31 Then 'character
        txt = Left(txt, sp - 1) + g + Mid(txt, sp)
        sp += 1
        Locate ze, co, 0
        Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
        Locate ze, sp+co-1, 1
    	Else 'control character
        Select Case g[0] 
        	Case 8 ' back key
            If sp > 1 Then
              txt = Left(txt, sp - 2) + Mid(txt, sp)
              sp -= 1
              Locate ze, co, 0
              Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
              Locate ze, sp+co-1, 1
            End If
        	Case 27 'esc
            If (mode And 8) Then
            	txt = Chr$(27) + txt
            Else
            	txt = remember 'old string
            EndIf
            g = Chr$(13) 'terminate
        End Select
      End If
    ElseIf Len(g) = 2 Then 'control character
    	gi = g[1] 
      Select Case gi 'control character
      	Case 75 'left arrow -> cursor left
          If sp > 1 Then
            sp -= 1
            Locate ze, sp+co-1, 1
          End If
      	Case 77 'right arrow -> cursor right
          If sp < Len(txt) Then
            sp += 1
            Locate ze, sp+co-1, 1
          ElseIf txt = " " Then 'set old string
          	txt = lasttext
          	sp = Len(txt)
          	Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
          	Locate ze, sp+co-1, 1
          End If
      	Case 14 'back -> delete character left of cursor
          If sp > 1 Then
            txt = Left(txt, sp - 1) + Mid$(txt, sp)
            sp -= 1
            Locate ze, co, 0
            Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
            Locate ze, sp+co-1, 1
          End If
      	Case 83 'del -> delete character right of cursor
          If sp < Len(txt) Then
            txt = Left(txt, sp - 1) + Mid$(txt, sp + 1)
            Locate ze, co, 0
            Print IIf(mode And 16, String(Len(txt) - 1, "*") + " ", txt);
            Locate ze, sp+co-1, 1
          End If
      	Case 71 'pos1 -> set cursor to the beginning of the string
          sp = 1
          Locate ze, sp+co-1, 1
      	Case 79 'end -> set cursor to the end of the string
          sp = Len(txt)
          Locate ze, sp+co-1, 1
      	Case Else
      		If (mode And 1) Then
            txt = g + Chr$(ze) + Chr$(co) + txt 'return control character and cursor position
            g = Chr$(13)
          EndIf
      End Select
    Else 'no key
    	Sleep 1
    End If
  Loop Until g = Chr$(13) 'return
		
  lasttext = txt
  Return Left(txt, Len(txt) - 1)
  Locate ze, sp+co-1, 0 'cursor off
             
End Function

Function joysubst () As Integer
	
	Dim As Single joyx, joyy
	Dim As Integer buttons, output_
	Static As Integer lock_ = 0
	Static As Double locktime
	
	output_ = 0 'default value no key pressed
		
	If GetJoystick (0, buttons, joyx, joyy) Then
		'no joystick connected
	Else
		If joyx < -.5 Then 'left
		  output_ = 4
		ElseIf joyx > .5 Then 'right
			output_ = 2
		EndIf
		If joyy < -.5 Then 'top
			output_ = 1
		ElseIf joyy > .5 Then 'bottom
			output_ = 3
		EndIf
	EndIf
	
	If output_ = 0 Then 'no key pressed, set delay to 0
		lock_ = 0
	EndIf

	Select Case lock_ 'delay mode
		Case 0 'immediate execution 
			If output_ Then 'key pressed
				lock_ = 1 'delay mode
			  locktime = Timer + 0.3 'delay for 1st keystroke
			EndIf
		Case 1 'key is held down
			If Timer > locktime Then 'check if delay time is over
				lock_ = 2 'repeat mode
				locktime = Timer + 0.07 'delay value for repetition mode
			Else 'delay time not over
				output_ = 0
			EndIf
		Case 2 'delay mode
			If Timer > locktime Then 'check if delay time is over
				locktime = Timer + 0.07 'set time for the next delay loop
			Else 'delay time not over
				output_ = 0
			EndIf
	End Select
	
	Return output_
  
End Function

Function joysubst (up_ As String, right_ As String, _
                   down_ As String, left_ As String) As String
			
	Select Case joysubst()
		Case 0 'no key
			Return ""
		Case 1 'up
			Return up_
		Case 2 'right
			Return right_
		Case 3 'down
			Return down_
		Case 4 'left
			Return left_
	End Select
	
End Function

Function joysubst (joyback As tJoyBack) As String
			
	Select Case joysubst()
		Case 0 'no key
			Return ""
		Case 1 'top
			Return joyback.up_
		Case 2 'right
			Return joyback.right_
		Case 3 'bottom
			Return joyback.down_
		Case 4 'left
			Return joyback.left_
	End Select
	
End Function

Function mousesubst(mouseback As tMouseBack) As String
	Return mousesubst(mouseback.left_, mouseback.middle_, mouseback.right_, _
	                 mouseback.forward_, mouseback.back_)
End Function

Function mousesubst (left_ As String = "", middle_ As String = "", _
                    right_ As String = "", forward_ As String = "", _
                    back_ As String = "") As String
	Dim As Integer ms, mz, wheel, buttons
	Static As Integer mousewheel
	
	GetMouse (ms,mz,wheel,buttons)
	If (buttons And 1) Then 'left mouse button
		Function = left_
	ElseIf (buttons And 4) Then 'mid mouse button
		Function = middle_
	ElseIf (buttons And 2) Then 'right mouse button
		Function = right_
	EndIf
		    	
	If wheel < mousewheel Then
		Function = back_ 'mouse wheel back
		mousewheel = wheel
	ElseIf wheel > mousewheel Then
		Function = forward_ 'mouse wheel forward
		mousewheel = wheel
	EndIf
	
	Do 'wait for mouse button release
		GetMouse (ms,mz,wheel,buttons)
		Sleep 1
	Loop While buttons

End Function

EDIT: Fixed "del" bug.

Example:

Code: Select all

#Include "stringmod.bi"

Dim As String pw

Print "Password: ";
pw = stringmod(pw, 16)
Print
Print pw
Sleep

sancho3 · Post by **sancho3** » Nov 27, 2018 6:34

@dodicat
Your routine does not work with ubuntu. There is no cursor and left and right don't seem to do anything (its hard to tell because there is no cursor)

@grindstone
Works great except for the delete key. To replicate the problem type abcdefg, left key to 'd' and press delete. The 'd' is replaced by 'abc'.
Adding 'Locate ze, co, 0' on line 198 after the text is rebuilt, fixes the problem. That is the same line used in the backspace code.

@jawade
To use grindstones function in its simplest form:

Code: Select all

stringmod()
Sleep

dodicat · Post by **dodicat** » Nov 27, 2018 10:35

sancho3.
Regarding my code.
I tested with Red Hat Linux, it doesn't work.
Chr 223 doesn't show at all.
I cannot get the right/left arrow keys to respond.
I note that chrs 0 to 255 are completely different to windows 10, most of the Linux chars don't show or are blobs.
So, it is windows only code.
Thanks for testing.

Munair · Post by **Munair** » Nov 27, 2018 11:35

dodicat wrote:sancho3.
Regarding my code.
I tested with Red Hat Linux, it doesn't work.
Chr 223 doesn't show at all.
I cannot get the right/left arrow keys to respond.
I note that chrs 0 to 255 are completely different to windows 10, most of the Linux chars don't show or are blobs.
So, it is windows only code.
Thanks for testing.

Sounds like an encoding issue.

dodicat · Post by **dodicat** » Nov 27, 2018 13:46

Thanks for testing Munair.
My code works OK on a graphics screen in Linux Red Hat, but not in the terminal or screen 0.

grindstone · Post by **grindstone** » Nov 27, 2018 21:26

sancho3 wrote:@grindstone
Works great except for the delete key. To replicate the problem type abcdefg, left key to 'd' and press delete. The 'd' is replaced by 'abc'.
Adding 'Locate ze, co, 0' on line 198 after the text is rebuilt, fixes the problem. That is the same line used in the backspace code.

Thank you, I accidentally deleted that line. Sorry! Fixed the bug in the posted code.

Jawade · Post by **Jawade** » Dec 29, 2018 1:01

I have made a new one. Works good in textmode.

Code: Select all

' Graphical mode is without cursor.


Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer)


Main:
'www    ScreenRes 640, 480, 32: Width 80, 30: Color 0, -1
    Cls
    Locate 5, 6: Print "Name: ";
    xText(12, 5, nn, 0)
    Locate 7, 2: Print "Password: ";
    xText(12, 7, pp, 1)
    Locate 14, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
        Do: aa = InKey$: Sleep 3: Loop Until aa <> ""
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i < Len(bb) + 1 Then
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If i < Len(bb) + 1 Then
                    Mid$(bb, i, 1) = aa
                Else
                    bb = bb + aa: i = i + 1
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 82) Then
                bb = Left$(bb, i - 1) + " " + Mid$(bb, i + 0)
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            Locate y, x: Print String$(Len(bb), "*"); " ";
            Locate , i + a
        Else
            Locate y, x: Print bb; " ";: Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub

Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?

Re: Is there existing an inputroutine?