Is there existing an inputroutine?

General FreeBASIC programming questions.
Jawade
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 1259
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Is there existing an inputroutine?

Postby jj2007 » Nov 25, 2018 18:24

Am I right that you are a little bit lazy? Otherwise you would have read the two following posts, too.
Munair
Posts: 836
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

Re: Is there existing an inputroutine?

Postby 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
Last edited by Munair on Nov 25, 2018 18:41, edited 1 time in total.
Munair
Posts: 836
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

Re: Is there existing an inputroutine?

Postby Munair » Nov 25, 2018 18:38

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

Oops, posts crossed.
Jawade
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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
Posts: 836
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 5983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Is there existing an inputroutine?

Postby 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


 
Last edited by dodicat on Nov 26, 2018 14:04, edited 2 times in total.
grindstone
Posts: 656
Joined: May 05, 2015 5:35
Location: Germany

Re: Is there existing an inputroutine?

Postby 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.php?t=26948#p250630 for a working example. And what exactly do you want to print?
grindstone
Posts: 656
Joined: May 05, 2015 5:35
Location: Germany

Re: Is there existing an inputroutine?

Postby 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
Last edited by grindstone on Nov 27, 2018 21:19, edited 1 time in total.
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Is there existing an inputroutine?

Postby 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
Posts: 5983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Is there existing an inputroutine?

Postby 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
Posts: 836
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

Re: Is there existing an inputroutine?

Postby 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
Posts: 5983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Is there existing an inputroutine?

Postby 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
Posts: 656
Joined: May 05, 2015 5:35
Location: Germany

Re: Is there existing an inputroutine?

Postby 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
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Is there existing an inputroutine?

Postby 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

Return to “General”

Who is online

Users browsing this forum: albert, mrToad, MSN [Bot] and 1 guest