Option Explicit
Public Low As UInt16
Public High As UInt16

Public Function GetUnicodeRangesForFont(ByVal font As font) As Collection '(Of 
' FontRange)
    Public Declare PtrSafe Function GetFontUnicodeRanges Lib "gdi32.dll" (ByVal _
      hds As IntPtr, ByVal lpgs As IntPtr) As UInteger
    '<DllImport("gdi32.dll")> _
    'Public Shared Function GetFontUnicodeRanges(ByVal hds As IntPtr, ByVal 
    ' lpgs As IntPtr) As UInteger
    End Function
 
    Public Declare PtrSafe Function SelectObject Lib "gdi32.dll" (ByVal hDC As _
      IntPtr, ByVal hObject As IntPtr) As IntPtr
    '<DllImport("gdi32.dll")> _
    'Public Shared Function SelectObject(ByVal hDc As IntPtr, ByVal hObject As 
    ' IntPtr) As IntPtr
    End Function
 
    RegServe App.Path & "\" & gdi32.dll, True
    Dim g As Graphics
    Dim hDC, hFont, old, glyphSet As IntPtr
    Dim size As UInteger
    Dim GURFF As FontRange
    Set GURFF = New FontRange
    Set GetUnicodeRangesForFont = New Collection
    Dim fontRanges As Collection '(Of FontRange)
    Dim frs As FontRange
    Set fontRanges = New Collection
    Set frs = New FontRange
    Dim i As Integer
 
    Dim count As Integer
 
    g = Graphics.FromHwnd(IntPtr.Zero)
    hDC = g.GetHdc()
    hFont = font.ToHfont()
    old = SelectObject(hDC, hFont)
    size = GetFontUnicodeRanges(hDC, IntPtr.Zero)
    glyphSet = Marshal.AllocHGlobal(CInt(size))
    GetFontUnicodeRanges(hDc, glyphSet)
    'fontRanges = New List(Of FontRange)
    count = Marshal.ReadInt32(glyphSet, 12)
 
    For i = 0 To count - 1
        Dim range As FontRange
        Set range = New FontRange
        range.Low = Unsign(Marshal.ReadInt16(glyphSet, 16 + (i * 4)))
        range.High = range.Low + Unsign(Marshal.ReadInt16(glyphSet, 18 + (i * _
          4)) - 1)
        fontRanges.Add (range)
    Next
 
    SelectObject(hDc, old)
    Marshal.FreeHGlobal (glyphSet)
    g.ReleaseHdc (hDC)
    g.Dispose()
 
    GetFontUnicodeRanges = fontRanges
End Function
 
Private Function Unsign(ByVal Input As Int16) As UInt16
    If Input > -1 Then
        Unsign = CType(Input, UInt16)
    Else
        Unsign = UInt16.MaxValue - (Not Input)
    End If
End Sub
 
Public Function CheckIfCharInFont(ByVal character As String, ByVal font As _
  font) As Boolean
    RegServe App.Path & "\" & gdi32.dll, True
 
    Dim intval As UInt16
    Dim ranges As Collection  '(Of FontRange)
    Dim fr As FontRange
    Set fr = New FontRange
    Set ranges = New Collection
 
    Dim isCharacterPresent As Boolean
    Dim range As Object
 
    intval = Convert.ToUInt16(character)
    ranges = GetUnicodeRangesForFont(font)
    isCharacterPresent = False
 
    For Each range In ranges
        If intval >= range.Low And intval <= range.High Then
            isCharacterPresent = True
            Exit For
        End If
    Next range
    CheckIfCharInFont = isCharacterPresent
End Function