第十章    FONTDMO.VBP
标准模块:Option ExplicitPublic Const LF_FACESIZE = 32
Public Const DEFAULT_CHARSET = 1
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(0 To LF_FACESIZE - 1) As Byte
End Type
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)‘窗体模块
Option ExplicitPrivate Sub Command1_Click()
    Dim font As LOGFONT
    Dim hOldFont As Long, hFont As Long
     
    RtlMoveMemory font.lfFaceName(0), _
                   ByVal CStr(cmbFontName), _
                   LenB(StrConv(cmbFontName, vbFromUnicode)) + 1
                   
    font.lfHeight = (Val(txtHeight) * -20) / Screen.TwipsPerPixelY
    font.lfWidth = (Val(txtWidth) * -20) / Screen.TwipsPerPixelY
    font.lfEscapement = Val(txtRotate) * 10
    font.lfWeight = IIf(chkBold, 700, 400)
    font.lfItalic = chkItalic
    font.lfUnderline = chkUnderline
    font.lfStrikeOut = chkStrikeThrough
    font.lfCharSet = DEFAULT_CHARSET
     
    hFont = CreateFontIndirect(font)
    hOldFont = SelectObject(Picture1.hDC, hFont)
     
    Picture1.Cls
    Picture1.CurrentX = Picture1.ScaleWidth / 2
    Picture1.CurrentY = Picture1.ScaleHeight / 2
    Picture1.Print txtString.Text
          
    SelectObject Picture1.hDC, hOldFont
    DeleteObject hFont
    
End SubPrivate Sub Form_Load()
    Dim i As Integer
    
    For i = 0 To Screen.FontCount - 1
        cmbFontName.AddItem Screen.Fonts(i)
    Next
    
    cmbFontName.Text = "Times New Roman"
End Sub///////我的问题:要打印出字体怎摸办,把所有的PICTURE1换成PRINTER吗,我试过不行//////