Results 1 to 8 of 8

Thread: Get Textbox Font Height

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    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

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    Re: Get Textbox Font Height

    Bump --- NO ONE?

  3. #3
    Fanatic Member
    Join Date
    Mar 2009
    Posts
    804

    Re: Get Textbox Font Height

    Font size is not the same as text height
    Code:
     Font.Name = "Tahoma"
     Font.Size = 9
     ScaleMode = vbPixels
     Debug.Print Font.Size, TextHeight("")

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    Re: Get Textbox Font Height

    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.

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    Re: Get Textbox Font Height

    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???
    Last edited by dw85745; Aug 20th, 2012 at 10:06 PM. Reason: improve english

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    Re: Get Textbox Font Height

    Bump

  7. #7
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Get Textbox Font Height

    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
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Jul 2001
    Location
    Tucson, AZ
    Posts
    2,166

    Re: Get Textbox Font Height

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width