|
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 Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) _
As Long
Private Declare Function SetBkMode Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nBkMode As Long) _
As Long
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
Dim RF As LOGFONT
Dim NewFont As Long
Dim OldFont As Long
Private Sub Command_View_Click()
Dim Throw As Long
Me.Picture1.Cls
RF.lfEscapement = Int(Val(Me.txtEscapement.Text)) * 10
'设置文本倾斜度
'设置字体参数
NewFont = CreateFontIndirect(RF)
'创建新字体
OldFont = SelectObject(Me.Picture1.hdc, NewFont)
'应用新字体
x = Me.Picture1.ScaleWidth / 2
y = Me.Picture1.ScaleHeight / 2
'选择显示文本的起点
Throw = TextOut(Me.Picture1.hdc, x, y, Me.Text_Input.Text, _
Len(Me.Text_Input.Text))
'显示文本
NewFont = SelectObject(Me.Picture1.hdc, OldFont)
'选择旧字体
Throw = DeleteObject(NewFont)
'删除新字体
End Sub
Private Sub Form_Load()
SetBkMode Me.Picture1.hdc, 1
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 / 10
End Sub
|
