Extended Custom Input

[empty]

This is loosely based on Kevin's Custom Input snippet.

It uses a mixture of the Inkey$()  and ScanCode() functions with the advantage, that it should work on international keyboard layouts as well- at least I do hope so... :)
I don't know how well it works on slower computers, though (might have some troubles).

Additionally it supports left & right arrow keys, the Home and the End key.

PlayBASIC Code: [Select]

Setfps 60


; Call the custom input routine with a init flag of 0

LoadFont "Ariel",2,24,0
SetFont 2
 
CustomInputEx(200,200,0)


Repeat
     Cls 0

 Mytext$,Status=CustomInputEx(200,200,1)

; Display the Screen and wait for the user to press a key
     Sync
 Until Status=True
 
SetCursorY 250

 Print "Input Complete - Here is your text"
 Print MyText$

 Sync
 WaitNoKey
 WaitKey
 END
 
 
Function CustomInputEx(Xpos, Ypos, Flag)
   Static CursorDraw,CursorTimer,CursorPos,MyText$

   If Flag=0
       MyText$=""
       CursorPos=0
       CursorTimer=0
       KeyDownTimer=0
       CursorDraw = 0
   EndIf
 
   If CursorTimer<Timer()
      CursorTimer=Timer()+300
      CursorDraw = CursorDraw Xor 1
   EndIf

   Local Char$ = Inkey$()
   Local SCode = ScanCode()
   Scode = SCode And 255
   If Asc(CHar$) = -1 Then Goto abort
   
   Local ASCII = Asc(Char$)
   
   Select SCode
  Case 203
     Dec CursorPos
     If CursorPos < 0 Then CursorPos = 0
  Case 205
     Inc CursorPos
     If CursorPos > Len(MyText$) Then CursorPos = Len(MyText$)   
  Case 14
     If CursorPos > 0
    Dec CursorPos
    LeftPart$ = CutRight$(Mytext$,CursorPos+1)
    RightPart$ = CutLeft$(MyText$,CursorPos+1)
    MyText$ = LeftPart$ + RightPart$
     EndIf    
  Case 211
     LeftPart$ = CutRight$(MyText$, CursorPos+1)
     RightPart$ = CutLeft$(MyText$, CursorPos+1)
     MyText$ = LeftPart$ + RightPart$
  Case 207
     CursorPos = Len(MyText$)
  Case 199
     CursorPos = 0
  Default 
     If ASCII >= 32 And SCode < 155 And Scode > 0
    Inc CursorPos
    MyText$ = Insert$(MyText$, Char$, CursorPos-1)
     EndIf 
     If ASCII = 13 Then Status = 1
   EndSelect

   CursorTimer=Timer()+300
   CursorDraw = 1

   
Abort:

   TextOffset = GetTextWidth(CutRight$(MyText$, CursorPos+1)) 
   TextHeight = GetTextHeight("Y")
   
   Text Xpos,Ypos,Mytext$
   If CursorDraw = 1 Then Line XPos + TextOffset, Ypos, XPos + TextOffset, Ypos + TextHeight
EndFunction MyText$, Status

[tomazmb]

Hello empty,

