Installer un Font

Version imprimable

Installer un Font

Bonjour,
je suis confronté à un problème au niveau de l'installation d'une font à partir de mon application VB.NET dans visual studio 2010, voici mon code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Declare Function AddFontResource Lib "gdi32" _
    Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
 
    Private Sub txbCode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txbCode.TextChanged
        Dim codeBar, codeClair
        If txbCode.Text <> "" Then
            'MsgBox("Bonjour")
            codeClair = txbCode.Text & New String("0", EANLen - Len(txbCode.Text))
            codeBar = IIf(EANLen = 7, EAN8(codeClair), EAN13(codeClair))
            lblCodeBar.Text = codeBar
            If File.Exists("C:\Windows\Fonts\ean13.ttf") Then
                MsgBox("police installée: OK !")
            Else
                MsgBox("police doit être installée")
                Try
                    AddFontResource("C:\temp\ean13.ttf")
                Catch ex As Exception
                    MsgBox(ex.ToString)
                End Try
            End If
            lblDessinCode.Font = New Font("Code EAN13", 48, FontStyle.Regular)
            lblDessinCode.Text = codeBar
        End If
    End Sub

Rien ne s'installe :s
Je ne comprend pas pourquoi.

Merci de votre aide,
Jérôme

25/02/2011, 15h56
anonymousse

bonjour,

Tu contrôles la présence dans le dossier Font, et tu l'installes dans Temp (?)

voir lien :

http://www.freevbcode.com/ShowCode.asp?ID=1945

Non je teste si la police existe déjà dans Fonts (si c'est le cas la police est déjà installée et je ne dois pas l'installer)

J'ai déjà été voir sur ce lien voici mon code actuel qui ne fonctionne toujours pas:

Code:

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
<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 txbCode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txbCode.TextChanged
        Dim codeBar, codeClair, ret
        If txbCode.Text <> "" Then
            'MsgBox("Bonjour")
            codeClair = txbCode.Text & New String("0", EANLen - Len(txbCode.Text))
            codeBar = IIf(EANLen = 7, EAN8(codeClair), EAN13(codeClair))
            lblCodeBar.Text = codeBar
            Const WM_FONTCHANGE As Integer = &H1D
            Const HWND_BROADCAST As Integer = &HFFFF
            If File.Exists("C:\Windows\Fonts\code128.ttf") Then
                'MsgBox("police installée: OK !")
            Else
                'MsgBox("police doit être installée copiée dans " & Environment.GetFolderPath(Environment.SpecialFolder.System))
                Try
                    FileCopy("C:\temp\code128.ttf", Environment.GetFolderPath(Environment.SpecialFolder.System) & "\code128.ttf")
                Catch ex As Exception
                    MsgBox(ex.ToString)
                End Try
                ret = AddFontResource(Environment.GetFolderPath(Environment.SpecialFolder.System) & "\code128.ttf")
                SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
                WriteProfileString("fonts", "code 128", Environment.GetFolderPath(Environment.SpecialFolder.System) & "\code128.ttf")
            End If
            lblDessinCode.Font = New Font("Code EAN13", 48, FontStyle.Regular)
            lblDessinCode.Text = codeBar
        End If
    End Sub

Je pense qu'en fait je dois d'abord copier le fichier .ttf dans le dossier System32 ce que je n'arrive pas à faire sous windows 7 (probablement problème de droit)

ma remarque concerne ça :
Code:

1 2 3 4 5 6 If File.Exists("C:\Windows\Fonts\ean13.ttf") Then MsgBox("police installée: OK !") Else MsgBox("police doit être installée") Try AddFontResource("C:\temp\ean13.ttf")
il faut à mon avis :

Code:

AddFontResource("C:\Windows\Fonts\ean13.ttf")

qu'en penses-tu ?

25/02/2011, 17h12
Jerome2606

Oui sans doute mais comment arriver à copier le fichier ean13.ttf dans le dossier C:\Windows\Fonts ?
Windows 7 requiert une élévation au niveau des droits pour pouvoir écrire dans les dossiers Windows.
Peut-on faire ça en VB.NET?
25/02/2011, 17h25
anonymousse

as-tu essayé ? je ne vois pas le changement dans ton code.

normalement AddFontResource permet justement de passer au dessus des droits il me semble.

par contre filecopy ne te permet pas de le faire dans le dossier Font, génération d'une erreur illegal function normalement.

Si je fais ça il manque à mon programme de savoir où se trouve mon fichier ttf de base.
Ca ne fonctionne pas :(
J'ai réussi en utilisant un script AutoIt mais comment exécuter un script en demandant à l'utilisateur s'il veut bien l'exécuter en tant qu'administrateur?

Code Autoit:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 #include <GuiConstants.au3> FileChangeDir (@ScriptDir) $FontFile="code128.ttf" _FontInstall ( $FontFile ) MsgBox(0, "Font Installed", $FontFile ) Func _FontInstall ( $FontFile ) FileCopy ( $FontFile, @WindowsDir & "\Fonts" ,1 ) Run("explorer " & @WindowsDir & "\Fonts", "", @SW_HIDE) WinWait("Fonts") WinClose("Fonts") EndFunc

bonsoir,

en fait je t'ai dit une c... !

il faut :

Code:

AddFontResource("PathMonDossierFont\ean13.ttf")

MonDossierFont étant le dossier source dans lequel tu as le fichier Font que tu veux enstaller dans le dossier Windows\Font.

peux-tu tester ça :

Code:

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
 
Private Declare Function AddFontResourceLib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
End Function
 
Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
 
Private Sub txbCode_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txbCode.TextChanged
   Dim codeBar as string, codeClair as string
   Dim ret As Long
   Const WM_FONTCHANGE As Integer = &H1D
   Const HWND_BROADCAST As Integer = &HFFFF
 
        If txbCode.Text <> "" Then
            codeClair = txbCode.Text & New String("0", EANLen - Len(txbCode.Text))
            codeBar = IIf(EANLen = 7, EAN8(codeClair), EAN13(codeClair))
            lblCodeBar.Text = codeBar
 
            If File.Exists("C:\Windows\Fonts\code128.ttf") Then
                'MsgBox("police installée: OK !")
            Else
                'MsgBox("police doit être installée copiée dans " & Environment.GetFolderPath(Environment.SpecialFolder.System))
                Try
                   ret = AddFontResource(Environment.GetFolderPath(Environment.SpecialFolder.System) & "\code128.ttf")
                   if ret > 0 then SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
                Catch ex As Exception
                    MsgBox(ex.ToString)
                End Try
            End If
            lblDessinCode.Font = New Font("Code EAN13", 48, FontStyle.Regular)
            lblDessinCode.Text = codeBar
        End If
End Sub

27/02/2011, 13h41
Jerome2606

Et je devrais rajouter le fichier ttf en tant que ressource du programme?
Ou alors je dois trouver un moyen de le copier au préalable dans C:\Windows\System32, mais comment?
27/02/2011, 13h53
anonymousse

bonjour,

taper du code à la volée n'est pas toujours bon ! je n'ai effectivement pas tout codé.

je n'ai pas d'accès sur mon poste de travail pour le moment, je te donne ce lien que je viens de trouver et qui doit résoudre ton problème, il faut intégrer la font aux ressources, ça me paraît plus simple à gérer :

http://zerosandtheone.com/blogs/vb/a...plication.aspx

bon code
27/02/2011, 13h59
Jerome2606

En tout cas merci de ton aide précieuse, je teste et je te tiens au courant.

Jérôme