Get Textbox Font Height

Can some please explain what I'm doing wrong.
I set the textbox font to "Tahoma", Fontsize = 9
and IMHO TEXTMETRICS should return that same value BUT does NOT??

Code:

---

Private Sub GetFontHeight()

    Dim hDC As Long
    Dim hWnd As Long
   
  'Individual Font Variables
  Dim mymetrics As TEXTMETRIC
  Dim savey As Single
  Dim InternalLeading As Single
  Dim Ascent As Single
  Dim Descent As Single
  Dim ExternalLeading As Single
  Dim txtHeight As Integer
  Dim txtHeight1 As Integer
  Dim convert As Long
  Dim convert1 As Long
 
  '--------------------------------
   
    Me.ScaleMode = vbPixels    'Form in Pixels
   
    With Me.Text1
        .FontName = "Tahoma"
        .FontSize = 9
       
          hWnd = .hWnd
    End With

    hDC = GetDC(hWnd)

  '-----------------------
  'Get Font Part Details Using API
  '------------------------
  GetTextMetrics hDC, mymetrics
  InternalLeading = mymetrics.tmInternalLeading
  Ascent = mymetrics.tmAscent
  Descent = mymetrics.tmDescent
  ExternalLeading = mymetrics.tmExternalLeading
 
  txtHeight = Ascent + Descent
  txtHeight1 = Ascent + Descent - InternalLeading
 

End Sub

---

Bump --- NO ONE?

Font size is not the same as text height

Code:

---

Font.Name = "Tahoma"
 Font.Size = 9
 ScaleMode = vbPixels
 Debug.Print Font.Size, TextHeight("")

---

Thanks for responding. As you point out:

Code:

---

Debug.Print Font.Size, TextHeight("")

---

That throws another question into the mix ?

For a Font.Size of 9, and converting it to pixels (TEXTMETRIC) and back to points I end up with 13 (Font.Size 9.75) instead of 12 (Font.Size 9.0).

This was done by Using GDI (TEXTMETRIC) and converting the result back to Font.Size
Microsoft is doing some type of Rounding or Truncating when they convert GDI pixels to VB Font.Size.
Haven't played with TextHeight yet, but based on the value of TextHeight in your example, it appears to be returning the TOTAL available
space where the font can reside which would be InternalLeading + Ascent + Descent + ExternalLeading.

Unless I'm doing something wrong (always a possibility) it appears that TEXTMETRIC does NOT return the correct values (to compute the font height) for VB controls -- other than for a Form and a Picturebox (Note: both a Form and Picturebox have Scale properties. Whether this is significant is unknown.)

Using the posted code (in the original post) if one deletes With Me.Text1 and substitutes just With Me -- or -- With Me.Picture1 the correct value is returned. For All other controls, TEXTMETRIC consistently returns the "same wrong value".

Can anyone explain why this occurs???

Bump

when you set the font.size, is the same value returned?
the sizes of font are not always maintained by controls, to test try like

Code:

---

For i = 1 To 100
    Text1.Font.Size = i
    Debug.Print Text1.Font.Size
Next

---

westconn1: Thanks for responding

Got It:
It APPEARS that ALL controls (except Form and Picturebox) create their Fonts when they gain Focus.
and destroy them when the control looses focus. Hence the Font does Not exist on the controls device context,
so the information is not avaialbe without reinstalling the Font on the DC..

Here's an example:

Code:

---


 
Private Sub GetFontHeight()

  '--------------------------------

    Dim hDC As Long
    Dim hWnd As Long
    Dim strFontName As String
    Dim lngFontSize As Long
   
  'Individual Font Variables
  Dim mymetrics As TEXTMETRIC
  Dim InternalLeading As Single
  Dim Ascent As Single
  Dim Descent As Single
  Dim ExternalLeading As Single
  Dim iHeight As Integer
  Dim VerifyFSizePoints As Single
  Dim VerifyHeightPixels As Integer
 
  '********
  'STARTUP
  '********
  '------------------------------
  'Get the New Font Data
  '---------------------------
  strFontName = "Tahoma"
  lngFontSize = 48
 
    '--------------------------------------
    'Get the Controls Device Context
    '--------------------------------------
    hWnd = Me.Text1.hWnd
    hDC = GetWindowDC(hWnd)
'    hDC = GetDC(hWnd)                  '<Alternative

  '--------------------------------------------------------
  'Install the New Font Information on the Device
  '--------------------------------------------------------
  Call fCreateFontIndirect(hDC, strFontName, lngFontSize)              'My Simplied Test Function
 
  '------------------------------------------
  'Assign the New Font to the Control
  '------------------------------------------
  Me.Text1.Font.Name = strFontName
  Me.Text1.Font.Size = lngFontSize
 
   
  '********
  'MAIN
  '********
  '-----------------------
  'Get Font Part Details of the Newly Assigned Font
  '------------------------
  GetTextMetrics hDC, mymetrics
  InternalLeading = mymetrics.tmInternalLeading
  Ascent = mymetrics.tmAscent
  Descent = mymetrics.tmDescent
  ExternalLeading = mymetrics.tmExternalLeading
 
  '-----------------------------------------
  'Calc the Font Height from Its Parts
  '----------------------------------------
  iHeight = Ascent + Descent - InternalLeading                       

  '---------------------------------------------
  'Verify the Height (in Pixels) is Correct
  '---------------------------------------------
  VerifyHeightPixels = ScaleY(Me.Text1.FontSize, vbPoints, vbPixels)
   
  '-----------------------------------
  'Verify the Font Size is Correct
  '-----------------------------------
  VerifyFSizePoints = ScaleY(iHeight, vbPixels, vbPoints)
 
 

  '********
  'WRAPUP
  '********
  Call ReleaseDC(hWnd, hDC)

End Sub

Private Sub fCreateFontIndirect(hDC As Long, strFontName As String, lngFontSize As Long)
  'Modified From:  'URL: http://www.allapi.net/
 
    Dim ThisFont As LOGFONT
    Dim rFont As Variant
   

    'Set the height of the font
    ThisFont.lfHeight = (lngFontSize * -20) / Screen.TwipsPerPixelY        '<< WHAT"S THE -20
   
    'Create the font
    rFont = CreateFontIndirect(ThisFont)
    If IsNull(rFont) Then
      MsgBox "fCreateFontIndirect Failed"
  End If
   
    'Select the font into the Controls device context
    Call SelectObject(hDC, rFont)

End Sub

---