News:

PlayBASIC2DLL V0.99 Revision I Commercial Edition released! - Convert PlayBASIC programs to super fast Machine Code. 

Main Menu

Extended Custom Input

Started by empty, December 11, 2004, 11:33:36 AM

Previous topic - Next topic

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
My computer specification:

AMD Athlon 64 2800+
MB ASUS K8V Socket 754 VIA K8T800
SB Audigy 2
3 GB RAM DDR 400 MHz PQI
AGP NVIDIA GeForce 7600GT 256 MB-Club 3D
Windows XP Pro SP2
DirectX 9.0c

empty

#2
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
My computer specification:

AMD Athlon 64 2800+
MB ASUS K8V Socket 754 VIA K8T800
SB Audigy 2
3 GB RAM DDR 400 MHz PQI
AGP NVIDIA GeForce 7600GT 256 MB-Club 3D
Windows XP Pro SP2
DirectX 9.0c