Namespace FontManagement
''' <summary>
''' Windows API Logical Font structure to represent information
''' about a font.
''' </summary>
<System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
Public Structure LOGFONT
''' <summary>
''' Height of the font.
''' </summary>
Public lfHeight As Integer
Public lfWidth As Integer
Public lfEscapement As Integer
Public lfOrientation As Integer
Public lfWeight As Integer
Public lfItalic As Byte
Public lfUnderline As Byte
Public lfStrikeOut As Byte
Public lfCharSet As Byte
Public lfOutPrecision As Byte
Public lfClipPrecision As Byte
Public lfQuality As Byte
Public lfPitchAndFamily As Byte
<System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=32)> _
Public lfFaceName As String
End Structure
''' <summary>
''' Enumeration of Panose Font Family Types. These can be used for
''' determining the similarity of two fonts or for detecting non-character
''' fonts like WingDings.
''' </summary>
Public Enum PanoseFontFamilyTypes As Integer
''' <summary>
''' Any
''' </summary>
PAN_ANY = 0
''' <summary>
''' No Fit
''' </summary>
PAN_NO_FIT = 1
''' <summary>
''' Text and Display
''' </summary>
PAN_FAMILY_TEXT_DISPLAY = 2
''' <summary>
''' Script
''' </summary>
PAN_FAMILY_SCRIPT = 3
''' <summary>
''' Decorative
''' </summary>
PAN_FAMILY_DECORATIVE = 4
''' <summary>
''' Pictorial
''' </summary>
PAN_FAMILY_PICTORIAL = 5
End Enum
''' <summary>
''' Summary description for FontUtility.
''' </summary>
Public Class Utility
<System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
Private Structure TEXTMETRIC
Public tmHeight As Integer
Public tmAscent As Integer
Public tmDescent As Integer
Public tmInternalLeading As Integer
Public tmExternalLeading As Integer
Public tmAveCharWidth As Integer
Public tmMaxCharWidth As Integer
Public tmWeight As Integer
Public tmOverhang As Integer
Public tmDigitizedAspectX As Integer
Public tmDigitizedAspectY As Integer
<System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=1)> _
Public tmFirstChar As String
<System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=1)> _
Public tmLastChar As String
<System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=1)> _
Public tmDefaultChar As String
<System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=1)> _
Public tmBreakChar As String
Public tmItalic As Byte
Public tmUnderlined As Byte
Public tmStruckOut As Byte
Public tmPitchAndFamily As Byte
Public tmCharSet As Byte
End Structure
Private Declare Function GetTextMetrics Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByRef lptm As TEXTMETRIC _
) As Integer
Private Declare Function GetOutlineTextMetricsA Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByVal cbData As Integer, _
ByVal lpOtm As IntPtr _
) As Integer
Private Declare Function SelectObject Lib "gdi32" ( _
ByVal hdc As IntPtr, _
ByVal hObj As IntPtr _
) As IntPtr
''' <summary>
''' Gets the <see cref="PanoseFontFamilyTypes"/> for the specified font.
''' </summary>
''' <param name="graphics">A graphics object to use when detecting the Panose
''' family.</param>
''' <param name="font">The font to check.</param>
''' <returns>The Panose font family type.</returns>
Public Shared Function PanoseFontFamilyType( _
ByVal graphics As Graphics, _
ByVal font As Font) As PanoseFontFamilyTypes
Dim bFamilyType As Byte = 0
Dim hdc As IntPtr = graphics.GetHdc()
Dim hFontOld As IntPtr = SelectObject(hdc, font.ToHfont())
Dim bufSize As Integer = GetOutlineTextMetricsA(hdc, 0, IntPtr.Zero)
Dim lpOtm As IntPtr = System.Runtime.InteropServices.Marshal.AllocCoTaskMem(bufSize)
System.Runtime.InteropServices.Marshal.WriteInt32(lpOtm, bufSize)
Dim success As Integer = GetOutlineTextMetricsA(hdc, bufSize, lpOtm)
If Not (success = 0) Then
Dim offset As Integer = 61
bFamilyType = System.Runtime.InteropServices.Marshal.ReadByte(lpOtm, offset)
'byte bSerifStyle = Marshal.ReadByte(lpOtm, offset + 1);
'byte bWeight = Marshal.ReadByte(lpOtm, offset + 2);
'byte bProportion = Marshal.ReadByte(lpOtm, offset + 3);
'byte bContrast = Marshal.ReadByte(lpOtm, offset + 4);
'byte bStrokeVariation = Marshal.ReadByte(lpOtm, offset + 5);
'byte bArmStyle = Marshal.ReadByte(lpOtm, offset + 6);
'byte bLetterform = Marshal.ReadByte(lpOtm, offset + 7);
'byte bMidline = Marshal.ReadByte(lpOtm, offset + 8);
'byte bXHeight = Marshal.ReadByte(lpOtm, offset + 9);
End If
System.Runtime.InteropServices.Marshal.FreeCoTaskMem(lpOtm)
SelectObject(hdc, hFontOld)
graphics.ReleaseHdc(hdc)
Return CType(bFamilyType, PanoseFontFamilyTypes)
End Function
Private Sub New()
End Sub
End Class
End Namespace
