Как получить кернинг пары шрифтов в.net

Question

Я пытаюсь получить пары кернинга шрифта с помощью этого вызова P/Invoke:

Imports System.Runtime.InteropServices

Public Class Kerning

Structure KERNINGPAIR
    Public wFirst As UInt16
    Public wSecond As UInt16
    Public iKernelAmount As UInt32
End Structure

<DllImport("gdi32.dll")> _
Private Shared Function GetKerningPairs(hdc As IntPtr, 
      nNumPairs As UInteger, <Out> lpkrnpair As KERNINGPAIR()) As UInteger
End Function

Sub ExaminePairs()
    Dim f As Font
    For Each myFontFamily In System.Drawing.FontFamily.Families

        f = New Font(myFontFamily, 25)
        Dim pairs As UInteger = 0
        Dim pairsArray() As KERNINGPAIR
        ReDim pairsArray(pairs)
        Dim a = GetKerningPairs(f.ToHfont(), pairs, Nothing)
        If a <> 0 Then
            MsgBox("Found!")
        End If
        f.Dispose()
    Next

End Sub
End Class

Функция ExamineParis должна отображать окно сообщения всякий раз, когда найден шрифт с определенными парами кернинга (в соответствии с этим: https://msdn.microsoft.com/en-us/library/windows/desktop/dd144895(v=vs.85).aspx) Но, похоже, всегда возвращает 0.

Мне нужно найти способ получить все кернинг-пары данного шрифта (сколько их, а затем их структуру).

Кто-нибудь знает, как это можно сделать?

Answer 1

Принятый ответ здесь показывает, как позвонить GetKerningPairs из VB.NET. Вот этот код, модифицированный, чтобы соответствовать вашему:

Imports System.Drawing
Imports System.Runtime.InteropServices

Public Class Kerning

    <StructLayout(LayoutKind.Sequential)>
    Structure KERNINGPAIR
        Public wFirst As Short
        Public wSecond As Short
        Public iKernelAmount As Integer
    End Structure

    <DllImport("gdi32.dll", SetLastError:=True, CallingConvention:=CallingConvention.Winapi)>
    Public Shared Function GetKerningPairs(ByVal hdc As IntPtr, ByVal nPairs As Integer, <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)> <Out()> ByVal pairs() As KERNINGPAIR) As Integer
    End Function

    <DllImport("gdi32.dll")>
    Private Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function

    Public Shared Function GetKerningPairs(ByVal font As Font) As IList(Of KERNINGPAIR)
        Dim pairs() As KERNINGPAIR
        Using g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
            g.PageUnit = GraphicsUnit.Pixel
            Dim hdc As IntPtr = g.GetHdc
            Dim hFont As IntPtr = font.ToHfont
            Dim old As IntPtr = SelectObject(hdc, hFont)
            Try
                Dim numPairs As Integer = GetKerningPairs(hdc, 0, Nothing)
                If numPairs > 0 Then
                    pairs = New KERNINGPAIR(numPairs - 1) {}
                    numPairs = GetKerningPairs(hdc, numPairs, pairs)
                    Return pairs
                Else
                    Return Nothing
                End If
            Finally
                old = SelectObject(hdc, old) ' replace whatever object was selected in the dc
            End Try
        End Using
    End Function

    Sub ExaminePairs()
        For Each myFontFamily In FontFamily.Families
            Try
                Using f = New Font(myFontFamily, 25)
                    Dim pairs = GetKerningPairs(f)
                    If pairs IsNot Nothing Then
                        Debug.Print("#Pairs: {0}", pairs.Count)
                    Else
                        Debug.Print("No pairs found")
                    End If
                End Using
            Catch ex As Exception
                Debug.Print("Error: {0} for: {1}", ex.Message, myFontFamily.Name)
            End Try
        Next
    End Sub

End Class