Discussion :

[cbleas]

Bonjour,

Je suis confronté à un problème je dois utiliser des fonts que j'ai créé pour une application ACCESS. Ma question est de savoir comment faire pour installer les fonts en VB.
Quelqu'un aurait il une idée?

Merci

[ProgElecT]

bonjour

je suppose que cette police ce trouve dans un fichier, moi je le met dans le dossier "C:\WINDOWS\Fonts".
Une autre façon,
quand on ouvre ce dossier par le menu "Fichier --> Instaler une nouvelle police" on peut lui passer le fichier.

Si une police est utilisé dans le projet, lors de l'empaquetage & déploiement
il suffit de ne pas oublier de rajouter ce fichier de police, pour qu'il soit inclus de le Cab.

INFOS
Le fichier créer doit repondre a une structure bien pécise, le meilleur moyen est de le fabriquer avec eudcedit.exe, qui ce trouve dans "C:\WINDOWS\system32", (sous XP)

[cbleas]

Bonjour,
Je les met déja dans Font mais il faut en plus les déclarer avec je crois un fichier .FOT ce qui indique au système qu'il y a une nouvelle polic de caractère. si on ne déclare pas cela la nouvelle font ne sera prise en compte uniquement que lorsque l'on ira uvrir le fichier .TTF

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 AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateScalableFontResource Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Long
 
Function SaveFonts(lpszResourceFile As String, lpszFontFile As String, lpszCurrentPath As String)
 
 
 
    ''res = AddFontResource(nomFont)   'Installation de la police
    fHidden = 0 '(police visible par toutes les applications)
    ''lpszResourceFile = "c:\windows\fonts\Mapolice.fot"
    ''lpszFontFile = "Mapolice.ttf"
    ''lpszCurrentPath = "c:\windows\fonts"
 
    Resultat = CreateScalableFontResource(0, lpszResourceFile, lpszFontFile, lpszCurrentPath)
''Vérifier que Resultat est différent de 0.
 
''3) Ajouter la ressource au système
 
    res = AddFontResource(lpszResourceFile)
''Vérifier que NbFontesInstallees est différent de 0.
 
 
 
    If res > 0 Then 'Test de l'install de la police
        SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0 'L'install à réussit, on valide la police dans les registres
        msg = "Police : " & lpszFontFile & " à été installée" & Chr(13)   'Message de confirmation d'ajout
    Else
        msg = "Police : " & lpszFontFile & " n'a pas été installée" & Chr(13)   'Message comme quoi ce n'est pas installé
    End If
 
    MsgBox msg  'Affichage du rapport
End Function

le pb c'est que ce programme ne fonctionne pas toutes les fois suivant le système d'exploitation.

[ThierryAIM]

tu veux absolument le faire en VB ?

Sinon qques lignes de script Inno Setup et le tour est joué :

Code x :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
;Installateur de Polices Windows

[Setup]
AppName=Font Installer
AppVerName=Font Installer 1.0
CreateAppDir=false

[Languages]
Name: en; MessagesFile: compiler:Default.isl;
Name: fr; MessagesFile: compiler:Languages\French.isl;

[Files]
; [Fonts]
Source: C:\windows\Fonts\Digirtu_.ttf; DestDir: {fonts}; FontInstall: Digital Readout Thick Upright; Flags: onlyifdoesntexist uninsneveruninstall

[mortalino]

Salut,

tu as aussi la possibilité d'énumérer les police par une Api : EnumFonts

Dans un Module :

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
Option Explicit
 
Private Const LF_FACESIZE   As Long = 32&
 
Private Type LOGFONT
    lfHeight                As Long
    lfWidth                 As Long
    lfEscapement            As Long
    lfOrientation           As Long
    lfWeight                As Long
    lfItalic                As Byte
    lfUnderline             As Byte
    lfStrikeOut             As Byte
    lfCharSet               As Byte
    lfOutPrecision          As Byte
    lfClipPrecision         As Byte
    lfQuality               As Byte
    lfPitchAndFamily        As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type
 
Public Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
 
Public Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
    Dim LF          As LOGFONT
    Dim ZeroPos     As Long
    Dim FontName    As String
 
    Call CopyMemory(LF, ByVal lplf, LenB(LF))
    FontName = StrConv(LF.lfFaceName, vbUnicode)
    ZeroPos = InStr(1, FontName, Chr$(0))
    If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1
' *** Attention ici : ***
    NomForm.NomCombo.AddItem FontName
    EnumFontProc = 1
End Function

Pour l'appeler :

Code :

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

Call EnumFonts(NomForm.hdc, vbNullString, AddressOf EnumFontProc, 0&)

@++

[cbleas]

Bonjour désolé pour le retard
Merci pour vos réponses j'ai en gros essayé l'ensemble qui fonctionnait plus ou moins bien
J'ai utilisé la solution de Thierry Aim qui semble fonctionner pour la plupart des ordinateurs.

Merci encore