Newsgroup: it.comp.lang.visual-basic
Titolo: [HELP] Come sapere se un font è True Type?

Ciao a tutti,
vorrei riempire una combobox solo con font TrueType. Quindi: come si fa a
sapere se un font č TrueType o no?
Ho pensato di risolvere facendo due for (uno interno all'altro) che fanno lo
scan dei font dello schermo e della stampante e quelli uguali sono TrueType.
Ma č veramente lento, soprattutto se uno ha parecchi font.
Esiste qualche metodo piů veloce? API?
Grazie,
Paolo
----
PS. Eliminare xxx per rispondermi in email!

 Esiste qualche metodo piů veloce? API?
I font TrueType hanno l'estensione TTF.......
Controlla se sono TTF e sono TrueType
Ciao
--
Timothy Redaelli
timothy.redae...@email.it
------------------------------------------------------------------
Togliere NONSPAMMARE per rispondere

 sapere se un font è TrueType o no?
E' tra le proprietà del font.
Dai un'occhiata alle Api che lavorano sui font.
ciao
ugo

 API?
L'API EnumFontFamilies fa molto di più di quello che chiedi. Non escludo che
spulciando nel registri o magari (orrore...) in qualche tipo di win.ini non
si riesca a fare a meno delle API.
Ecco il codice per riempire un combobox con tutti i font e relativi tipi. Un
*If* al posto giusto e lo riempi con i soli font TT. Dato che il VB non è il
C (ma va?) ci sono di mezzo puntatori a strutture e ad array di caratteri,
serve l'API CopyMemory per recuperare le strutture e una funzioncina di
servizio per recuperare le stringhe.
In un modulo metti
----------------------------
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64
Public Const DEVICE_FONTTYPE = &H2
Public Const RASTER_FONTTYPE = &H1
Public Const TRUETYPE_FONTTYPE = &H4
Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(LF_FACESIZE) As Byte
End Type
Type ENUMLOGFONT
        elfLogFont As LOGFONT
        elfFullName(LF_FULLFACESIZE) As Byte
        elfStyle(LF_FACESIZE) As Byte
End Type
Type NEWTEXTMETRIC
        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
        ' Solo font TrueType
        ntmFlags As Long
        ntmSizeEM As Long
        ntmCellHeight As Long
        ntmAveWidth As Long
End Type
Declare Function EnumFontFamilies Lib "gdi32" Alias _
  "EnumFontFamiliesA" (ByVal hDC As Long, ByVal _
   lpszFamily As String, ByVal lpEnumFontFamProc _
   As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _
   (dest As Any, source As Any, ByVal numBytes As Long)
Function StringFromAsciiz(asciiz As String) As String
  Dim i As Integer
  i = InStr(asciiz, vbNullChar)
  If i Then
    StringFromAsciiz = Left$(asciiz, i - 1)
  Else
    StringFromAsciiz = asciiz
  End If
End Function
Function EnumFontFamilies_CBK(ByVal lpEnumLogFont As Long, _
  ByVal lpNewTextMetric As Long, ByVal FontType As Long, _
  ByVal lParam As Long) As Long
  Dim elf As ENUMLOGFONT
  Dim ntm As NEWTEXTMETRIC
  Dim fontname As String
  Dim fType As String
  ' copia nelle strutture locali
  CopyMemory elf, ByVal lpEnumLogFont, LenB(elf)
  CopyMemory ntm, ByVal lpNewTextMetric, LenB(ntm)
  ' nome completo del font
  fontname = StringFromAsciiz(StrConv(elf.elfLogFont.lfFaceName, bUnicode))
  ' tipo di font
  If FontType And DEVICE_FONTTYPE Then
    fType = "Downloadable "
  End If
  If FontType And RASTER_FONTTYPE Then
    fType = fType & "Raster"
  ElseIf FontType And TRUETYPE_FONTTYPE Then
    fType = fType & "TrueType"
  Else
    fType = fType & "Vector"
  End If
  ' aggiungi alla listbox
  Form1.Combo1.AddItem fontname & "  [" & fType & "]"
  ' restituisci True per continuare l'enumerazione
  EnumFontFamilies_CBK = True
End Function
---------------------
e richiama la funzione EnumFontFamilies, che è una funzione di enumerazione
che fa uso del CallBack, ovvero avvisa Win di mandargli delle risposte e gli
dice dove metterle, dopodiché sarà Win a richiamare ogni volta che avrà
pronta un risposta nuoava, finché non finisce o gli si dice di smetterla.
Ecco un esempio di chiamata:
  Combo1.Clear
  EnumFontFamilies Form1.hDC, vbNullString, AddressOf EnumFontFamilies_CBK,
0
oppure, se vuoi la lista dei font per la stampa:
  Combo1.Clear
  EnumFontFamilies Printer.hDC, vbNullString, AddressOf
EnumFontFamilies_CBK, 0
Ciao, Silv:o)