display unicode text(by windows api)

[qbfans]

Hello everyone, I'm a beginner, and QBasic was the first programming language I learned during my student days, although my knowledge of it was quite basic. I'm delighted to see how powerful it has become today. In this forum, I've learned a lot, but I've noticed that most discussions are quite advanced, with relatively few resources suitable for beginners—especially regarding localization, which is rarely addressed. Through my own exploration, I’ve managed to create a program that displays Chinese text in graphics mode. The core mechanism involves calling the Windows API to convert GBK to UTF-16. Please don’t laugh at my amateurish code—I’m still learning, and I welcome any feedback or corrections on its shortcomings.

Code: (Select All)

'$Console
_Title "Display Unicode Character - Test"
Declare Dynamic Library "kernel32"
    FUNCTION MultiByteToWideChar& (BYVAL CodePage AS LONG, BYVAL dwFlags AS LONG,_
                                  BYVAL lpMultiByteStr AS _OFFSET, BYVAL cbMultiByte AS LONG,_
                                  BYVAL lpWideCharStr AS _OFFSET, BYVAL cchWideChar AS LONG)
End Declare
'You can modify the path to point to their local font directory.
Const FONT_PATH = "c:\windows\fonts\"
'Define global font IDs (handles) for four fonts to be loaded
Dim Shared As Long fN3 'fn, fn1, fn2, fn3

text$ = "美丽中国Beautiful China"
mk_data$ = StringToUnicodeMK(text$)

'Dim As String inputStrSc, inputStrCon
'Use input,QBpe IDE shows garbled (ANSI display), but data stores correctly.
'Line Input "Input texts in the screen:", inputStrSc
'Initializes the screen and loads fonts.
initinput
'Switch to console (native Unicode support) for clean input
'_ScreenHide
'_Console On
'_Dest _Console
'Line Input "Input texts in the console:", inputStrCon
'_Console Off
'_ScreenShow
'_ScreenMove _Middle
'_Dest 0

'_UPrintString (50, 50), StringToUnicodeMK(inputStrSc + inputStrCon), , 16, fn
'_UPrintString (50, 80), mk_data$, , 16, fn
'_UPrintString (50, 110), mk_data$, , 16, fn1
'_UPrintString (50, 150), mk_data$, , 16, fn2
If fN3 > 0 Then
    _UPrintString (50, 200), mk_data$, , 16, fN3
Else
    _PrintString (50, 40), "Font load false._UPrintString may not work, use _PrintString for English"
End If
Sleep
_Font 16
'_FreeFont fn
'_FreeFont fn1
'_FreeFont fn2
_FreeFont fN3
System

'Initializes the screen and loads fonts.
Sub initinput
    Screen _NewImage(1000, 760, 32)
    _ScreenMove _Middle
    Cls , _RGB32(155, 155, 155)
    _PrintMode _KeepBackground
    Color _RGB32(0, 0, 0)
    'You may substitute simsun.ttc... with a locally supported font file.
    'fn = _LoadFont(FONT_PATH + "simsun.ttc", 20, "automono")
    'fn1 = _LoadFont(FONT_PATH + "KTGB2312.ttf", 30, "automono")
    'fn2 = _LoadFont(FONT_PATH + "STLITI.TTF", 40, "automono")
    fN3 = _LoadFont(FONT_PATH + "STHUPO.TTF", 50, "automono")
    If fN3 <= 0 Then
        ' Second fallback also failed
        Print "Fallback font also unavailable."
        Print "Using system default font (English only)."
        ' Use system default font (won't display Chinese properly)
        _Font 16
        ' Note: System font handle cannot be obtained directly
    End If
End Sub

'  Main function: Converts entire string at once, then unpacks
Function StringToUnicodeMK$ (teXt As String)
    Const CP_ACP = 0 ' Code page: ANSI (default system locale)
    Const UTF16_WIDTH = 2 'Character width in bytes for UTF-16 (little-endian)
    Dim As String result, buffer, str_null
    Dim As _Unsigned Long needed, written
    Dim As _Unsigned Integer i, posC
    Dim hi As _Unsigned _Byte
    If Len(teXt) = 0 Then Exit Function
    result = ""
    ' Convert entire string to Unicode in one operation
    str_null = teXt + Chr$(0)
    needed = MultiByteToWideChar(CP_ACP, 0, _Offset(str_null$), Len(str_null$), 0, 0)
    If needed <= 1 Then Exit Function
    buffer = Space$(needed * UTF16_WIDTH) ' Allocate buffer for wide chars
    written = MultiByteToWideChar(CP_ACP, 0, _Offset(str_null$), Len(str_null$), _Offset(buffer), needed)
    If written <= 1 Then Exit Function
    ' Unpack wide characters and pack into MK$ format (skip final null)
    For i = 1 To written - 1
        posC = (i - 1) * UTF16_WIDTH + 1 'Position in byte buffer (1-based)
        ' Asc(buffer, posC + 1)  High byte (for Chinese characters)
        ' If hi = 0, character is ASCII, value is low byte only
        ' Pack as little-endian 16-bit integer (QB64 uses little-endian architecture)
        result = result + _MK$(Integer, Asc(buffer, posC + 1) * 256 + Asc(buffer, posC))
    Next
    StringToUnicodeMK = result
End Function