[VB.NET] การรีจีสทรี้ฟอนต์ให้กับตัวโปรแกรม เพื่อนำฟอนต์ที่เรากำหนดไปใช้งานกับเครื่องอื่น

thongkorn

จากตอนที่แล้วในการนำฟอนต์พิเศษไปใช้งานกับเครื่องอื่น จะเป็นการกำหนดฟอนต์ให้กับ Control ต่างๆด้วยวิธีการเขียนโค้ด วิธีนี้ง่ายแต่ไม่สะดวกมากนัก ในกรณที่เรามี Control ต่างๆเยอะแยะมากมาย ดังนั้นจึงใช้วิธีการแก้ปัญหาด้วยการทำ Registry ให้กับฟอนต์แทน แต่แอดมินไม่ได้ใช้วิธีการคัดลอกฟอนต์ไปเก็บที่ %WinDir%\Fonts  แล้วทำการรีจิสทรี้เหมือนคนอื่นๆเขา แต่จะใช้จุดตำแหน่งที่โปรแกรมของเราอยู่นั่นแหละเป็นที่เก็บฟอนต์ และทำการรีจิสทรี้ฟอนต์จาก ณ จุดนั้น เพื่อป้องกันปัญหา Access Denied ของตัว Windows เอง ... อนึ่ง!!! ในการทำรีจีสทรี้ฟอนต์ แอดมินเลือกการใช้ Win32 API (Application Programming Interface) ครั้นพอเราจบทำงานของโปรแกรม ก็จะสั่งให้ลบ Value ของฟอนต์รีจีสทรี้ออกไป เพื่อให้มิตรรักแฟนคลับภาษาเบสิคได้ศึกษาการเพิ่ม/ลบค่าในรีจีสทรี้ครับผม ...

การปรับโปรแกรมของเราให้ทำงานแบบโหมด Administrator ...


ดูจาก RegEdit เมื่อฟอนต์ถูกสั่งให้รีจีสทรี้ และจะหายไปเมื่อปิดโปรแกรม ...


มาดูโค้ดฉบับเต็มกันเถอะ ...

1. Imports System.Runtime.InteropServices
   
2. Imports Microsoft.Win32
   
3. 
   
4. Public Class frmRegistryFont
   
5.     <DllImport("gdi32")> _
   
6.     Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
   
7.     End Function
   
8. 
   
9.     <DllImport("user32.dll")> _
   
10.     Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    
11.     End Function
    
12. 
    
13.     <DllImport("kernel32.dll", SetLastError:=True)> _
    
14.     Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
    
15.     End Function
    
16. 
    
17.     ' / --------------------------------------------------------------------
    
18.     ' / Registry Font with API32 (Application Programming Interface).
    
19.     Private Sub frmRegistryFont_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    
20.         Me.TextBox1.Text = "ทดสอบการใช้งานฟอนต์แบบการรีจิสทรี้วินโดส์ว"
    
21.         Try
    
22.             '// Check Font exist.
    
23.             If My.Computer.FileSystem.FileExists(Environment.GetEnvironmentVariable("windir") & "\fonts\Kanit-regular.ttf") Then
    
24.                 MessageBox.Show("Font already exist.")
    
25.             Else
    
26.                 MessageBox.Show("Font not found.")
    
27.                 '// Set Administrator
    
28.                 Dim oRegKey As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\AppCompatFlags\\Layers", True)
    
29.                 oRegKey.SetValue("RegistryFont.Exe", "~ RUNASADMIN")
    
30.                 oRegKey.Close()
    
31.                 '// Use API (Application Programming Interface).
    
32.                 Dim Ret As Integer
    
33.                 Dim Res As Integer
    
34.                 Dim FontPath As String = MyPath(Application.StartupPath) & "Kanit-regular.ttf"
    
35.                 '// ระมัดระวังในการตั้งชื่อฟอนต์ อย่าให้ไปซ้ำกับที่มีอยู่ในระบบ
    
36.                 Dim FontName As String = "Kanit (TrueType)"
    
37.                 Const WM_FONTCHANGE As Integer = &H1D
    
38.                 Const HWND_BROADCAST As Integer = &HFFFF
    
39.                 Ret = AddFontResource(FontPath)
    
40.                 Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
    
41.                 Ret = WriteProfileString("fonts", FontName, FontPath)
    
