VB.NET

Thay đổi phông chữ hệ thống

06/04/2013 17:08

Trên blog này có một bài viết về cách thay đổi phông chữ hệ thống bằng ứng dụng VB6. Ta sẽ làm điều tương tự với VB.NET.

Để ngâm cứu bài này, bạn tìm đọc (trên blog này) bài viết về cách đọc và thay đổi phông chữ hệ thống trên Windows bằng VB6. Tôi không nhắc lại chi tiết các vấn đề đã nêu trong bài viết đó, bài viết này minh họa cách làm trên VB.NET.

Trước hết, bạn tạo mới một ứng dụng VB.NET có kiểu WindowstemplateWindows Application. Trên formForm1 mặc định (xem minh họa thiết kế như hình 1), bạn thực hiện các việc sau đây:

· Vẽ một Label control có tên lblFontHienHanh dùng để hiển thị phông chữ hệ thống đang sử dụng cho trình đơn (menu). Trên hình 1, lblFontHienHanh được đặt dưới dòng Phông chữ hệ thống đang sử dụng:.

· Vẽ một ListBox control có tên lstFont dùng để hiển thị danh sách phông chữ đang có trong Windows. Trên hình 1, lstFont được đặt dưới dòng Phông chữ hệ thống có thể sử dụng:.

· Vẽ một CheckedListBox control có tên chklstThanhPhan. Click phải chuột vào control, chọn mục Edit Items để hiển thị hộp thoại String Collection Editor và gõ 4 dòng như trong hình 2. Danh sách này cho phép người sử dụng lựa chọn thành phần cần thay đổi phông chữ hiển thị.

· Vẽ một ComboBox control có tên cboCoChu cho phép người sử dụng lựa chọn cỡ chữ cần thay đổi cho phông chữ hiển thị.

· Vẽ 2 Button control lần lượt có tên cmdThayDoicmdKetThuc.

· Chọn mục Add Module… trên trình đơn Project để thêm mới một module có tên Module1.vb vào ứng dụng. Rồi gõ đoạn mã sau đây vào:

Imports System.Runtime.InteropServices

Imports System.Drawing

Module Module1

<StructLayout(LayoutKind.Sequential)> _

Public Class NonClientMetrics

Private StructureSize As Integer = Marshal.SizeOf(GetType(NonClientMetrics))

Public BorderWidth As Integer

Public ScrollWidth As Integer

Public ScrollHeight As Integer

Public CaptionWidth As Integer

Public CaptionHeight As Integer

<MarshalAs(UnmanagedType.Struct)> Private lfCaptionFont As LOGFONT

Public SmCaptionWidth As Integer

Public SmCaptionHeight As Integer

<MarshalAs(UnmanagedType.Struct)> Private lfSmCaptionFont As LOGFONT

Public MenuWidth As Integer

Public MenuHeight As Integer

<MarshalAs(UnmanagedType.Struct)> Private lfMenuFont As LOGFONT

<MarshalAs(UnmanagedType.Struct)> Private lfStatusFont As LOGFONT

<MarshalAs(UnmanagedType.Struct)> Private lfMessageFont As LOGFONT

Private Const SPI_GETNONCLIENTMETRICS As Integer = 41

Private Const SPI_SETNONCLIENTMETRICS As Integer = 42

Private Declare Auto Function SystemParametersInfo _

Lib "user32.dll" (ByVal Action As Integer, _

ByVal uiParam As Integer, <[In](), Out()> _

ByVal pvParam As NonClientMetrics, ByVal WinIni As _

Integer) As Boolean

Private Sub New()

End Sub

Public Shared Function CurrentMetrics() As _

NonClientMetrics

Dim NCM As New NonClientMetrics()

SystemParametersInfo(SPI_GETNONCLIENTMETRICS, _

NCM.StructureSize, NCM, 0)

Return (NCM)

End Function

Public Function Apply() As Boolean

Apply=SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _

StructureSize, Me, &H1 Or &H2)

End Function

Public Property CaptionFont() As Font

Get

Return (Font.FromLogFont(lfCaptionFont))

End Get

Set(ByVal value As Font)

value.ToLogFont(lfCaptionFont)

End Set

End Property

Public Property MenuFont() As Font

Get

Return (Font.FromLogFont(lfMenuFont))

End Get

Set(ByVal value As Font)

value.ToLogFont(lfMenuFont)

End Set

End Property

Public Property MessageFont() As Font

Get

Return (Font.FromLogFont(lfMessageFont))

End Get

Set(ByVal value As Font)

value.ToLogFont(lfMessageFont)

End Set

End Property

Public Property StatusFont() As Font

Get

Return (Font.FromLogFont(lfStatusFont))

End Get

Set(ByVal value As Font)

value.ToLogFont(lfStatusFont)

End Set

End Property

Public Property SmCaptionFont() As Font

Get

Return (Font.FromLogFont(lfSmCaptionFont))

End Get

Set(ByVal value As Font)

value.ToLogFont(lfSmCaptionFont)

End Set

End Property

End Class

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _

Public Class LOGFONT

Public lfHeight As Integer

Public lfWidth As Integer

Public lfEscapement As Integer

Public lfOrientation As Integer

Public lfWeight As Integer

Public lfItalic As Byte

