GdipDrawString vs TextOut - unicode chars

well clarified in another post about chrW with some characters, now I have this doubt, because TextOut is able to recognize this character in any fonts, instead GdipDrawString if it does not have the correct font does not draw the desired character.

on the other hand I wonder why GdipCreateFontFamilyFromName is not compatible with all fonts.


add one listbox to the right

Code:

---

Option Explicit
Private Declare Function GdipCreateFont Lib "gdiplus" (ByVal fontFamily As Long, ByVal emSize As Single, ByVal Style As GDIPLUS_FONTSTYLE, ByVal UNIT As Long, createdfont As Long) As Long
Private Declare Function GdipCreateFontFamilyFromName Lib "gdiplus" (ByVal name As Long, ByVal fontCollection As Long, fontFamily As Long) As Long
Private Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal argb As Long, brush As Long) As Long
Private Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal brush As Long) As Long
Private Declare Function GdipDeleteFont Lib "gdiplus" (ByVal curFont As Long) As Long
Private Declare Function GdipDeleteFontFamily Lib "gdiplus" (ByVal fontFamily As Long) As Long
Private Declare Function GdipDeleteStringFormat Lib "gdiplus" (ByVal StringFormat As Long) As Long
Private Declare Function GdipDrawString Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mString As Long, ByVal mLength As Long, ByVal mFont As Long, ByRef mLayoutRect As RECTF, ByVal mStringFormat As Long, ByVal mBrush As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal hGraphics As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutW" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long

Private Type GdiplusStartupInput
    GdiplusVersion          As Long
    DebugEventCallback      As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type
 
Private Type RECTF
    Left    As Single
    Top    As Single
    Width  As Single
    Height  As Single
End Type
 
Public Enum GDIPLUS_FONTSTYLE
    FontStyleRegular = 0
    FontStyleBold = 1
    FontStyleItalic = 2
    FontStyleBoldItalic = 3
    FontStyleUnderline = 4
    FontStyleStrikeout = 8
End Enum
 

 


Private Const LOGPIXELSY        As Long = 90



Public Function DrawString(ByVal hDC As Long, _
                        ByVal Text As String, _
                        ByVal X As Single, _
                        ByVal Y As Single, oFont As StdFont) As Boolean
 
 
    Dim lBrush As Long
    Dim hGraphic As Long
    Dim lFontFamily As Long
    Dim lCurrentFont As Long
    Dim lFontSize As Long
    Dim lFontStyle As GDIPLUS_FONTSTYLE
    Dim lFormat As Long
    Dim RctText As RECTF
    Dim GdiToken As Long
    Dim GDIsi As GdiplusStartupInput
 
    GDIsi.GdiplusVersion = 1&
 
    If GdiplusStartup(GdiToken, GDIsi) = 0 Then

        If GdipCreateFontFamilyFromName(StrPtr(oFont.name), 0, lFontFamily) <> 0 Then
            GdiplusShutdown GdiToken
            Debug.Print "Error: GdipCreateFontFamilyFromName", oFont.name
            Exit Function
        End If

        Call GdipCreateFromHDC(hDC, hGraphic)

        If oFont.Bold Then lFontStyle = lFontStyle Or FontStyleBold
        If oFont.Italic Then lFontStyle = lFontStyle Or FontStyleItalic
        If oFont.Strikethrough Then lFontStyle = lFontStyle Or FontStyleStrikeout
        If oFont.Underline Then lFontStyle = lFontStyle Or FontStyleUnderline
 
        lFontSize = MulDiv(oFont.Size, GetDeviceCaps(hDC, LOGPIXELSY), 72)
        GdipCreateFont lFontFamily, lFontSize, lFontStyle, 0, lCurrentFont

        With RctText
            .Left = X
            .Top = Y
        End With
       
        GdipCreateSolidFill &HFF000000, lBrush
        DrawString = GdipDrawString(hGraphic, StrPtr(Text), Len(Text), lCurrentFont, RctText, lFormat, lBrush) = 0
        GdipDeleteBrush lBrush

        GdipDeleteFont lCurrentFont
        GdipDeleteFontFamily lFontFamily
        GdipDeleteGraphics hGraphic
        GdiplusShutdown GdiToken
    End If
End Function
 
Public Function ChrW2(ByVal CharCode As Long) As String
  Const POW10 As Long = 2 ^ 10
  If CharCode <= &HFFFF& Then ChrW2 = ChrW$(CharCode) Else _
                              ChrW2 = ChrW$(&HD800& + (CharCode And &HFFFF&) \ POW10) & _
                                      ChrW$(&HDC00& + (CharCode And (POW10 - 1)))
End Function


Private Sub Form_Load()

    Dim lChrCode As Long: lChrCode = &H1F601
    Dim sUTF16 As String: sUTF16 = ChrW2(lChrCode)
   
    Dim i As Long
    For i = 0 To Screen.FontCount - 1
        List1.AddItem Screen.Fonts(i)
    Next
    Me.AutoRedraw = True
    'Me.Font.name = "Segoe UI"
    Me.Font.name = "Segoe UI Emoji"
    Me.Font.Size = 14
   
    Call DrawString(Me.hDC, sUTF16, 0, 0, Me.Font)
   
    Call TextOut(Me.hDC, 0, 32, StrPtr(sUTF16), Len(sUTF16))
End Sub

Private Sub List1_Click()
    Dim lChrCode As Long: lChrCode = &H1F601
    Dim sUTF16 As String: sUTF16 = ChrW2(lChrCode)
   
    Me.Cls
    Me.Font.name = List1.Text
    Me.Font.Size = 14
   
    Call DrawString(Me.hDC, sUTF16, 0, 0, Me.Font)
   
    Call TextOut(Me.hDC, 0, 32, StrPtr(sUTF16), Len(sUTF16))
    Me.Refresh
End Sub

---