haquocquan > 18-11-10, 01:07 AM
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 SubSetSysFont ("Tahoma")restoreSysFont()phamthainguyen86 > 07-06-12, 11:33 PM