Public Function TailleChaineEcran(ByVal sChaine As String, ByVal sPolice As String, ByVal iTaille As Integer, Optional ByVal bBold As Boolean = False) As POINTAPI
Dim pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
Dim TextSize As POINTAPI, CX As Long, CY As Long
Dim sNomChamp As String
Dim hEnCours As Long
' position curseur
GetCursorPos pt
' handle fenetre sous le curseur
mWnd = WindowFromPoint(pt.X, pt.Y)
' device context de la fenetre
nDC = GetWindowDC(mWnd)
Dim hFont As Long
hFont = CreateMyFont(sPolice, iTaille, bBold)
hEnCours = SelectObject(nDC, hFont)
' dimensions du texte dans sChaine
GetTextExtentPoint32 nDC, sChaine, Len(sChaine), TextSize
TailleChaineEcran.X = TextSize.X
TailleChaineEcran.Y = TextSize.Y
SelectObject nDC, hEnCours
hEnCours = ReleaseDC(mWnd, nDC)
End Function
Function CreateMyFont(sPolice As String, nSize As Integer, Optional bBold As Boolean = False) As Long
'Créer la police spécifique
CreateMyFont = CreateFont(-nSize, 0, 0, 0, FW_NORMAL + IIf(bBold, FW_BOLD, 0), False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, sPolice)
End Function
|