Update v1.01.2
- Added UCS4
Code: Select all
;-TOP by mk-soft, v1.01.2, 19.04.2023
; Free result with g_free_(...)
Procedure GCHAR(String$)
Protected *gchar, items_read, items_written, *ppError.gerror
*gchar = g_utf16_to_utf8_(String$, -1, @items_read, @items_written, @*ppError)
If *ppError
Debug "GCHAR Error: " + PeekS(*ppError\message, -1, #PB_UTF8)
g_error_free_(*ppError)
EndIf
ProcedureReturn *gchar
EndProcedure
Procedure.s StringFromUCS4(*gunichar)
Protected r1.s, *gunichar2, items_read, items_written, *ppError.gerror
*gunichar2 = g_ucs4_to_utf16_(*gunichar, -1, @items_read, @items_written, @*ppError)
If *ppError
Debug "GUNICHAR Error: " + PeekS(*ppError\message, -1, #PB_UTF8)
g_error_free_(*ppError)
EndIf
If *gunichar2
r1 = PeekS(*gunichar2, -1, #PB_Unicode)
g_free_(*gunichar2)
EndIf
ProcedureReturn r1
EndProcedure
Procedure StringToUCS4(String$)
Protected *gunichar, items_read, items_written, *ppError.gerror
*gunichar = g_utf16_to_ucs4_(String$, -1, @items_read, @items_written, @*ppError)
If *ppError
Debug "GUNICHAR Error: " + PeekS(*ppError\message, -1, #PB_UTF8)
g_error_free_(*ppError)
EndIf
ProcedureReturn *gunichar
EndProcedure
; ****
CompilerIf #PB_Compiler_IsMainFile
Structure ArrayOfLong
l.l[0]
EndStructure
Structure ArrayOfUnicode
u.u[0]
EndStructure
Structure ArrayOfByte
StructureUnion
b.b[0]
a.a[0]
EndStructureUnion
EndStructure
Debug "gunichar to string"
Dim unichar.l(4)
unichar(0) = Asc("{")
unichar(1) = $0001f923
unichar(2) = Asc("}")
s1.s = StringFromUCS4(@unichar())
Debug s1
*unicode.ArrayOfUnicode = @s1
If *unicode
i = 0
While *unicode\u[i]
Debug "Char " + i + ": " + RSet(Hex(*unicode\u[i], #PB_Unicode), 4, "0")
i + 1
Wend
EndIf
Debug "----"
Debug "gunichar from string"
*gunichar.ArrayOfLong = StringToUCS4(s1)
If *gunichar
i = 0
While *gunichar\l[i]
Debug "Char " + i + ": " + RSet(Hex(*gunichar\l[i], #PB_Long), 8, "0")
i + 1
Wend
g_free_(*gunichar)
EndIf
Debug "----"
Debug "gchar from string"
*gchar.ArrayOfByte = GCHAR(s1)
If *gchar
Debug PeekS(*gchar, -1, #PB_UTF8)
i = 0
While *gchar\a[i]
Debug "Byte " + i + ": " + RSet(Hex(*gchar\a[i], #PB_Ascii), 2, "0")
i + 1
Wend
g_free_(*gchar)
EndIf
Debug "----"
CompilerEndIf