Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
HELP, I've fallen out of SCREEN 0 and I can't Esc back!
#1
Code: (Select All)
$Color:32
Screen _NewImage(1100, 600, 32)
f& = _LoadFont("c:\windows\fonts\lucon.ttf", 16)
_Font f&
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Delay .1
_ScreenMove 0, 0
x = 100
y = 100
maxchars = 90
a$ = "If I had a nickle for every good idea, I couldn't afford to give anyone my 2-cents."
sentence$ = Space$(maxchars): Mid$(sentence$, 1, Len(a$)) = a$
strng$ = GetField(sentence$, x, y, maxchars)
End

Function GetField$ (t$, x, y, maxchars)
t$ = Left$(t$ + Space$(maxchars), maxchars)
ccol = 1: cnew = ccol
Do:
_Limit 30
Line (x, y)-(x + _PrintWidth(t$) + 20, y + 16), _RGB32(255, 255, 255, 255), BF
Color _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 255)
_PrintString (x, y), t$

If Timer > cc! Or cnew <> ccol Or ins_update Then
If ins_update = 1 And Timer < cc! Then
_KeyClear
_Continue ' Wait for one cursor cycle before next operation.
Else
bit = bit Xor 1
cc! = Timer + .25
c$ = Mid$(t$, ccol, 1)
chr_wdth = _PrintWidth(c$)
tx_row = _PrintWidth(Mid$(t$, 1, ccol)) - _PrintWidth(c$)

If overwritemode Then
Line (x + tx_row - 0, y)-(x + tx_row - 0 + chr_wdth, y + 16), _RGB32(bit * 200), BF ' insert cursor
If bit Then
Color _RGB32(255, 255, 255, 255), _RGB32(0, 0, 0, 255) ' Overwrite cursor.
_PrintString (x + tx_row, y), c$
End If
Else
Line (x + tx_row, y + 16)-Step(chr_wdth, 0), _RGB32(bit * 255) ' Underline cursor.
End If
_Display ' text and cursor
If ins_update = -1 Then ins_update = 1: _Continue Else ins_update = 0
End If
End If
cnew = ccol
b$ = InKey$
Select Case Len(b$)
Case Is = 1
ins_update = 0 ' Shut off cycle delay since ins key was not pressed.
If b$ = Chr$(27) Then ' Remove cursor and restore text before quitting.
Color _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 255)
_PrintString (x, y), t$
_Display
End ' Esc
End If
If b$ = Chr$(13) Then ' Enter
GetField$ = LTrim$(RTrim$(t$))
_AutoDisplay
Exit Function
End If
If b$ = Chr$(8) Then ' backspace
If ccol > 1 Then
ccol = ccol - 1 - (ccol = 1)
t$ = Left$(t$, ccol - 1) + Right$(t$, maxchars - ccol) + " "
End If
_Continue
End If
If overwritemode Then
Mid$(t$, ccol, 1) = b$
If ccol < maxchars Then ccol = ccol + 1 Else cnew = -ccol ' Disables printing delay due to cursor non-movement.
Else
If Len(RTrim$(t$)) < maxchars Then
t$ = Left$(Left$(t$, ccol - 1) + b$ + Right$(t$, Len(t$) - ccol + 1) + Space$(10), maxchars)
If ccol < maxchars Then ccol = ccol + 1
End If
End If
Case Is = 2
a = Asc(Right$(b$, 1))
If ins_update And a <> 82 Then ins_update = 0 ' Shut off cycle delay since ins key was not pressed.
Select Case a
Case 71 ' Home
If ccol <> 1 Then ccol = 1
Case 79 ' End
If ccol < Len(RTrim$(t$)) + 1 And ccol < maxchars Then
If Len(RTrim$(t$)) = maxchars Then ccol = maxchars Else ccol = Len(RTrim$(t$)) + 1
End If
Case 82 ' Ins
If Not ins_update Then overwritemode = overwritemode Xor 1: ins_update = -1
Case 83 ' Del
If Len(RTrim$(t$)) And ccol <= Len(RTrim$(t$)) Then t$ = Left$(t$, ccol - 1) + Right$(t$, maxchars - ccol) + " ": cnew = -ccol
End Select
cur_arrows = ccol + (a = 75) - (a = 77) ' left or right arrow
If cur_arrows > ccol Then
If cur_arrows > Len(RTrim$(t$)) + 1 Or cur_arrows > maxchars Then
If cur_arrows > maxchars Then ccol = maxchars
Else
ccol = cur_arrows
End If
Else
If cur_arrows < ccol And cur_arrows > 0 Then ccol = cur_arrows
End If
End Select
Loop
End Function

This was a project I continued today from a few years back. My thanks the Richard Frost, who came up with a nice cursor routine for graphics screens. I modified that routine a bit, to cut down on some processing loops. I do a lot of WP stuff in screen 0, but I'm either going to have to take this new approach, or continue using some hardware image hybrids if I want to add so extra bells and whistles, like underlined and italic text.

The above example is bare bones, but missing mouse translation to graphics for now, as well as highlighting and scrolling input past the max characters point, it certainly is usable, as is , for smaller input tasks.

I'm also looking into some very cool text printing with hardware  imaging, posted by MasterGY: https://qb64phoenix.com/forum/showthread...4#pid23644

QB64 has certainly opened up a world of possibilities. From Rob to Fell, and the developer crew still working on it today. Wow, you guys rock!

Pete
Reply


Messages In This Thread
HELP, I've fallen out of SCREEN 0 and I can't Esc back! - by Pete - 03-10-2024, 01:37 AM



Users browsing this thread: 2 Guest(s)