Installer un Font

**Jerome2606** · 25/02/2011, 14h34

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 :

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
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

**anonymousse** · 25/02/2011, 15h56

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

**Jerome2606** · 25/02/2011, 16h22

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 :

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
<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)

**anonymousse** · 25/02/2011, 16h59

ma remarque concerne ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

qu'en penses-tu ?

**Jerome2606** · 25/02/2011, 17h12

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?

**anonymousse** · 25/02/2011, 17h25

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.

**Jerome2606** · 25/02/2011, 17h56

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**anonymousse** · 25/02/2011, 18h20

bonsoir,

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

il faut :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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
 
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

**Jerome2606** · 27/02/2011, 13h41

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?

**anonymousse** · 27/02/2011, 13h53

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

**Jerome2606** · 27/02/2011, 13h59

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

Jérôme

Installer un Font

VB.NET

Discussions similaires

Partager

Partager