Thay đổi Font tiếng việt cho Menu của Window home
Xuất xứ : www.pcworld.com.vn
Binh khí sử dụng : Không
Đoạn mã :
'Các hằng được dùng cho các hàm API
Private Const LF_FaceSize=32
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 LF_FaceSize) As Byte
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScoolHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
Const SPI_SetNonClientMetrics = 42
Const SPI_GettNonClientMetrics = 41
'Các hàm API cần thiết
'Hàm SystemParametersInfo sẽ gọi lại tất cả thông tin các tham số ngoài hệ thống. Nó còn có khả năng
cập nhật những thông tin do người dùng tự phát triển. Chính vì thế bạn dùng nó để thay đổi Font là rất
hợp lí
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 Const REF_StructureSize = 340 ` Sizeof( NONCLIENTMETRICS)
Private Const VNI_FontHeight = -13
Private Const VNI_FontWeight = 700
Private Const VNI_FontName = "VNI-Palatin"
Private Const VNI_FontLen = 11 `Len(VNI_FontName)
Private FontMetric As NONCLIENTMETRICS
Private OldFontMetric As NONCLIENTMETRICS
'Thủ tục này dùng để thay đổi Font của Menu
Private Sub ChangeFont()
Dim I As Integer
Dim VarGT As Long
Dim VarHeight As Long
Dim VarWeight As Long
Dim VarStr As String
FontMetric.cbSize = REG_StructureSize
VarGT = SystemParametersInfo(SPI_GetNonClientMetrics,REG_StructureSize, FontMetric, 0)
OldFontMetric =FontMetric
FontMetric.lfCaptionFont.lfHeight = VNI_FontHeight
FontMetric.lfCaptionFont.lfWeight = VNI_FontWeight
VarStr = VNI_FontName
For I=1 To LF_FaceSize
If I <= VNI_FontLen Then
FontMetric.lfCaptionFont.lfFaceName(I)= CByte(Asc(Mid(VarStr,I,1)))
FontMetric.lfMenuFont.lfFaceName(I)= CByte(Asc(Mid(VarStr,I,1)))
Else
FontMetric.lfCaptionFont.lfFaceName(I) = 0
FontMetric.lfMenuFont.lfFaceName(I) = 0
End If
Next I
VarGT= SystemParametersInfo
(SPI_SetNonClientMetrics, REG_StructureSize, FontMetric,0)
End Sub
'THủ tục để phục hồi lại font cho menu
Private Sub RestoreFont()
Dim VarGT As Long
VarGT= SystemParametersInfo (SPI_SetNonClientMetrics, REG_StructureSize, OldFontMetric,0)
End Sub
'Khi form được khởi tạo thì đổi Font
Private Sub Form_Load()
ChangeFont
End Sub
'Khi form thoát thì khởi tạo lại font mặc định cho hệ thống bước này quan trọng vì nếu bạn không phục
hồi lại font hệ thống thì các menu khác trong Window sẽ nhảy lộn xộn cả lên
Private Sub Form_UnLoad(Cancel As Integer)
RestoreFont
End
End Sub