Bonjour tout le monde
Svp gentelman
Si vous pouvez m'aider a resoudre ce probleme
J'ai un font nomme (Bubblegum) .. je l'ai posé dans le dossier (Fontart\Debug)
Je veux copier ce font dans le disque (C\windows\Fonts)
Malheureusement j'obtien ce message d'erreur
"L'acces au chemin d'acces C:\windows\Fonts\Bubblegum.TTF est refuse"
Comment resoudre ce probleme svp je ne veux pas copier ce font manuellement
Voici tout mon code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Imports System.Runtime.InteropServices
Imports System.IO
Imports Microsoft.Win32
Public Class Form1
    <DllImport("gdi32.dll", EntryPoint:="AddFontResourceW")>
    Private Shared Function AddFontResourceW(<MarshalAs(UnmanagedType.LPWStr)> ByVal lpFilename As String) As Integer
    End Function
 
    <DllImport("gdi32.dll", EntryPoint:="RemoveFontResourceW")>
    Private Shared Function RemoveFontResourceW(<MarshalAs(UnmanagedType.LPWStr)> ByVal lpFileName As String) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32.dll", EntryPoint:="SendMessageW")>
    Private Shared Function SendMessageW(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    End Function
    Private Const WM_FONTCHANGE As Integer = &H1D
    Private Const HWND_BROADCAST As Integer = &HFFFF
    Private Sub Transmettre_Font()
        Dim Font_Name As String = "Bubblegum (TrueType)"
        Dim Font_File_Name As String = "Bubblegum.ttf"
 
        Dim SourceFontFile As String = (Application.StartupPath & "\Fontart\Bubblegum.TTF")
 
        Dim DestinationFontFile As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), Path.GetFileName(SourceFontFile))
        If Not File.Exists(DestinationFontFile) Then
            Try
                File.Copy(SourceFontFile, DestinationFontFile) 'copy the font file to the system's font folder
            Catch ex As Exception
                MessageBox.Show(ex.Message, "Copy Failed...")
                Exit Sub
            End Try
            'Add the 'copied' font file to the system's font resource table. If AddFontResource fails it returns 0, otherwise it returns the number of fonts successfully added to the table.
            If AddFontResourceW(DestinationFontFile) > 0 Then
                'open the Fonts registry key with 'write' access.
                Dim FontRegKey As RegistryKey = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", True)
                If FontRegKey IsNot Nothing Then
                    Try
                        FontRegKey.SetValue(Path.GetFileNameWithoutExtension(DestinationFontFile) & " (TrueType)", Path.GetFileName(DestinationFontFile)) 'add a Value to the Fonts registry key for your font.
                    Catch ex As Exception
                        MessageBox.Show(ex.Message, "Failed To Register Font...")
                    End Try
                    FontRegKey.Close()
                Else
                    MessageBox.Show("Could not open the fonts registry key.", "Failed To Register Font...")
                End If
                'broadcast the WM_FONTCHANGE message to all opened applications to let them know a font resource has changed.
                SendMessageW(New IntPtr(HWND_BROADCAST), WM_FONTCHANGE, IntPtr.Zero, IntPtr.Zero)
            Else
                MessageBox.Show("Could not add the font to the system resource table.", "Install Failed...")
            End If
        Else
            MessageBox.Show("A font with the same filename already exists in the system font folder.", "Install Failed...")
        End If
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Call Transmettre_Font()
    End Sub
End Class
Merci beaucoup d'avance pour l'aide
Cordialement
MADA