+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: SMcNeill (https://staging.qb64phoenix.com/forumdisplay.php?fid=29)
+---- Thread: ASCII Picker (/showthread.php?tid=110)
ASCII Picker - SMcNeill - 04-22-2022
You guys may have seen something like this somewhere before, but this is the original, prettier version than the one that exists inside the QB64 IDE.
Code: (Select All)
_Title "External ASCII Picker"
Screen _NewImage(640, 480, 32)
f = _LoadFont("cour.ttf", 128) 'a nice large display font, not a 100% match to QB64's inbuilt version,
_Font f ' but it works easily here for a demo highlight character
_ControlChr Off
Do
out$ = ASCIIbox$ 'get an ASCII character
If out$ = "" Then System
Print out$, Asc(out$) 'preview it
Sleep: _KeyClear 'hit a key to select another
Cls
Loop
Function ASCIIbox$
Static temp As Long, temp1 As Long, ws As Long
d = _Dest
font = _Font
If temp = 0 Then 'static backgrounds so we don't have to make them over and over, or worry about freeing them
temp = _NewImage(640, 480, 32)
temp1 = _NewImage(640, 480, 32)
ws = _NewImage(640, 480, 32)
End If
Screen temp
Dim CurrentASC(1 To 16, 1 To 16)
Dim CurrentOne As Integer
Cls , _RGB(0, 0, 170)
Color , _RGB(0, 0, 170)
For y = 1 To 16
For x = 1 To 16
Line (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
Line (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
If counter Then _PrintString (x * 40 - 28, y * 30 - 23), Chr$(counter)
counter = counter + 1
Next
Next
_Dest temp1
Cls , _RGB(0, 0, 170)
Color , _RGB(0, 0, 170)
counter = 0
For y = 1 To 16
For x = 1 To 16
Line (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
Line (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
text$ = LTrim$(Str$(counter))
If counter Then _PrintString (x * 40 - 24 - (Len(text$)) * 4, y * 30 - 23), text$
counter = counter + 1
Next
Next
_Dest temp
x = 1: y = 1
_PutImage , temp, ws
Do: Loop While _MouseInput 'clear the mouse input buffer
oldmousex = _MouseX: oldmousey = _MouseY
Do
_Limit 60
Do: Loop While _MouseInput
If oldx <> _MouseX And oldy <> _MouseY Then
x = _MouseX \ 40 + 1 'If mouse moved, where are we now?
y = _MouseY \ 30 + 1
End If
oldx = _MouseX: oldy = _MouseY
num = (y - 1) * 16 + x - 1
If num = 0 Then
text$ = ""
Else
flashcounter = flashcounter + 1
If flashcounter > 30 Then
Color _RGB32(255, 255, 255), _RGB(0, 0, 170)
text$ = Chr$(num)
If Len(text$) = 1 Then text$ = " " + text$ + " "
Else
Color _RGB32(255, 255, 255), _RGB(0, 0, 170)
text$ = RTrim$(LTrim$(Str$(num)))
End If
End If
If flashcounter = 60 Then flashcounter = 1
Cls
If toggle Then _PutImage , temp1, temp Else _PutImage , ws, temp
_PrintString (x * 40 - 24 - (Len(text$)) * 4, y * 30 - 23), text$
Line (x * 40 - 40, y * 30 - 30)-(x * 40, y * 30), _RGBA32(255, 255, 255, 150), BF
k1 = _KeyHit
MouseClick = 0: MouseExit = 0
If MouseButtonSwapped Then
MouseClick = _MouseButton(2): MouseExit = _MouseButton(1)
Else
MouseClick = _MouseButton(1): MouseExit = _MouseButton(2)
End If
Select Case k1
Case 13: Exit Do
Case 27
GoTo cleanexit
Case 32: toggle = Not toggle
Case 18432: y = y - 1
Case 19200: x = x - 1
Case 20480: y = y + 1
Case 19712: x = x + 1
End Select
If x < 1 Then x = 1
If x > 16 Then x = 16
If y < 1 Then y = 1
If y > 16 Then y = 16
_Display
If MouseExit GoTo cleanexit
Loop Until MouseClick
ret% = (y - 1) * 16 + x - 1
If ret% > 0 And ret% < 255 Then
ASCIIbox$ = Chr$(ret%)
End If
cleanexit:
_AutoDisplay
Screen d
_Font font
_Dest 0: _Delay .2
End Function