VB6从哪里得到它的默认字体 [英] Where does VB6 get its default font from

问题描述

VB6从哪里获得默认字体？

是系统字体吗？

是否由locale决定？

不管实际的字体大小是不是一样的大小？

解决方案

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

pre $字体和大小
常量MODERN_FONTS_CSV =Segoe UI / 9，Tahoma / 8，MS Sans Serif / 8
$ b $ 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，，）'字体和大小列表为CSV
'尝试字体是否存在
i = 0

fontName = Split（mf（i ）/）（0）
fontSize = CLng（Split（mf（i），/）（1））
oFont.Name = Trim（fontName）'字体是否存在？
i = i + 1
'字体存在或列表结束（姓氏是默认值，不管是否存在）
循环直到StrComp（fontName，oFont.Name，vbTextCompare）= 0我> UBound（mf）

'首先更改字体形式
使用oFrm.Font
.Name = fontName'名称
.size = fontSize'size
'.charset = 238 - 你可以设置字符集，在某些情况下可能需要
End With
'通过
形式的所有控件循环一些控件没有字体属性（定时器，工具栏） - 忽略错误
在错误恢复下一个
对于每个oCtrl在oFrm.Controls
与oCtrl.Font
.Name = fontName'名称
.size = fontSize'size $ b $ .charset = 238 - charset，如果你想
Err.Clear
结束
下一个
出错转到0

结束Sub

解决方案2 - 获取系统字体的名称<这个代码是相似的，但通过API读取系统字体名称和大小（谢谢，Bob77）。嗯 - 确切的说，但有一些缺点：$ b​​
$ b

• 你不能测试疯狂用户的所有疯狂设置。
  
• 它为消息（VB6中的MsgBox窗口）设置字体名称和大小，但是用户可能为其他文本（菜单，标题...），但默认大小是相同的。


• 用户可能已经设置了系统字体，不支持您的语言。可能会得到错误的字体大小为72 DPI设备（见 变量） - 它应该是固定的。

<代码：
$ b $ pre $ code $ Option $ Exp

Declare Function SystemParametersInfo LibUSER32.DLL_
AliasSystemParametersInfoA（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 Libgdi32.dll（ByVal hDC As Long，ByVal nIndex As Long）As Long

Private输入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
结束类型

私有类型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作为LOGFONT
lfStatusFont作为LOGFONT
lfMessageFont作为LOGFONT
结束类型


Public Sub ChangeFont（oFrm As VB.Form）
Dim i As Long
Dim ncm As NONCLIENTMETRICS
Dim fontSiz e 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））
下一个我

'名称
fontName =替换（fontName，Chr（0），）'trim
'size
fontSize = - （ncm.lfMessageFont.lfHeight *（72 / GetDeviceCaps（oFrm.hDC，LOGPIXELSY）））

'首先改变字体形式
使用oFrm.Font
.Name = fontName'名称
.Size = fontSize'size $ b $ .charset = 238 - 您可以设置字符集，在某些情况下可能需要
以
'循环通过所有控件的形式
'一些控件没有字体属性（定时器，工具栏） - 忽略错误
对错误恢复下一个
对于每个oCtrl在oFrm.Controls
使用oCtrl.Font
.Name = fontName'名称
.Size = fontSize'size $ b $ .charset = 238 - charset，如果你想
Err.Clear
End With
Next
On Error GoTo 0
End Sub

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

其他问题

是否由语言环境决定？

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

无论实际的字体大小是否一样？

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

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?

解决方案

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%.

这篇关于VB6从哪里得到它的默认字体的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！