ASCII Picker

[SMcNeill]

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