42.             End If
    
43.         Catch ex As Exception
    
44.             MessageBox.Show(ex.Message)
    
45.         End Try
    
46.     End Sub
    
47. 
    
48.     ' / --------------------------------------------------------------------
    
49.     '// Before finishing the program, delete the value.
    
50.     Private Sub frmRegistryFont_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
    
51.         Dim FontName As String = "Kanit (TrueType)"
    
52.         If My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", "Kanit (TrueType)", Nothing) Is Nothing Then
    
53.             MsgBox(FontName & "  does not exist.")
    
54.         Else
    
55.             MsgBox(FontName & " exist.")
    
56.             Dim rk As RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", True)
    
57.             If rk IsNot Nothing Then
    
58.                 rk.DeleteValue(FontName)
    
59.                 rk.Close()
    
60.             End If
    
61.         End If
    
62.     End Sub
    
63. 
    
64.     Private Sub btnLoad_Click(sender As System.Object, e As System.EventArgs) Handles btnLoad.Click
    
65.         Call InitializeGrid()
    
66.         Call FillData()
    
67.     End Sub
    
68. 
    
69.     ' / --------------------------------------------------------------------
    
70.     Private Sub FillData()
    
71.         Dim dt As New DataTable
    
72.         dt.Columns.Add("ID")
    
73.         dt.Columns.Add("Name")
    
74.         dt.Columns.Add("PositionName")
    
75.         dt.Columns.Add("Salary")
    
76.         dt.Columns.Add("HireDate")
    
77.         dt.Rows.Add("00001", "นายทองก้อน ทับทิมกรอบ", "Managing Director", "99,999.99", "01/01/2562")
    
78.         dt.Rows.Add("00002", "นายบุญห่อ พ่อรวย", "Labour", "15,000.00", "01/06/2562")
    
79.         dt.Rows.Add("00003", "นางสาวคำหล้า น่ารัก", "Secretary", "19,999.50", "13/02/2562")
    
80.         dt.Rows.Add("00004", "นางบัวผัน ทันใจ", "House Keeper", "9,000.99", "24/01/2562")
    
81.         DataGridView1.DataSource = dt
    
82.     End Sub
    
83. 
    
84.     ' / --------------------------------------------------------------------
    
85.     '// การตั้งค่าเริ่มต้นให้กับตารางกริดในแบบ @Run Time
    
86.     Private Sub InitializeGrid()
    
87.         With DataGridView1
    
88.             .RowHeadersVisible = False
    
89.             .AllowUserToAddRows = False
    
90.             .AllowUserToDeleteRows = False
    
91.             .AllowUserToResizeRows = False
    
92.             .MultiSelect = False
    
93.             .SelectionMode = DataGridViewSelectionMode.FullRowSelect
    
94.             .ReadOnly = True
    
95.             .RowTemplate.MinimumHeight = 30
    
96.             .RowTemplate.Height = 30
    
97.             .Font = New Font("Kanit", 10, FontStyle.Regular)
    
98.             '/ จัดความกว้างของแต่ละหลัก โดยการจัดเรียงฟิลด์จาก QUERY ดังนี้
    
99.             .AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
    
100.             '/ Adjust Header Styles
     
101.             With .ColumnHeadersDefaultCellStyle
     
102.                 .BackColor = Color.Navy
     
103.                 .ForeColor = Color.White
     
104.                 .Font = New Font("Kanit", 11)
     
105.             End With
     
106.         End With
     
107.     End Sub
     
108. 
     
109.     ' / --------------------------------------------------------------------
     
110.     ' / Get my project path
     
111.     ' / AppPath = C:\My Project\bin\debug
     
112.     ' / Replace "\bin\debug" with ""
     
113.     ' / Return : C:\My Project\
     
114.     Function MyPath(ByVal AppPath As String) As String
     
115.         '/ MessageBox.Show(AppPath);
     
116.         AppPath = AppPath.ToLower()
     
117.         '/ Return Value
     
118.         MyPath = AppPath.Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "")
     
119.         '// If not found folder then put the \ (BackSlash) at the end.
     
120.         If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
     
121.     End Function
     
122. 
     
123.     Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
     
124.         Me.Close()
     
125.     End Sub
     
126. End Class

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดชุดเต็ม VB.NET (2010) ได้จากที่นี่ ...