Kerning in vb.net

Question

Does anyone know how to change the kerning (space between characters) in vb.net? For example, i would like to change "STRING" to "S T R I N G". If possible i would like to be able to create my own font where i can specify the kerning as i wish! Thanks in advance!

Answer 1

The only way I found is to P/Invoke. Assumming a generic form with a generic button this code will work.

Imports System.Runtime.InteropServices

Public Class Form1
    Declare Function SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtra" (ByVal hDC As Integer, ByVal nCharExtra As Integer) As Integer
    <DllImport("gdi32")> _
    Private Shared Function TextOut(ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal textstring As String, ByVal charCount As Integer) As Boolean
    End Function
    <DllImport("gdi32")> _
    Private Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hgdiobj As IntPtr) As IntPtr
    End Function
    <DllImport("gdi32")> _
    Private Shared Function DeleteObject(ByVal objectHandle As IntPtr) As Boolean
    End Function
    <DllImport("gdi32")> _
    Private Shared Function SetBkColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
    End Function
    <DllImport("gdi32")> _
    Private Shared Function SetTextColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Using G = Graphics.FromHwnd(Me.Handle)
            Using myFont As New System.Drawing.Font("Arial", 20, FontStyle.Regular, GraphicsUnit.Pixel)
                'Regular Way
                Dim LeftEdge = 20
                G.DrawString("Hello", myFont, Brushes.Red, LeftEdge, 40)

                'If you want kerning
                Dim Kerning As Integer = 6 'I think this is twips
                Dim Hdc As IntPtr
                Dim FontPtr As IntPtr
                Try
                    'Grab the Graphic object's handle
                    Hdc = G.GetHdc()
                    'Set the current GDI font
                    FontPtr = SelectObject(Hdc, myFont.ToHfont())
                    'Set the drawing surface background color
                    SetBkColor(Hdc, ColorTranslator.ToWin32(Me.BackColor))
                    'Set the text color
                    SetTextColor(Hdc, ColorTranslator.ToWin32(Color.Red))
                    'Set the kerning
                    SetTextCharacterExtra(Hdc, Kerning)
                    Dim Text = "Hello"
                    'Draw the text at (20,60), Kerning will be applied so reset the left edge to half of kerning
                    TextOut(Hdc, LeftEdge + (Kerning \ 2), 60, Text, Text.Length)
                Catch ex As Exception

                Finally
                    'Release the font
                    DeleteObject(FontPtr)
                    'Release the handle on the graphics object
                    G.ReleaseHdc()
                End Try
            End Using
        End Using
    End Sub
End Class