Question

VB6从哪里获取默认字体？

是系统字体吗？

是否由区域设置决定？

无论实际字体如何，它总是一样大小吗？

Answer 1

应用程序的字体在控件的 Font 属性中设置。 VB6默认为 MS Sans Serif （大小为8），这是Windows 95/98中的默认系统字体，此名称在VB6中是硬编码的。 Windows XP使用 Tahoma 8，Windows Vista及更高版本 Segoe UI 9.因此，如果您需要所有表单和其他控件的现代外观，请根据Windows版本更改字体。检测它很困难，所以这个子从列表中获取第一个现有的字体：

'fonts and sizes
Const MODERN_FONTS_CSV = "Segoe UI/9,Tahoma/8,MS Sans Serif/8"

Sub ChangeFont(oFrm As VB.Form)
  Dim i As Long
  Dim mf() As String
  Dim fontSize As Long
  Dim fontName As String
  Dim oCtrl As VB.Control
  Dim oFont As New stdole.StdFont

  mf = Split(MODERN_FONTS_CSV, ",") 'list of fonts and sizes as CSV
  'trying if the font exists
  i = 0
  Do
    fontName = Split(mf(i), "/")(0)
    fontSize = CLng(Split(mf(i), "/")(1))
    oFont.Name = Trim(fontName) 'does the font exist?
    i = i + 1
  'font exists or end of the list (last name is the default whether exists or not)
  Loop Until StrComp(fontName, oFont.Name, vbTextCompare) = 0 Or i > UBound(mf) 

  'at first change font in the form
  With oFrm.Font
    .Name = fontName 'name
    .size = fontSize 'size
    '.charset = 238 - you can set charset, in some cases it could be necessary
  End With
  'loop through all controls in the form
  'some controls doesn't have font property (timer, toolbar) - ignore error
  On Error Resume Next
  For Each oCtrl In oFrm.Controls
    With oCtrl.Font
      .Name = fontName 'name
      .size = fontSize 'size
      '.charset = 238 - charset, if you want
      Err.Clear
    End With
  Next
  On Error GoTo 0

End Sub

解决方案2 - 获取系统字体的名称

此代码类似，但通过API读取系统字体名称和大小（感谢Bob77）。嗯 - 这是确切的，但有一些缺点：

您无法测试疯狂用户的所有疯狂设置。对于某些字体大小，您的程序可能无法使用。
获取消息的字体名称和大小（VB6中的MsgBox窗口），但用户可能有其他文本的不同字体（菜单，标题...），但默认大小相同。
用户可能设置了系统字体，但不支持您的语言。
72 DPI设备以外的字体大小可能会错误（请参阅 fontSize 变量） - 它应该是固定的。

代码：

Option Explicit

Declare Function SystemParametersInfo Lib "USER32.DLL" _
  Alias "SystemParametersInfoA" (ByVal uAction As Long, _
  ByVal uiParam As Long, pvParam As Any, _
  ByVal fWinIni As Long) As Long

Private Const LOGPIXELSY = 90
Private Const SPI_GETNONCLIENTMETRICS = 41

Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex 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(1 To 32) As Byte
End Type

Private Type NONCLIENTMETRICS
  cbSize As Long
  iBorderWidth As Long
  iScrollWidth As Long
  iScrollHeight As Long
  iCaptionWidth As Long
  iCaptionHeight As Long
  lfCaptionFont As LOGFONT
  iSMCaptionWidth As Long
  iSMCaptionHeight As Long
  lfSMCaptionFont As LOGFONT
  iMenuWidth As Long
  iMenuHeight As Long
  lfMenuFont As LOGFONT
  lfStatusFont As LOGFONT
  lfMessageFont As LOGFONT
End Type


Public Sub ChangeFont(oFrm As VB.Form)
  Dim i As Long
  Dim ncm As NONCLIENTMETRICS
  Dim fontSize As Long
  Dim fontName As String
  Dim oCtrl As VB.Control
  Dim oFont As New stdole.StdFont

  'get font properties
  ncm.cbSize = Len(ncm)
  SystemParametersInfo SPI_GETNONCLIENTMETRICS, 0, ncm, 0
  For i = 1 To 32
    fontName = fontName & Chr(ncm.lfMessageFont.lfFaceName(i))
  Next i

  'name
  fontName = Replace(fontName, Chr(0), "") 'trim
  'size
  fontSize = -(ncm.lfMessageFont.lfHeight * (72 / GetDeviceCaps(oFrm.hDC, LOGPIXELSY)))

  'at first change font in the form
  With oFrm.Font
    .Name = fontName 'name
    .Size = fontSize 'size
    '.charset = 238 - you can set charset, in some cases it could be necessary
  End With
  'loop through all controls in the form
  'some controls doesn't have font property (timer, toolbar) - ignore error
  On Error Resume Next
  For Each oCtrl In oFrm.Controls
    With oCtrl.Font
      .Name = fontName 'name
      .Size = fontSize 'size
      '.charset = 238 - charset, if you want
      Err.Clear
    End With
  Next
  On Error GoTo 0
End Sub

对于其他字体操作，请参阅this module。

其他问题

是否由区域设置决定？

不，但是当我在Windows环境中使用不同的语言环境和环境语言（德语Windows环境和捷克语语言环境）时，我遇到了国家特定字符的问题。我不得不强制所有控件的代码页（参见上面的代码）。

无论实际字体如何，它总是一样大小吗？

如果在Windows环境中更改字体大小，文本大小会以适当的方式更改。我强烈建议：测试所有组合的应用程序 - MODERN_FONTS_CSV常量和Windows文本大小100-150％的字体。

Answer 2

Windows 7笔记本电脑可以安装125％更大的字体。这是一篇很棒的文章和修正： http://www.rlvision.com/misc/windows_7_font_bug.asp

如果VB6应用程序只使用默认字体，它们将获取这些较大的字体。

Answer 3

VB6中的许多字体设置问题可以通过更改表单中的字体来解决。 VB6自动将表单的字体应用于该表单上的每个对象。

VB6从哪里获取其默认字体

3 个答案: