Diffrentiate betwwen types of font?

Hi,

Yes, you can inspect if a given font is a true type font. Use the textmetrics and inspect the tmPitchAndFamily mask of the textmetric structure. In the sample code below, you use a picturebox (picSelectedFont) that has the font you require the info from. Next, the cmdGetInfo button retrieves the name and type of the font.

Option Explicit

Private Const TMPF_DEVICE = &H8
Private Const TMPF_FIXED_PITCH = &H1
Private Const TMPF_TRUETYPE = &H4
Private Const TMPF_VECTOR = &H2

Private Type TEXTMETRIC
        tmHeight As Long
        tmAscent As Long
        tmDescent As Long
        tmInternalLeading As Long
        tmExternalLeading As Long
        tmAveCharWidth As Long
        tmMaxCharWidth As Long
        tmWeight As Long
        tmOverhang As Long
        tmDigitizedAspectX As Long
        tmDigitizedAspectY As Long
        tmFirstChar As Byte
        tmLastChar As Byte
        tmDefaultChar As Byte
        tmBreakChar As Byte
        tmItalic As Byte
        tmUnderlined As Byte
        tmStruckOut As Byte
        tmPitchAndFamily As Byte
        tmCharSet As Byte
End Type

Private Declare Function winGetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function winGetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long


Private Sub cmdGetInfo_Click()
  Dim tMetrics As TEXTMETRIC
  Dim lReturn As Long
  Dim sBuffer As String
  Dim lSize As Long
  Dim sReturn As String
' -------------------------------------
  On Error GoTo PROC_ERR
 
  lReturn = winGetTextMetrics(picSelectedFont.hdc, tMetrics)
  If (tMetrics.tmPitchAndFamily And TMPF_TRUETYPE) <> 0 Then
    sReturn = sReturn & "...The font is a truetype font" & vbCrLf
  End If
 
  If (tMetrics.tmPitchAndFamily And TMPF_VECTOR) <> 0 Then
    sReturn = sReturn & "...The font is a Vector font" & vbCrLf
  End If
 
  If (tMetrics.tmPitchAndFamily And TMPF_DEVICE) <> 0 Then
    sReturn = sReturn & "...The font is a device font" & vbCrLf
  End If
 
  If (tMetrics.tmPitchAndFamily And TMPF_FIXED_PITCH) <> 0 Then
    sReturn = sReturn & "...The font is a variable pitch font" & vbCrLf
  Else
    sReturn = sReturn & "...The font is a fixed pitch font" & vbCrLf
  End If
 
  sBuffer = String$(255, Chr$(0))
  lSize = Len(sBuffer)
 
  lReturn = winGetTextFace(picSelectedFont.hdc, lSize, sBuffer)
 
  MsgBox VBA.Left$(sBuffer, lReturn) & vbCrLf & sReturn
 
PROC_ERR:
  Select Case Err.Number
  Case Is <> 0
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdGetInfo_Click of Form frmMain"
    Err.Clear
  End Select
End Sub

Is this what you wanted to know?

Grtz.&copy;

D.