• Trang chủ click to expand contents 

  • Set mặc định fonts cho hệ thống

  • Set mặc định fonts cho hệ thống

    haquocquan > 18-11-10, 01:07 AM

    Copy đoạn code sau vào một module:

    Mã:
    Option Compare Database

    'Khai bao cac hang
    Const SPI_GETNONCLIENTMETRICS = 41
    Const SPI_SETNONCLIENTMETRICS = 42
    Const SPI_GETICONTITLELOGFONT = 31
    Const SPI_SETICONTITLELOGFONT = 34
    Const LF_FACESIZE = 32
    'Khai bao cac kieu
    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 As String * 32
    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
    'Khai bao cac bieb thuoc kieu tren
    Dim m_nonClientMetrics As NONCLIENTMETRICS
    Dim m_logFont As LOGFONT
    'Khai bao cac bien chua so do font
    Dim m_fontCaption As String * 32
    Dim m_fontSmCaption As String * 32
    Dim m_fontMenu As String * 32
    Dim m_fontMessage As String * 32
    Dim m_fontStatus As String * 32
    Dim m_fontIcon As String * 32
    Dim m_fontHeight As Long, m_fontWeight As Long
    'Khai bao ham API can dung
    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

    'Thu tuc thiet lap so do font he thong
    Public Function SetSysFont(fontName As String)
    Dim result As Long

    '*****************************
    'Truy xuat so do font hien tai
    m_nonClientMetrics.cbSize = Len(m_nonClientMetrics)
    result = SystemParametersInfo(SPI_GETNONCLIENTMETRICS, _
    Len(m_nonClientMetrics), _
    m_nonClientMetrics, 0)
    result = SystemParametersInfo(SPI_GETICONTITLELOGFONT, _
    Len(m_logFont), _
    m_logFont, 0)

    '**********************************
    'Luu lai cac font he thong hien tai
    'Luu lai font hien thi Caption
    m_fontCaption = m_nonClientMetrics.lfCaptionFont.lfFaceName
    m_fontHeight = m_nonClientMetrics.lfCaptionFont.lfHeight
    m_fontWeight = m_nonClientMetrics.lfCaptionFont.lfWeight
    'Luu lai font hien thi Caption nho
    m_fontSmCaption = m_nonClientMetrics.lfSMCaptionFont.lfFaceName
    'Luu lai font hien thi hop thoai thong bao
    m_fontMessage = m_nonClientMetrics.lfMessageFont.lfFaceName
    'Luu lai font Menu
    m_fontMenu = m_nonClientMetrics.lfMenuFont.lfFaceName
    '************************************
    'Thay doi font
    'font hien thi Caption
    m_nonClientMetrics.lfCaptionFont.lfFaceName = fontName & vbNullChar
    m_nonClientMetrics.lfCaptionFont.lfWeight = 700
    m_nonClientMetrics.lfCaptionFont.lfHeight = -12
    'font hien thi Caption nho
    m_nonClientMetrics.lfSMCaptionFont.lfFaceName = fontName & vbNullChar
    m_nonClientMetrics.lfSMCaptionFont.lfHeight = -12
    'font hien thi hop thoai thong bao
    m_nonClientMetrics.lfMessageFont.lfFaceName = fontName & vbNullChar
    m_nonClientMetrics.lfMessageFont.lfHeight = -12
    'font hien thi menu
    m_nonClientMetrics.lfMenuFont.lfFaceName = fontName & vbNullChar
    m_nonClientMetrics.lfMenuFont.lfHeight = -12
    'thuc hien thay doi
    result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
    Len(m_nonClientMetrics), _
    m_nonClientMetrics, 0)
    result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
    Len(m_logFont), _
    m_logFont, 0)
    End Function

    'Thu tuc thiet lap lai so do font cu
    Public Sub restoreSysFont()
    'font hien thi Caption
    m_nonClientMetrics.lfCaptionFont.lfFaceName = m_fontCaption
    m_nonClientMetrics.lfCaptionFont.lfHeight = m_fontHeight
    m_nonClientMetrics.lfCaptionFont.lfWeight = m_fontWeight
    'font hien thi Caption nho
    m_nonClientMetrics.lfSMCaptionFont.lfFaceName = m_fontSmCaption
    m_nonClientMetrics.lfSMCaptionFont.lfHeight = m_fontHeight
    'font hien thi hop thoai thong bao
    m_nonClientMetrics.lfMessageFont.lfFaceName = m_fontMessage
    m_nonClientMetrics.lfMessageFont.lfHeight = m_fontHeight
    'font hien thi menu
    m_nonClientMetrics.lfMenuFont.lfFaceName = m_fontMenu
    m_nonClientMetrics.lfMenuFont.lfHeight = m_fontHeight
    'thuc hien thay doi
    result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
    Len(m_nonClientMetrics), _
    m_nonClientMetrics, 0)
    result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
    Len(m_logFont), _
    m_logFont, 0)
    End Sub

    Khi cần Set fonts cho hệ thống, gọi: (ví dụ font TAHOMA)
    Mã:
    SetSysFont ("Tahoma")

    Khôi phục lại font ban đầu, gọi:
    Mã:
    restoreSysFont()

    Nguồn: sưu tầm

  • RE: Set mặc định fonts cho hệ thống

    phamthainguyen86 > 07-06-12, 11:33 PM