2010-06-07 30 views

回答

1

看到這些鏈接已經死了,我挖出了我在工作時使用的代碼。

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 
相關問題