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

RegServe App.Path & "\" & gdi32.dll, True

GetFontUnicodeRanges(hdc, glyphSet)

GetFontUnicodeRanges = GetFontUnicodeRanges(hdc, glyphSet)

<DllImport("gdi32.dll")> _
Public Shared Function GetFontUnicodeRanges(ByVal hds As IntPtr, ByVal lpgs As _
IntPtr) As UInteger
End Function  
 
<DllImport("gdi32.dll")> _
Public Shared Function SelectObject(ByVal hDc As IntPtr, ByVal hObject As _
IntPtr) As IntPtr
End Function  
 
Public Structure FontRange
    Public Low As UInt16
    Public High As UInt16
End Structure  
 
Public Function GetUnicodeRangesForFont(ByVal font As Font) As List(Of _
  FontRange)
    Dim g As Graphics
    Dim hdc, hFont, old, glyphSet As IntPtr
    Dim size As UInteger
    Dim fontRanges As List(Of FontRange)
    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 As Integer = 0 To count - 1
    Dim range As FontRange = 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()
 
    Return fontRanges
End Function  
 
Public Function CheckIfCharInFont(ByVal character As Char, ByVal font As Font) _
  As Boolean
    Dim intval As UInt16 = Convert.ToUInt16(character)
    Dim ranges As List(Of FontRange) = GetUnicodeRangesForFont(font)
    Dim isCharacterPresent As Boolean = False
 
    For Each range In ranges
        If intval >= range.Low And intval <= range.High Then
            isCharacterPresent = True
            Exit For
        End If
    Next range
    Return isCharacterPresent
End Function  
 
Protected Function Unsign(ByVal Input As Int16) As UInt16
    If Input > -1 Then
        Return CType(Input, UInt16)
    Else
        Return UInt16.MaxValue - (Not Input)
    End If
End Function