Extraction des glyphs d'une font ?

Bon le sujet n'a pas l'air d'intéresser grand monde... :?

Voici la solution que j'ai mise en oeuvre :
Code:
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