1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Declare Function GetFontUnicodeRanges Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal lpGlyphset As IntPtr) As UInt32
Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Int32
Public Structure FontRange
Public Low, High, Count As UShort
End Structure
Public Structure Glyphset
Public cbThis, flAccel, cGlyphsSupported, cRanges As UInteger, ranges() As FontRange
End Structure
Public Function GetUnicodeRangesForFont(ByVal font As Font) As Glyphset
'Win32 GetFontUnicodeRanges
Dim hdc, hFont, old, lpGlyphSet As IntPtr
Dim g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
hdc = g.GetHdc()
hFont = font.ToHfont()
old = SelectObject(hdc, hFont)
Dim size As UInteger = GetFontUnicodeRanges(hdc, IntPtr.Zero)
lpGlyphSet = Marshal.AllocHGlobal(CInt(size))
Dim read As UInteger = GetFontUnicodeRanges(hdc, lpGlyphSet)
Dim bytes(CInt(read) - 1) As Byte
Marshal.Copy(lpGlyphSet, bytes, 0, bytes.Length)
'cleanup
SelectObject(hdc, old)
Marshal.FreeHGlobal(lpGlyphSet)
g.ReleaseHdc(hdc)
g.Dispose()
DeleteObject(hFont)
'get glyph data
Dim gs As New Glyphset
gs.cbThis = BitConverter.ToUInt32(bytes, 0)
gs.flAccel = BitConverter.ToUInt32(bytes, 4)
gs.cGlyphsSupported = BitConverter.ToUInt32(bytes, 8)
gs.cRanges = BitConverter.ToUInt32(bytes, 12)
Array.Resize(gs.ranges, CInt(gs.cRanges))
For i As Integer = 0 To gs.ranges.Length - 1
gs.ranges(i).Low = BitConverter.ToUInt16(bytes, 16 + (i * 4))
gs.ranges(i).Count = BitConverter.ToUInt16(bytes, 18 + (i * 4))
gs.ranges(i).High = gs.ranges(i).Low + gs.ranges(i).Count - 1US
Next
'
Return gs
End Function |
Partager