The font for the application is set in the Font property of the control. VB6 has MS Sans Serif (size 8) by default, which was the default system font in Windows 95/98, and this name is hardcoded in VB6. Windows XP uses Tahoma 8, Windows Vista and higher. The interface of Segoe 9. So, if you need a modern look of all forms and other controls, replace the font in accordance with the version of Windows. It would be difficult to detect it, so this subtitles the first existing font from the 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 system font name
This code is similar, but reads the name and font size of the system through the API (thanks, Bob77). Well - that's for sure, but it has some disadvantages:
- You cannot check all the crazy settings of crazy users. For some font sizes, your program may not be available.
- It gets the name and font size for the message (MsgBox Window in VB6), but the user may have different fonts for other texts (menu, signature ...), however the default size is the same.
- The user can install a system font that does not support your language.
- This can lead to an incorrect font size, except for the 72 DPI device (see the fontSize variable) - it must be fixed.
the 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 manipulations see this module .
Other questions
Is it determined by language?
No, but I had problems with national characters when in the Windows settings there was a different locale and environment language (German Windows environment and Czech language). I had to create a code page for all the controls (see Code above).
Is it always the same size regardless of the actual font?
The font size changes accordingly if you change the font size in a Windows environment. I highly recommend: test your application for all combinations - fonts from the MODERN_FONTS_CSV constant and Windows text size of 100-150%.