How to get font kerning pairs in .net

Question

I'm trying to get font kerning pairs by using this P/Invoke call:

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

The ExamineParis function should show a messagebox whenever a font with defined kerning pairs is found (according to this: https://msdn.microsoft.com/en-us/library/windows/desktop/dd144895(v=vs.85).aspx ) But it seems to return always 0.

I need to find a way to get all kerning pairs of a given font (how many there are, and then their structure).

Does anyone know how it could be done?

The first argument to GetKerningPairs is an HDC, but you are passing an HFONT. — Lithis

Mark Mark · Accepted Answer · 2015-07-09T20:44:41

The accepted answer here shows how to call GetKerningPairs from VB.NET. Here's that code modified to fit with yours:

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

How to get font kerning pairs in .net

1 Answers