GDI operating system to install new fonts

Imports System.Drawing.Text
Public Class Form1
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Long
    Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
    Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Const WM_FONTCHANGE As Integer = &H1D
        Const HWND_BROADCAST As Integer = &HFFFF

        Dim InFont As New InstalledFontCollection
        Dim IsInstalledBarCodeFont As Boolean = False
        For Each k In InFont.Families
            If k.Name = "C39HrP36DmTt" Then
                IsInstalledBarCodeFont = True
                Exit For
            End If
        Next
        If IsInstalledBarCodeFont = False Then
            Dim Ret As Long
            Dim Res As Long
            Dim Ret2 As Long

            FileCopy(CurDir() & "\C39HrP36DmTt.TTF", "C:\Windows\Fonts\C39HrP36DmTt.TTF")
            Ret = AddFontResource("C:\Windows\Fonts\C39HrP36DmTt.TTF")
            Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
            Ret2 = WriteProfileString("fonts", "C39HrP36DmTt.TTF" + " (TrueType)", "C39HrP36DmTt.TTF")
        End If
        Me.Close()
    End Sub
End Class

Guess you like

Origin www.cnblogs.com/longjin2018/p/11737582.html