Public lfUnderline As Byte

Public lfStrikeOut As Byte

Public lfCharSet As Byte

Public lfOutPrecision As Byte

Public lfClipPrecision As Byte

Public lfQuality As Byte

Public lfPitchAndFamily As Byte

<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _

Public lfFaceName As String

End Class

End Module

Lưu ý: Cấu trúc một số mã lệnh Visual Basic trong VB.NET đã có thay đổi (hoặc mới mẻ hơn) so với VB6. Cho nên bạn cần gõ chính xác đoạn mã nêu trên. Nội dung module này là mô tả một lớp có tên NonClientMetrics, và một cấu trúc phông chữ LOGFONT. Trong đó, hàm CurrentMetrics() dùng để đọc chi tiết phông chữ hệ thống hiện hành, còn hàm Apply() dùng để cập nhật các thay đổi lên phông chữ hệ thống hiện hành.

Trong phần Declarations của form, gõ đoạn mã sau đây vào:

Public Class Form1

Dim CurrentNonClientMetrics As NonClientMetrics = _

NonClientMetrics.CurrentMetrics()

Dim NewNonClientMetrics As NonClientMetrics = _

NonClientMetrics.CurrentMetrics()

End Class

Trong đó, CurrentNonClientMetrics dùng để lưu cấu trúc phông chữ hệ thống hiện hành, còn NewNonClientMetrics dùng để lưu cấu trúc phông chữ sẽ dùng để thay đổi phông chữ hệ thống hiện hành.

Trong thủ tục xử lý tình huống Form_Load sau đây, thuộc tính SizeInPoints (cỡ chữ được sử dụng trong hộp thoại Advanced Appearance thuộc ứng dụng Display của Control Panel) được sử dụng chứ không phải thuộc tính Size (cỡ chữ tính từ cấu trúc lưu trữ NonClientMetrics):

Private Sub Form1_Load(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles MyBase.Load

' Danh sách cỡ chữ: từ 6 đến 24

Dim I As Byte

For I = 6 To 24

cboCoChu.Items.Add(I)

Next

cboCoChu.SelectedIndex = _

CurrentNonClientMetrics.MenuFont.SizeInPoints - 6

lblFontHienHanh.Text = _

CurrentNonClientMetrics.MenuFont.Name

For I = 0 To chklstThanhPhan.Items.Count - 1

chklstThanhPhan.SetItemCheckState(I, _

CheckState.Checked)

Next

' Danh sách phông chữ hiện hành

' ít phông chữ hơn Screen.Fonts trong VB6

Dim fFontDangCo As FontFamily

For Each fFontDangCo In FontFamily.Families

lstFont.Items.Add(fFontDangCo.Name)

Next fFontDangCo

lstFont.SelectedIndex = 0

End Sub

Lưu ý: Không hiểu sao danh sách phông chữ thuộc lớp FontFamily của VB.NET luôn ít hơn khi sử dụng lớp Screen.Fonts trong VB6. Điều này chắc chỉ có Microsoft mới giải thích được.

Sau cùng, bạn gõ đoạn mã cho các thủ tục xử lý tình huống cmdKetThuc_ClickcmdThayDoi_Click như dưới đây:

Private Sub cmdKetThuc_Click(ByVal sender As _

System.Object, ByVal e As System.EventArgs) _

Handles cmdKetThuc.Click

End

End Sub

Private Sub cmdThayDoi_Click(ByVal sender As _

System.Object, ByVal e As System.EventArgs) _

Handles cmdThayDoi.Click

Dim lCoThayDoi As Boolean, chkMucChon As Object

lCoThayDoi = False

For Each chkMucChon In chklstThanhPhan.CheckedItems

lCoThayDoi = True ' Có chọn

Next

If Not lCoThayDoi Then

MessageBox.Show("Chưa chọn mục cần thay đổi phông [" & _

lstFont.Text & "]!", Me.Text, MessageBoxButtons.OK, _

MessageBoxIcon.Exclamation)

Exit Sub

End If

For Each chkMucChon In chklstThanhPhan.CheckedItems

Select Case chkMucChon.ToString

Case "Tiêu đề cửa sổ"

NewNonClientMetrics.CaptionFont = _

New Font(lstFont.Text, Val(cboCoChu.Text))

Case "Mơ-nu"

NewNonClientMetrics.MenuFont = _

New Font(lstFont.Text, Val(cboCoChu.Text))

Case "Chú thích"

NewNonClientMetrics.StatusFont = _

New Font(lstFont.Text, Val(cboCoChu.Text))

Case "Thông báo"

NewNonClientMetrics.MessageFont = _

New Font(lstFont.Text, Val(cboCoChu.Text))

End Select

Next

If NewNonClientMetrics.Apply() Then

MessageBox.Show("Đã thay đổi phông chữ!", Me.Text, _

MessageBoxButtons.OK, MessageBoxIcon.Information)

Else

MessageBox.Show("Chưa thay đổi phông chữ được!", _

Me.Text, MessageBoxButtons.OK, _

MessageBoxIcon.Warning)

End If

End Sub

Bây giờ, bạn có thể nhấn F5 để chạy thử chương trình.

CHƯƠNG CAN CHÍP
Ý kiến bạn đọc (0)
Tên   Email

Lên đầu trang