home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / articles / vbdev / source / enmfntx.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-01-22  |  3.7 KB  |  112 lines
  1. VERSION 4.00
  2. Begin VB.Form enmfntx 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    Caption         =   "Enum Font Example"
  6.    ClientHeight    =   4020
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1500
  9.    ClientWidth     =   7365
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   4425
  21.    Left            =   1035
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   4020
  24.    ScaleWidth      =   7365
  25.    Top             =   1155
  26.    Width           =   7485
  27.    Begin VB.CommandButton Command1 
  28.       Appearance      =   0  'Flat
  29.       BackColor       =   &H80000005&
  30.       Caption         =   "List TrueType"
  31.       Height          =   435
  32.       Left            =   5460
  33.       TabIndex        =   3
  34.       Top             =   180
  35.       Width           =   1395
  36.    End
  37.    Begin VB.CommandButton CmdListArial 
  38.       Appearance      =   0  'Flat
  39.       BackColor       =   &H80000005&
  40.       Caption         =   "List Arial"
  41.       Height          =   495
  42.       Left            =   5460
  43.       TabIndex        =   2
  44.       Top             =   1140
  45.       Width           =   1395
  46.    End
  47.    Begin VB.CommandButton CmdListFonts 
  48.       Appearance      =   0  'Flat
  49.       BackColor       =   &H80000005&
  50.       Caption         =   "ListFonts"
  51.       Height          =   435
  52.       Left            =   5460
  53.       TabIndex        =   1
  54.       Top             =   660
  55.       Width           =   1395
  56.    End
  57.    Begin VB.ListBox List1 
  58.       Appearance      =   0  'Flat
  59.       Height          =   1785
  60.       Left            =   300
  61.       TabIndex        =   0
  62.       Top             =   1800
  63.       Width           =   5595
  64.    End
  65.    Begin VBX.ccCallback Callback1 
  66.       IntVersion      =   5
  67.       Left            =   6120
  68.       Top             =   2700
  69.       Type            =   2  'EnumFonts
  70.    End
  71. Attribute VB_Name = "enmfntx"
  72. Attribute VB_Creatable = False
  73. Attribute VB_Exposed = False
  74. Option Explicit
  75. Private Sub Callback1_EnumFonts(lpLogFont As Long, lpTextMetrics As Long, nFontType As Integer, lpData As Long, retval As Integer)
  76.     Dim fullname$, stylename$
  77.     ' agCopyData copies the data referenced by the pointer
  78.     ' provided into a structure
  79.     agCopyData ByVal lpLogFont, nlf, Len(nlf)
  80.     agCopyData ByVal lpTextMetrics, ntm, Len(ntm)
  81.     ' Only look at TrueType fonts.
  82.     If lpData = 1 And nFontType <> TRUETYPE_FONTTYPE Then Exit Sub
  83.     If nFontType = TRUETYPE_FONTTYPE Then
  84.         fullname$ = left$(nlf.lfFullName, InStr(nlf.lfFullName, Chr$(0)))
  85.         stylename$ = left$(nlf.lfStyle, InStr(nlf.lfStyle, Chr$(0)))
  86.     Else
  87.         ' Non truetype fonts do not have a valid lfFullname and lfStyle field
  88.         fullname$ = left$(nlf.lfFaceName, InStr(nlf.lfFaceName, Chr$(0)))
  89.     End If
  90.     list1.AddItem fullname$ & " " & stylename$
  91. End Sub
  92. Private Sub CmdListArial_Click()
  93.     Dim di%
  94.     Dim fname$
  95.     list1.Clear
  96.     fname$ = "Arial"
  97.     ' This gets Arial only (all styles)
  98.     di% = EnumFontFamilies(hDC, fname$, callback1.ProcAddress, 0)
  99. End Sub
  100. Private Sub CmdListFonts_Click()
  101.     Dim di%
  102.     list1.Clear
  103.     ' This gets one font for each family
  104.     di% = EnumFontFamiliesBynum(hDC, 0, callback1.ProcAddress, 0)
  105. End Sub
  106. Private Sub Command1_Click()
  107.     Dim di%
  108.     list1.Clear
  109.     ' This gets one font for each family
  110.     di% = EnumFontFamiliesBynum(hDC, 0, callback1.ProcAddress, 1)
  111. End Sub
  112.