VB API 第四课 字体应用篇之二

Option Explicit

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Button As Long
End Type
Private 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 As String * 50
End Type
Private RF As LOGFONT
Private NewFont As Long
Private OldFont As Long

Function FontOption()
    RF.lfWidth = Int(Val(Me.txtWidth.Text))
    RF.lfHeight = Int(Val(Me.txtHeight.Text))
    RF.lfEscapement = Int(Val(Me.txtEscapement.Text))
    RF.lfWeight = Int(Val(Me.txtWeight.Text))
    RF.lfItalic = Me.chkItalic.Value
    RF.lfUnderline = Me.chkUnderline.Value
    RF.lfStrikeOut = Me.chkStrikeOut.Value
End Function



Private Sub Command1_Click()
    Dim Throw As Long
    Dim x, y As Long
    FontOption   ‘设置字体参数
    NewFont = CreateFontIndirect(RF)   ‘创建新字体
    OldFont = SelectObject(Me.Picture1.hdc, NewFont) ‘应用新字体
    x = Picture1.ScaleWidth / 2
    y = Picture1.ScaleHeight / 2   ‘显示文本的位置
    Throw = TextOut(Me.Picture1.hdc, x, y, Me.txtShow.Text, Len(Me.txtShow.Text))  ‘显示文本
    NewFont = SelectObject(Me.Picture1.hdc, OldFont)  ‘选择旧字体
    Throw = DeleteObject(NewFont)   ‘删除字体
    
End Sub

Private Sub Command2_Click()
    Me.Picture1.Cls
End Sub

Private Sub Form_Load()
    RF.lfHeight = 50  ‘设置字体高度
    RF.lfWidth = 10    ‘设置字体平均宽度
    RF.lfEscapement = 0  ‘设置文本倾斜度
    RF.lfWeight = 400   ‘设置字体的轻重
    RF.lfItalic = 0    ‘设置字体不倾斜
    RF.lfUnderline = 0  ‘字体不加下划线
    RF.lfStrikeOut = 0   ‘字体不加删除线
    RF.lfOutPrecision = 0  ‘设置输出进度
    RF.lfClipPrecision = 0  ‘设置剪辑精度
    RF.lfQuality = 0      ‘设置输出质量
    RF.lfPitchAndFamily = 0  ‘设置字体的字距和字体族
    RF.lfCharSet = 0        ‘设置字符集
    RF.lfFaceName = "Arial" + Chr(0)   ‘设置字体名字
    Me.txtEscapement.Text = RF.lfEscapement
    Me.txtHeight.Text = RF.lfHeight
    Me.txtWeight.Text = RF.lfWeight
    Me.txtWidth.Text = RF.lfWidth
    ‘设置文本框显示文本
End Sub