|
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
'設(shè)置文本傾斜度
'設(shè)置字體參數(shù)
NewFont = CreateFontIndirect(RF)
'創(chuàng)建新字體
OldFont = SelectObject(Me.Picture1.hdc, NewFont)
'應(yīng)用新字體
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
'設(shè)置字符高度
RF.lfWidth = 10
'設(shè)置字符平均寬度
RF.lfEscapement = 0
'設(shè)置文本傾斜度
RF.lfWeight = 400
'設(shè)置字體的輕重
RF.lfItalic = 0
'字體不傾斜
RF.lfUnderline = 0
'字體不加下劃線
RF.lfStrikeOut = 0
'字體不加刪除線
RF.lfOutPrecision = 0
'設(shè)置輸出精度
RF.lfClipPrecision = 0
'設(shè)置剪輯精度
RF.lfQuality = 0
'設(shè)置輸出質(zhì)量
RF.lfPitchAndFamily = 0
'設(shè)置字體的字距和字體族
RF.lfCharSet = 0
'設(shè)置字符集
RF.lfFaceName = "Arial" + Chr(0)
'設(shè)置字體名稱
Me.txtEscapement.Text = RF.lfEscapement / 10
End Sub
|
