Skini API-Guide i pogledaj funkciju EnumFonts
evo primera iz API-Guide-a:
Code:
'in a form
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail:
[email protected]
Me.AutoRedraw = True
EnumFonts Me.hDC, vbNullString, AddressOf EnumFontProc, 0
End Sub
'in a module
Private Const LF_FACESIZE = 32
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
Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
Dim LF As LOGFONT, FontName As String, ZeroPos As Long
CopyMemory LF, ByVal lplf, LenB(LF)
FontName = StrConv(LF.lfFaceName, vbUnicode)
ZeroPos = InStr(1, FontName, Chr$(0))
If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1)
Form1.Print FontName
EnumFontProc = 1
End Function
[edit]
Goran me je pretekao za 30ak sekundi :)
Moze i sa Screen.Fonts, sto je sigurno jednostavnije od direktnog pristupa EnumFonts API funkciji.
[/edit]