Si vous souhaitez utiliser des polices de caractères dans votre application sans avoir à les installer.
Il suffit de mettre les fichiers ttf dans un répertoire avec l'application et de les charger au démarrage de la base de données avec des API.
Code à mettre dans un module standard :
Avec ce code, la police de caractères chargée sera utilisable dans les autres application.
Fonctionne sur toutes les versions de windows (à partir de 95/NT).
Code à mettre dans un module standard :
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 Option Compare Database Option Explicit Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (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, ByVal lParam As Long) As Long Private Const WM_FONTCHANGE = &H1D Private Const HWND_BROADCAST = &HFFFF& Public Function AddFontFromFile(pFile As String) As Boolean AddFontFromFile = (AddFontResource(pFile) > 0) SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0 End Function Public Function RemoveFontFromFile(pFile As String) As Boolean RemoveFontFromFile = (RemoveFontResource(pFile) <> 0) End Function
Avec ce code, la police de caractères chargée ne sera utilisable que dans l'application courante.
Fonctionne sur les versions de windows à partir de 2000.
Pour charger la police :
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 Option Compare Database Option Explicit Private Declare Function AddFontResourceEx Lib "gdi32" Alias "AddFontResourceExA" (ByVal lpszFilename As String, ByVal fl As Long, ByVal pdv As Long) As Long Private Declare Function RemoveFontResourceEx Lib "gdi32" Alias "RemoveFontResourceExA" (ByVal lpszFilename As String, ByVal fl As Long, ByVal pdv As Long) As Long Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const FR_PRIVATE = &H10 Public Function AddFontFromFile(pFile As String) As Boolean AddFontFromFile = (AddFontResourceEx(pFile, FR_PRIVATE, 0) > 0) End Function Public Function RemoveFontFromFile(pFile As String) As Boolean RemoveFontFromFile = (RemoveFontResourceEx(pFile, FR_PRIVATE, 0) <> 0) End Function
Pour la décharger :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Call AddFontFromFile (CurrentProject.Path & "\fonts\MaPolice.ttf")
La police n'est pas installée de manière permanente, si RemoveFontFromFile n'est pas exécuté la police sera déchargée à la fermeture de session windows.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Call RemoveFontFromFile (CurrentProject.Path & "\fonts\MaPolice.ttf")
S'il n'y a pas de contre-indication à installer les polices, il vaut mieux les intégrer à un installeur mais, au cas où, il peut être utile de les charger dynamiquement en mémoire.
Partager