I'm using an international keyboard with our slavic characters. It's OK, all is working well and I have no speed problems (but I don't have a slow computer  :) ). Thank you for input.

Have a nice day,

Tomaz

[empty]

Update
Now supports selecting text (hold down shift key and use arrow keys or home/end key). There's still a lot of room to optimise the code, but it works. :)

PlayBASIC Code: [Select]

; PROJECT : ExInput
; AUTHOR  : Twarloh
; CREATED : 10.10.2005
; EDITED  : 10.10.2005
; ---------------------------------------------------------------------


Global _ExInputSelColor = RGB(0, 0, 255)
Global _ExInputSelTextColor = RGB(255,255,255)


Ink RGB(255,255,255)
LoadFont "Arial",2,24,0
SetFont 2

InputEx(200,200,1)


Repeat
  Ink 0   
    Cls RGB(255, 255, 255)
    Text 0,0," "

   Mytext$,Status=InputEx(200,200,0)
   
   

; Display the Screen and wait for the user to press a key
    Sync
Until Status=True

SetCursorY 250

Print "Input Complete - Here is your text"
Print MyText$





Psub _InputEx_Delete(Text$, RightCut, LeftCut)
   Local LeftPart$ = CutRight$(Text$, RightCut)
   Local RightPart$ = CutLeft$(Text$, LeftCut)
   Local Result$ = LeftPart$ + RightPart$
EndPsub Result$

Function InputEx(XPos, YPos, Init)
   Static CurDraw, CurTimer, CurPos, Text$
   Static SelStart, SelLength

   If Init = 1
  Text$ = ""
  CurDraw = 0
  CurTimer = 0
  CurPos = 0
  SelStart = 0
  SelLength = 0
   EndIf
   
   If CurTimer < Timer() 
    CurTimer = Timer() + 300
    CurDraw = CurDraw Xor 1
   EndIf
   
   Local Char$ = Inkey$()
   Local SCode = ScanCode()
   Local Shift = SCode And 512
   SCode = SCode And 255
   If Asc(Char$) = -1 Then Goto OutputSection
   Local Ascii = Asc(Char$)
   
   Select SCode
  Case 203; Right Arrow
     If CurPos > 0 
    Dec CurPos
    If Shift Then Dec SelLength
     EndIf 
     
  Case 205; Left Arrow
     If CurPos < Len(Text$)
    Inc CurPos
    If Shift Then Inc SelLength
     EndIf
     
  Case 211; Delete
     If SelLength = 0 Then Text$ = _InputEx_Delete(Text$, CurPos + 1, CurPos + 1)
     If SelLength > 0
    Text$ = _InputEx_Delete(Text$, SelStart + 1, SelStart + SelLength)
    SelLength = 0
    CurPos = SelStart
     EndIf
     If SelLength < 0
    Text$ = _InputEx_Delete(Text$, SelStart + SelLength + 1, SelStart)
    StartSel = CurPos
    SelLength = 0
     EndIf
  
  Case 14; BackSpace
     If SelLength = 0
    If CurPos > 0 Then Dec CurPos
    Text$   = _InputEx_Delete(Text$, CurPos + 1, CurPos + 1)
     EndIf
     If SelLength > 0      
    Text$ = _InputEx_Delete(Text$, SelStart + 1, SelStart + SelLength)
    SelLength = 0
    CurPos = SelStart
     EndIf
     If SelLength < 0 
    Text$ = _InputEx_Delete(Text$, SelStart + SelLength + 1, SelStart)
    StartSel = CurPos
    SelLength = 0
     EndIf  
     
  Case 207; End     
     CurPos = Len(Text$)
     If Shift Then SelLength = Len(Text$) - SelStart
  
  Case 199; Home
     CurPos = 0
     If Shift Then SelLength = 0 - SelStart
     
  Default; other key
     If Ascii >= 32 And Scode < 155 And Scode > 0
    Inc CurPos
       Text$ = Insert$(Text$, Char$, CurPos - 1)
    If SelLength > 0
       Text$ = _InputEx_Delete(Text$, SelStart + 1, SelStart + SelLength)
       CurPos = SelStart + 1
       SelLength = 0
    EndIf 
    If SelLength < 0
       Text$ = _InputEx_Delete(Text$, SelStart + SelLength+2, SelStart+1)
       CurPos = SelStart+SelLength+1
       SelLength = 0
    EndIf 
     EndIf
     SelStart = CurPos
     If ASCII = 13 Then Status = 1
   EndSelect
   
   If Shift = 0
  SelLength = 0
  SelStart = CurPos
   EndIf
   
   CurTimer = Timer() + 300
   CurDraw = 1
   
OutputSection:   

Login required to view complete source code

[tomazmb]

Hello,

It still works OK.

Have a nice day,

Tomaz