Текстовый редактор

Option Explicit
 
' Декларации API...
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
 
' Константы...
Private Const LOGPIXELSY = 90
Private Const SPI_GETNONCLIENTMETRICS = 41
 
' Типы...
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 Enum FontElement
    CaptionFont = 0
    smCaptionFont = 1
    MenuFont = 2
    StatusFont = 3
    MessageFont = 4
End Enum
 
' Получить имя системного шрифта какого-то элемента
Public Function GetSystemFontName(Element As FontElement) As String
    Dim i As Long
    Dim ncm As NONCLIENTMETRICS
    Dim fontName As String
    
    ncm.cbSize = Len(ncm)
    SystemParametersInfo SPI_GETNONCLIENTMETRICS, 0, ncm, 0
    
    For i = 1 To 32
        Select Case Element
            Case CaptionFont
                fontName = fontName & Chr(ncm.lfCaptionFont.lfFaceName(i))
            Case smCaptionFont
                fontName = fontName & Chr(ncm.lfSMCaptionFont.lfFaceName(i))
            Case MenuFont
                fontName = fontName & Chr(ncm.lfMenuFont.lfFaceName(i))
            Case StatusFont
                fontName = fontName & Chr(ncm.lfStatusFont.lfFaceName(i))
            Case MessageFont
                fontName = fontName & Chr(ncm.lfMessageFont.lfFaceName(i))
        End Select
    Next i
    
    GetSystemFontName = Replace(fontName, Chr(0), vbNullString)
End Function
 
' Получить размер системного шрифта какого-то элемента
Public Function GetSystemFontSize(Element As FontElement) As Long
    Dim ncm As NONCLIENTMETRICS
    Dim hDC As Long
    
    ncm.cbSize = Len(ncm)
    SystemParametersInfo SPI_GETNONCLIENTMETRICS, 0, ncm, 0
    
    hDC = GetDC(GetDesktopWindow())
    
    Select Case Element
        Case CaptionFont
            GetSystemFontSize = -(ncm.lfCaptionFont.lfHeight * (72 / GetDeviceCaps(hDC, LOGPIXELSY)))
        Case smCaptionFont
            GetSystemFontSize = -(ncm.lfSMCaptionFont.lfHeight * (72 / GetDeviceCaps(hDC, LOGPIXELSY)))
        Case MenuFont
            GetSystemFontSize = -(ncm.lfMenuFont.lfHeight * (72 / GetDeviceCaps(hDC, LOGPIXELSY)))
        Case StatusFont
            GetSystemFontSize = -(ncm.lfStatusFont.lfHeight * (72 / GetDeviceCaps(hDC, LOGPIXELSY)))
        Case MessageFont
            GetSystemFontSize = -(ncm.lfMessageFont.lfHeight * (72 / GetDeviceCaps(hDC, LOGPIXELSY)))
    End Select
End Function
 
' Получить жирность системного шрифта какого-то элемента
Public Function IsSystemFontBold(Element As FontElement) As Boolean
    Dim ncm As NONCLIENTMETRICS
    
    ncm.cbSize = Len(ncm)
    SystemParametersInfo SPI_GETNONCLIENTMETRICS, 0, ncm, 0
    
    Select Case Element
        Case CaptionFont
            If ncm.lfCaptionFont.lfWeight = 700 Then IsSystemFontBold = True
        Case smCaptionFont
            If ncm.lfSMCaptionFont.lfWeight = 700 Then IsSystemFontBold = True
        Case MenuFont
            If ncm.lfMenuFont.lfWeight = 700 Then IsSystemFontBold = True
        Case StatusFont
            If ncm.lfStatusFont.lfWeight = 700 Then IsSystemFontBold = True
        Case MessageFont
            If ncm.lfMessageFont.lfWeight = 700 Then IsSystemFontBold = True
    End Select
End Function
 
 
Private Sub Form_Load()
    Label1.Font = GetSystemFontName(MessageFont)
    Label1.Caption = "Этот текст должен читаться правильно без всякого размытия"
End Sub

Private Sub Button_Click() 
        TextBox = "Привет"
    End Sub

Private Sub Button_Click() 
        TextBox. Text = "Привет"
    End Sub

Text1 = "qwerty"
    Text1.Text = "qwerty"