ชุมชนคนรักภาษาเบสิค - Visual Basic Community

 ลืมรหัสผ่าน
 ลงทะเบียน
ค้นหา
ดู: 434|ตอบกลับ: 0

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

[คัดลอกลิงก์]

213

กระทู้

301

โพสต์

2407

เครดิต

ผู้ดูแลระบบ

Rank: 9Rank: 9Rank: 9

เครดิต
2407




จากตอนที่แล้วในการนำฟอนต์พิเศษไปใช้งานกับเครื่องอื่น จะเป็นการกำหนดฟอนต์ให้กับ 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. Public Class frmRegistryFont
  4.     <DllImport("gdi32")> _
  5.     Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
  6.     End Function

  7.     <DllImport("user32.dll")> _
  8.     Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  9.     End Function

  10.     <DllImport("kernel32.dll", SetLastError:=True)> _
  11.     Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
  12.     End Function

  13.     ' / --------------------------------------------------------------------
  14.     ' / Registry Font with API32 (Application Programming Interface).
  15.     Private Sub frmRegistryFont_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
  16.         Me.TextBox1.Text = "ทดสอบการใช้งานฟอนต์แบบการรีจิสทรี้วินโดส์ว"
  17.         Try
  18.             '// Check Font exist.
  19.             If My.Computer.FileSystem.FileExists(Environment.GetEnvironmentVariable("windir") & "\fonts\Kanit-regular.ttf") Then
  20.                 MessageBox.Show("Font already exist.")
  21.             Else
  22.                 MessageBox.Show("Font not found.")
  23.                 '// Set Administrator
  24.                 Dim oRegKey As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\AppCompatFlags\\Layers", True)
  25.                 oRegKey.SetValue("RegistryFont.Exe", "~ RUNASADMIN")
  26.                 oRegKey.Close()
  27.                 '// Use API (Application Programming Interface).
  28.                 Dim Ret As Integer
  29.                 Dim Res As Integer
  30.                 Dim FontPath As String = MyPath(Application.StartupPath) & "Kanit-regular.ttf"
  31.                 '// ระมัดระวังในการตั้งชื่อฟอนต์ อย่าให้ไปซ้ำกับที่มีอยู่ในระบบ
  32.                 Dim FontName As String = "Kanit (TrueType)"
  33.                 Const WM_FONTCHANGE As Integer = &H1D
  34.                 Const HWND_BROADCAST As Integer = &HFFFF
  35.                 Ret = AddFontResource(FontPath)
  36.                 Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
  37.                 Ret = WriteProfileString("fonts", FontName, FontPath)
  38.             End If
  39.         Catch ex As Exception
  40.             MessageBox.Show(ex.Message)
  41.         End Try
  42.     End Sub

  43.     ' / --------------------------------------------------------------------
  44.     '// Before finishing the program, delete the value.
  45.     Private Sub frmRegistryFont_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
  46.         Dim FontName As String = "Kanit (TrueType)"
  47.         If My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", "Kanit (TrueType)", Nothing) Is Nothing Then
  48.             MsgBox(FontName & "  does not exist.")
  49.         Else
  50.             MsgBox(FontName & " exist.")
  51.             Dim rk As RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", True)
  52.             If rk IsNot Nothing Then
  53.                 rk.DeleteValue(FontName)
  54.                 rk.Close()
  55.             End If
  56.         End If
  57.     End Sub

  58.     Private Sub btnLoad_Click(sender As System.Object, e As System.EventArgs) Handles btnLoad.Click
  59.         Call InitializeGrid()
  60.         Call FillData()
  61.     End Sub

  62.     ' / --------------------------------------------------------------------
  63.     Private Sub FillData()
  64.         Dim dt As New DataTable
  65.         dt.Columns.Add("ID")
  66.         dt.Columns.Add("Name")
  67.         dt.Columns.Add("PositionName")
  68.         dt.Columns.Add("Salary")
  69.         dt.Columns.Add("HireDate")
  70.         dt.Rows.Add("00001", "นายทองก้อน ทับทิมกรอบ", "Managing Director", "99,999.99", "01/01/2562")
  71.         dt.Rows.Add("00002", "นายบุญห่อ พ่อรวย", "Labour", "15,000.00", "01/06/2562")
  72.         dt.Rows.Add("00003", "นางสาวคำหล้า น่ารัก", "Secretary", "19,999.50", "13/02/2562")
  73.         dt.Rows.Add("00004", "นางบัวผัน ทันใจ", "House Keeper", "9,000.99", "24/01/2562")
  74.         DataGridView1.DataSource = dt
  75.     End Sub

  76.     ' / --------------------------------------------------------------------
  77.     '// การตั้งค่าเริ่มต้นให้กับตารางกริดในแบบ @Run Time
  78.     Private Sub InitializeGrid()
  79.         With DataGridView1
  80.             .RowHeadersVisible = False
  81.             .AllowUserToAddRows = False
  82.             .AllowUserToDeleteRows = False
  83.             .AllowUserToResizeRows = False
  84.             .MultiSelect = False
  85.             .SelectionMode = DataGridViewSelectionMode.FullRowSelect
  86.             .ReadOnly = True
  87.             .RowTemplate.MinimumHeight = 30
  88.             .RowTemplate.Height = 30
  89.             .Font = New Font("Kanit", 10, FontStyle.Regular)
  90.             '/ จัดความกว้างของแต่ละหลัก โดยการจัดเรียงฟิลด์จาก QUERY ดังนี้
  91.             .AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
  92.             '/ Adjust Header Styles
  93.             With .ColumnHeadersDefaultCellStyle
  94.                 .BackColor = Color.Navy
  95.                 .ForeColor = Color.White
  96.                 .Font = New Font("Kanit", 11)
  97.             End With
  98.         End With
  99.     End Sub

  100.     ' / --------------------------------------------------------------------
  101.     ' / Get my project path
  102.     ' / AppPath = C:\My Project\bin\debug
  103.     ' / Replace "\bin\debug" with ""
  104.     ' / Return : C:\My Project\
  105.     Function MyPath(ByVal AppPath As String) As String
  106.         '/ MessageBox.Show(AppPath);
  107.         AppPath = AppPath.ToLower()
  108.         '/ Return Value
  109.         MyPath = AppPath.Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "")
  110.         '// If not found folder then put the \ (BackSlash) at the end.
  111.         If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
  112.     End Function

  113.     Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
  114.         Me.Close()
  115.     End Sub
  116. End Class
คัดลอกไปที่คลิปบอร์ด


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

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน

x
สิ่งที่ดีกว่าการให้ คือการให้แบบไม่มีที่สิ้นสุด
ขออภัย! คุณไม่ได้รับสิทธิ์ในการดำเนินการในส่วนนี้ กรุณาเลือกอย่างใดอย่างหนึ่ง ลงชื่อเข้าใช้ | ลงทะเบียน

รายละเอียดเครดิต

ข้อความล้วน|อุปกรณ์พกพา|ประวัติการแบน|G2GNet.com  

GMT+7, 2020-1-21 12:21 , Processed in 0.273569 second(s), 4 queries , File On.

Powered by Discuz! X3.3 R20170401, Rev.54

© 2001-2017 Comsenz Inc.

ตอบกระทู้ ขึ้นไปด้านบน ไปที่หน้ารายการกระทู้