VB6在哪裏得到它的默認字體從

Question

VB6在哪裏得到它的默認字體從？

它是系統字體嗎？

它由語言環境決定嗎？

無論實際字體如何，它總是一樣大小嗎？

Answer 1

應用程序的字體設置在字體控件的屬性。 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自動將窗體的字體應用於該窗體上的每個對象。