[سؤال] اضافة خط جديد الى النظام - نسخة قابلة للطباعة

كود :

    Dim allFonts As New Drawing.Text.InstalledFontCollection

        Dim fontFamilies() As FontFamily = allFonts.Families()



        For Each Fnt In allFonts.Families

            ListFonts.Items.Add(Fnt)

        Next

كود :

<DllImport("gdi32")> _

    Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer

    End Function



    <DllImport("user32.dll")> _

    Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

    End Function



    <DllImport("kernel32.dll", SetLastError:=True)> _

    Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer

    End Function



    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim Ret As Integer

        Dim Res As Integer

        Dim FontPath As String

        Const WM_FONTCHANGE As Integer = &H1D

        Const HWND_BROADCAST As Integer = &HFFFF

        FontPath = WinFontDir & "\" & FontFileName

        Ret = AddFontResource(FontPath)

        Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)

        Ret = WriteProfileString("fonts", FontName & " (TrueType)", FontFileName)

    End Sub