vb 2010如何设置更改字体和样式代码?

vb 2010如何设置更改字体和样式代码?,第1张

vbnet和vb6的写法不一样 可以用以下代码来设置字体样式和颜色


TextBox1Font = New Font("Arial", 16, FontStyleBold) 'Arial字体,大小:16,粗体
'TextBox1Font = New Font("Arial", 16, FontStyleItalic) 'Arial字体,大小:16,斜体
'TextBox1Font = New Font("Arial", 16, FontStyleRegular) 'Arial字体,大小:16,正常
'TextBox1Font = New Font("Arial", 16, FontStyleStrikeout) 'Arial字体,大小:16,删除线
'TextBox1Font = New Font("Arial", 16, FontStyleUnderline) 'Arial字体,大小:16,下划线
TextBox1ForeColor = ColorRed '前景色

楼主您好!

可以用这种方法试试,代码如下:

Option Explicit
Private Sub Combo1_Click()
    MeCombo1FontName = MeCombo1Text
End Sub
Private Sub Form_Load()
    MeCombo1AddItem "宋体"
    MeCombo1AddItem "新宋体"
    MeCombo1AddItem "隶书"
    MeCombo1AddItem "幼圆"
End Sub

'结束按钮
Private Sub Cmdend_Click()
End
End Sub
'确定按钮
Private Sub Cmdok_Click()
If ChksizeValue = 1 Then
TxtshowFontSize = 32
Else
End If
If ChkfontValue = 1 Then
TxtshowFontName = "隶书"
End If
If ChkstyleValue = 1 Then
TxtshowFontUnderline = True
Else
TxtshowFontUnderline = False
End If
End Sub
以此类推

建个工程, 在窗体里放个TextBox 控件, 复制代码试试Option Explicit
Private Declare Function CHOOSEFONT Lib "comdlg32dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
Private Const LF_FACESIZE = 32
Private Enum CF_
CF_APPLY = &H200&
CF_ANSIONLY = &H400&
CF_TTONLY = &H40000
CF_ENABLEHOOK = &H8&
CF_ENABLETEMPLATE = &H10&
CF_ENABLETEMPLATEHANDLE = &H20&
CF_FIXEDPITCHONLY = &H4000&
CF_NOVECTORFONTS = &H800&
CF_NOOEMFONTS = CF_NOVECTORFONTS
CF_NOFACESEL = &H80000
CF_NOSCRIPTSEL = &H800000
CF_NOSTYLESEL = &H100000
CF_NOSIZESEL = &H200000
CF_NOSIMULATIONS = &H1000&
CF_NOVERTFONTS = &H1000000
CF_SCALABLEONLY = &H20000
CF_SCRIPTSONLY = CF_ANSIONLY
CF_SELECTSCRIPT = &H400000
CF_SHOWHELP = &H4&
CF_USESTYLE = &H80&
CF_WYSIWYG = &H8000 ' must also have CF_SCREENFONTS CF_PRINTERFONTS
CF_FORCEFONTEXIST = &H10000
CF_INITTOLOGFONTSTRUCT = &H40&
CF_SCREENFONTS = &H1 '显示屏幕字体
CF_PRINTERFONTS = &H2 '显示打印机字体
CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) '两者都显示
CF_EFFECTS = &H100& '添加字体效果
CF_LIMITSIZE = &H2000& '设置字体大小限制
End Enum
Private Type CHOOSEFONT
lStructSize As Long
hwndOwner As Long ' caller's window handle
hdc As Long ' printer DC/IC or NULL
lpLogFont As Long 'LogFont结构地址
iPointSize As Long ' 10 size in points of selected font
flags As CF_ ' enum type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn
lpfnHook As Long ' ptr to hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle ofEXE that
' contains cust dlg template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the EnumFonts
' call back with the extra FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
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 LF_FACESIZE '字体名称
End TypePrivate Sub Text1_Click()
Dim CF As CHOOSEFONT, LF As LOGFONT
With LF
lfFaceName = StrConv(Text1FontName, vbFromUnicode) & vbNullChar '初始化字体名称,需要从Unicode转换,须以空字符结尾
lfItalic = Text1FontItalic '初始化是否有斜体
lfStrikeOut = Text1FontStrikethru '初始化是否有删除线
lfUnderline = Text1FontUnderline '初始化是否有下划线
lfWeight = Text1FontWeight '初始化字体大小
lfCharSet = Text1FontCharset '初始化字符集
lfHeight = -MulDiv(Text1FontSize, GetDeviceCaps(hdc, LOGPIXELSY), 72) '把字体转换为lfHeight,用到公式
End With
With CF
rgbColors = Text1ForeColor '初始化字体颜色
lStructSize = Len(CF)
hwndOwner = hWnd
hInstance = ApphInstance
flags = CF_BOTH Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_EFFECTS Or CF_LIMITSIZE
lpLogFont = VarPtr(LF) '设置为定义好的LogFont结构地址
nSizeMin = 8 '最小字体大小
nSizeMax = 72 '最大字体大小
End With
If CHOOSEFONT(CF) = 0 Then Exit Sub '如果按“取消”则退出过程
With Text1
FontName = StrConv(LFlfFaceName, vbUnicode) '设置字体名称
FontItalic = LFlfItalic '设置是否斜体
FontStrikethru = LFlfStrikeOut '设置是否删除线
FontUnderline = LFlfUnderline '设置是否下划线
FontWeight = LFlfWeight '设置是否粗体
FontCharset = LFlfCharSet '设置字符集
FontSize = -LFlfHeight - ((-LFlfHeight) / 4) - IIf(-LFlfHeight Mod 4 > 1, 1, 0) '设置字体大小,lfHeight与字号得转换需要用到公式
ForeColor = CFrgbColors '设置字体颜色
End With
End Sub

这需要使用控件的扩展,一般在VC上比较好实现,在VB上就比较难了,关注中。
具体的可参考我的编程笔记:
VC/MFC CListCtrl如何高亮选中一行、单行、双行及完成状态 自绘控件
>

欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/yw/12935250.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-29
下一篇 2023-05-29

发表评论

登录后才能评论

评论列表(0条)

保存