vb drawtext怎样设置字体
答案:1 悬赏:70 手机版
解决时间 2021-03-20 14:39
- 提问者网友:嗝是迷路的屁
- 2021-03-19 15:46
vb drawtext怎样设置字体
最佳答案
- 五星知识达人网友:慢性怪人
- 2021-03-19 16:38
下面是个例子:
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As LOGFONT) As Long
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 DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const SYSTEM_FONT = 13
Private Const LF_FACESIZE = 32
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(1 To LF_FACESIZE) As Byte
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Command1_Click() '点击Command1运行
Dim ofont As Long, nfont As Long
Dim lf As LOGFONT, r As RECT
Dim s As String
ofont = SelectObject(Picture1.hdc, GetStockObject(SYSTEM_FONT)) '获取Picture1的当前字体对象
GetObject ofont, Len(lf), lf '从字体对象中获取字体信息
lf.lfHeight = lf.lfHeight * 3 '字体扩大三倍(你可以自己改其他的)
nfont = CreateFontIndirect(lf) '重新建立字体对象
ofont = SelectObject(Picture1.hdc, nfont) '替换Picture1中的字体对象
s = "123你好abc" '要显示的文字
r.Left = 0 '此四行是设置要显示文字的区域范围(即整个Picture1)
r.Top = 0
r.Right = Picture1.ScaleWidth 15
r.Bottom = Picture1.ScaleHeight 15
DrawText Picture1.hdc, s, -1, r, 0 '显示文字
nfont = SelectObject(Picture1.hdc, ofont) '把Picture1的字体恢复为原来的
DeleteObject nfont '删除新建的字体对象
End Sub
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As LOGFONT) As Long
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 DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const SYSTEM_FONT = 13
Private Const LF_FACESIZE = 32
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(1 To LF_FACESIZE) As Byte
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Command1_Click() '点击Command1运行
Dim ofont As Long, nfont As Long
Dim lf As LOGFONT, r As RECT
Dim s As String
ofont = SelectObject(Picture1.hdc, GetStockObject(SYSTEM_FONT)) '获取Picture1的当前字体对象
GetObject ofont, Len(lf), lf '从字体对象中获取字体信息
lf.lfHeight = lf.lfHeight * 3 '字体扩大三倍(你可以自己改其他的)
nfont = CreateFontIndirect(lf) '重新建立字体对象
ofont = SelectObject(Picture1.hdc, nfont) '替换Picture1中的字体对象
s = "123你好abc" '要显示的文字
r.Left = 0 '此四行是设置要显示文字的区域范围(即整个Picture1)
r.Top = 0
r.Right = Picture1.ScaleWidth 15
r.Bottom = Picture1.ScaleHeight 15
DrawText Picture1.hdc, s, -1, r, 0 '显示文字
nfont = SelectObject(Picture1.hdc, ofont) '把Picture1的字体恢复为原来的
DeleteObject nfont '删除新建的字体对象
End Sub
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