VB6的默认字体从哪里获取？

Question

VB6的默认字体是从哪里获取的？

它是从系统字体获取的吗？

它是由区域设置确定的吗？

无论实际字体大小如何，它的大小是否始终相同？

- SirHowy

Answer 1

应用程序的字体在控件的 Font 属性中设置。VB6 默认使用大小为 8 的 MS Sans Serif 字体，这是 Windows 95/98 中的默认系统字体，并且该名称已经硬编码在 VB6 中。Windows XP 使用大小为 8 的 Tahoma 字体，而 Windows Vista 及更高版本使用大小为 9 的 Segoe UI 字体。因此，如果您需要所有表单和其他控件具有现代外观，请根据 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

对于其他字体操作，请参见此模块。

其他问题

这是否由语言环境决定？

不是的，但当Windows设置为不同的语言环境（例如德国Windows环境和捷克语环境）时，我遇到了特定于国家/地区的字符问题。我必须为所有控件强制使用代码页（请参见上面的代码）。

无论实际字体大小如何，它的大小是否始终相同？

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

- Roman Plischke

---

这些只是默认设置，用户可以更改它们，因此您的程序最好通过SystemParametersInfo（SPI_GETNONCLIENTMETRICS）调用来查询系统字体，而不是基于操作系统版本。而且不要忘记高DPI设置的影响！ - Bob77

@Bob77：是的，SystemParametersInfo 更精确一些。但更改系统字体并不是易事，并且仅涉及到数百万用户之一。此外，您无法测试它，因此最好缩小字体的选择范围。- 关于高 DPI：也许我错了，但我认为在 VB6 程序中不能考虑监视器的 DPI 参数。 - Roman Plischke

将字体设置为 MS Shell Dlg 也会获取系统字体，因为存在字体别名。 - Deanna

@Deana：MS Shell Dlg 使用 Microsoft Sans Serif_；_MS Shell Dlg 2 总是使用 _Tahoma_，两者都比 MS Sans Serif 好。但你永远不会以这种方式获得在 Windows Vista 及更高版本中作为默认字体的 _Segoe UI_。请参见 MSDN。 - Roman Plischke

不要依赖于Windows版本检测，因为应用兼容性shim可能会出于许多原因而被应用。用户确实可以相当轻松地更改系统字体：个性化，窗口颜色和外观，经典外观属性，高级。SystemParametersInfo（SPI_GETNONCLIENTMETRICS）是正确的方法，使用返回的lfMessageFont作为基本字体。 - Bob77

好的，@Bob77，我放弃了。我已经添加了第二个解决方案，使用SystemParametersInfo（带有一些警告）。 - Roman Plischke

Answer 2

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

如果VB6应用程序只使用默认字体，则会使用这些更大的字体。

- JonoIsTall

Answer 3

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

- John Hurley