Discussion :

[xp]

Bonjour,
je cherche à créer une zone de liste avec les noms des polices disponibles, y-a-t-il une fonction permettant de récupérer cette liste?

Merci

[fearless]

En cherchant sur , j'ai trouver ceci

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
58
59
60
 
Const Code1 = _
  "558BEC8B4D1433D28B450883C01CEB02424080380075F9660351" _
  & "02B801000000426689510266FF015DC210"
 
Const Code2 = _
  "558BEC53568B551433C00FBFF08B4D088B5A0403DE408A4C311C" _
  & "0FBF720284C9880C3375E566014202B8010000005E5B5DC210"
 
Type SFont
  Count As Integer
  Length As Integer
  Str As String
End Type
 
Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
 
Declare Function EnumFontFamiliesA Lib "Gdi32" _
  (ByVal hdc As Long, ByVal lpFaceName As Long, _
  ByVal lpFontFunc As String, Fonts As SFont) As Long
 
Function ListePolices()
 
  Dim CallBack1 As String, CallBack2 As String
  Dim Fonts As SFont
  Dim FontNames() As String
  Dim I As Integer, J As Integer, K As Integer
 
  HexDec = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, _
    0, 0, 0, 0, 0, 0, 0, 10, 11, 12, 13, 14, 15)
  For I = 1 To Len(Code1) Step 2
    CallBack1 = CallBack1 & Chr(HexDec(Asc(Mid(Code1, I, 1)) _
    - 48) * 16 + HexDec(Asc(Mid(Code1, I + 1, 1)) - 48))
  Next I
  For I = 1 To Len(Code2) Step 2
    CallBack2 = CallBack2 & Chr(HexDec(Asc(Mid(Code2, I, 1)) _
    - 48) * 16 + HexDec(Asc(Mid(Code2, I + 1, 1)) - 48))
  Next I
 
  EnumFontFamiliesA GetDC(0), 0, CallBack1, Fonts
  Fonts.Str = Space(Fonts.Length)
  Fonts.Length = 0
  EnumFontFamiliesA GetDC(0), 0, CallBack2, Fonts
  ReDim FontNames(1 To Fonts.Count)
  J = 1
  For I = 1 To Fonts.Count
    K = InStr(J, Fonts.Str, Chr(0))
    FontNames(I) = Mid(Fonts.Str, J, K - J)
    J = K + 1
  Next
  ListePolices = FontNames
 
End Function
 
Function InstPolice(FontName As String) As Boolean
 
  InstPolice = IsNumeric(Application.Match(FontName, _
    ListePolices, 0))
 
End Function

Tellement bon que je crois que je vais garder cette fonction tjrs prêt de moi

[xp]

Un grand merci,
je vais de ce pas la tester