Is there existing an inputroutine?
Re: Is there existing an inputroutine?
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.
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.
Re: Is there existing an inputroutine?
Am I right that you are a little bit lazy? Otherwise you would have read the two following posts, too.Jawade wrote:And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.
Re: Is there existing an inputroutine?
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.
Re: Is there existing an inputroutine?
Oops, posts crossed.jj2007 wrote:Am I right that you are a little bit lazy? Otherwise you would have read the two following posts, too.Jawade wrote:And https://freebasic.net/forum/viewtopic.p ... 48#p250621
does nothing.
Re: Is there existing an inputroutine?
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.
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
Re: Is there existing an inputroutine?
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.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
Re: Is there existing an inputroutine?
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.
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.
-
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: Is there existing an inputroutine?
Of course it does nothing by itself. It's a library.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.
See https://freebasic.net/forum/viewtopic.p ... 48#p250630 for a working example. And what exactly do you want to print?
-
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: Is there existing an inputroutine?
Added a password mode.
stringmod.bi: EDIT: Fixed "del" bug.
Example:
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
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.
Re: Is there existing an inputroutine?
@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:
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
Re: Is there existing an inputroutine?
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.
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.
Re: Is there existing an inputroutine?
Sounds like an encoding issue.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.
Re: Is there existing an inputroutine?
Thanks for testing Munair.
My code works OK on a graphics screen in Linux Red Hat, but not in the terminal or screen 0.
My code works OK on a graphics screen in Linux Red Hat, but not in the terminal or screen 0.
-
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: Is there existing an inputroutine?
Thank you, I accidentally deleted that line. Sorry! Fixed the bug in the posted code.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.
Re: Is there existing an inputroutine?
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