Where does VB6 get its default font from

问题

Where does VB6 get its default font from?

Is it the system font?

Is it determined by locale?

Is it always the same size irrespective of the actual font?

回答1:

Font for application is set in the Font property of a control. VB6 has as default MS Sans Serif (size 8), which was default system font in Windows 95/98 and this name is hard-coded in VB6. Windows XP uses Tahoma 8, Windows Vista and higher Segoe UI 9. So if you need a modern look of all forms and other controls, change font according the Windows version. It would be difficult to detect it, so this sub takes the first existing font from list:

'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

Solution 2 - get the name of system font

This code is similar, but reads the system font name and size via API (thanks, Bob77). Well - it is exact, but has some disadvantages:

You cannot test all crazy settings of crazy users. For some font sizes may be your program unusable.
It gets font name and size set for message (MsgBox Window in VB6), but user may have different fonts for other texts (menu, caption...), however default size is the same.
User may have set system font, which doesn't support your language.
It may get wrong font size for other than 72 DPI device (see fontSize variable) - it should be fixed.

Code:

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

For other font manipulation see this module.

Other questions

Is it determined by locale?

No, but I had troubles with national-specific characters, when in Windows setting was different locale and language of environment (German Windows environment and Czech locale). I had to force codepage for all controls (see code above).

Is it always the same size irrespective of the actual font?

The text size changes in proper way, if you change font size in Windows environment. I strongly recommend: test your application for all combinations - fonts from MODERN_FONTS_CSV constant and Windows text size 100-150%.

回答2:

Windows 7 Laptops can get installed with 125% larger fonts. Here's a great article and a fix: http://www.rlvision.com/misc/windows_7_font_bug.asp

VB6 Apps will pick up these larger fonts if they are just using the default fonts.

回答3:

Many font setting issues in VB6 can be solved by changing the font in your forms. VB6 applies a form's font automatically to every object on that form.

来源：https://stackoverflow.com/questions/25620114/where-does-vb6-get-its-default-font-from

标签

fonts

vb6

default