Link to home
Start Free TrialLog in
Avatar of Sven Schubert
Sven Schubert

asked on

Need Help to convert code from VB.Net --> VBA !!!

Can anybody help me to convert this code from VB.NET to VBA. It should afterwards be running on a system with: Win10, Excel 2013, VBA

Here is the original Code in VB.NET including the improvment further down in the thread:

Source: https://stackoverflow.com/questions/103725/is-there-a-way-to-programmatically-determine-if-a-font-file-has-a-specific-unico

<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

Open in new window


I would be very happy to get this translated. Any help very welcome.

Many thanks.
ASKER CERTIFIED SOLUTION
Avatar of aikimark
aikimark
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Sven Schubert
Sven Schubert

ASKER

Thank you Aikimak!

I had a look at the code. Unfortunately, on my system the results are not correct OR  it has been written with a different goal in mind. The issue is, even though many characters get displayed correctly after running the code, the evaluation column doesn't show that this character is part of the font.
Besides that, I'm not able to transform this code into a function like this one: Function IsCharacterPartOfFont (Character as String, Font as ??) as boolean

Would you or anybody else be able to:

  1. Correct the code so it's functioning the way I need it?
  1. Transform this into a function so I can call this function in my own VBA code.

Many thanks for your help.
Do you know how to program in the VBA environment?
Only a little bit. For this - with external APIs/dlls - my knowledge is not good enough.

And I would not be able to figure out why the current code doesn't work properly for my purpose.

That's why I still need help. Many thanks if you can help me.
I think that level of hand-holding would be a good case for Live or Gigs
I will have to read what that means. I am not fammiliar with those terms yet.
Thanks for the answer. I will somehow manage to get my results.