Infos sur une police particulière (A propos de GetTextMetrics)

Question

Je voulais savoir (car je suis 
débutant en VBA) comment utiliser la fonction GetTextMetrics en VBA pour avoir les infos sur 
une police de nom et de taille données (je cherche à connaître la taille sous et 
celle au-dessus la ligne de base alias  tmAscent  et  tmDescent  si j'en crois 
MSDN). Je pense  qu'en passant par une forme cela devrait être 
faisable.

Merci.

geobasic · Answer

Je ne connais pas cette fonction mais si j'en juge par ces paramètres elle demande en entrée un hdc, et une structure en sortie LpMetrics qui doit recevoir les données de la font du Hdc. Essai de l'appeller avec la propriété Hdc de ton form pour voir ce que tu récupère.

rambc · Answer

Hombre, no entiendo nada.

Qu'est-ce qu'un hdc STP ?

geobasic · Answer

Le hDC c'est un handle graphique (le terme signifie Handle Display Context), un pointeur qui te permet entre autres d'exécuter des fonctions API sur un objet graphique. Quelques controls de VB possède ce handle comme le form ou le PictureBox.

Par exemple tu crée une PictureBox, tu lui met la police désirée et tu appelle la fonction GetTextMetrics avec Picture1.hDC en paramêtre. Tu dois Pouvoir récupérer les paramètres de la police dans la stucture LpMetrics. Si tu n'a pas la decription de cette structure la voici:

Private Type TEXTMETRIC
    tmHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
End Type

Et puis pendant qu'on y est, la décraration de la fonction:

Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long

geobasic · Answer

Oups ... Pardon pour les fautes de frappe !

rambc · Answer

Gros Problème : je travaille sur VBA et je souhaite avoir une solution pour VBA. Et malheureusement, en essayant, le HDC ne semble pas faire partie de VBA.

Merci quand même.

Sinon y-aurait-il au pire possibilté de faire une DLL qui obtiendrait les infos ?

geobasic · Answer

Je connais pas bien VBA mais en fouillant un petit peu j'ai trouvé un moyen d'obtenir un hDC. Dans un UserForm crée un control Frame que tu met en Visible=false et tu positionne une font. Pour obtenir un hDC on peut utiliser l'api GetDC dont voici la description:

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Pour ça comme tu le remarque on a besoin d'un paramètre hWnd (handle de fenêtre) que l'on n'a pas non plus sur les controls de VBA. Mais en faisant un recherche j'ai vu qu'il existait un fonction caché de l'objet Control qui permet de récuperer ce handle. Voici en bout de code pour illustrer cela:

    Dim Ctrl As Control

    Dim hWnd As Long, hDC As Long
    Set Ctrl = Frame1

    hWnd = Ctrl.[_GethWnd]
    hDC = GetDC(hWnd)

Et à partir du hDC tu peut appeller la fonction GetTextMetrics.

rambc · Answer

Quelle est la signification de ceci  "hWnd = Ctrl.[_GethWnd]" ?

Lorsque je teste, cela me renvoie des infos sur la police courante de Windows et non sur celle de la FRAME (essayes sous WORD tu verras le problème).

Si tu as une solution pour améliorer les choses ....

Le code que j'ai tapé dans mon UserForm :

Private Type TEXTMETRIC
  tmHeight As Integer
  tmAscent As Integer
  tmDescent As Integer
  tmInternalLeading As Integer
  tmExternalLeading As Integer
  tmAveCharWidth As Integer
  tmMaxCharWidth As Integer
  tmWeight As Integer
  tmItalic As String * 1
  tmUnderlined As String * 1
  tmStruckOut As String * 1
  tmFirstChar As String * 1
  tmLastChar As String * 1
  tmDefaultChar As String * 1
  tmBreakChar As String * 1
  tmPitchAndFamily As String * 1
  tmCharSet As String * 1
  tmOverhang As Integer
  tmDigitizedAspectX As Integer
  tmDigitizedAspectY As Integer
End Type


Private Declare Function GetTextMetrics Lib "gdi32" _
   Alias "GetTextMetricsA" _
   (ByVal hdc As Long, _
   lpMetrics As TEXTMETRIC) _
   As Long


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long


Private Sub CommandButton1_Click()


Dim tm As TEXTMETRIC
Dim Ctrl As Control
Dim hwnd As Long, hdc As Long
Set Ctrl = Me.Frame1
    
hwnd = Ctrl.[_GethWnd]
hdc = GetDC(hwnd)

GetTextMetrics hdc, tm

MsgBox "Taille=" + CStr(tm.tmHeight) + Chr(13) + _
"TailleSur=" + CStr(tm.tmAscent) + Chr(13) + _
"TailleSous=" + CStr(tm.tmDescent)


End Sub

Infos sur une police particulière (A propos de GetTextMetrics)

7 réponses

Votre réponse