-
Aug 15th, 2012, 10:09 PM
#1
Thread Starter
PowerPoster
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
-
Aug 16th, 2012, 01:07 PM
#2
Thread Starter
PowerPoster
Re: Get Textbox Font Height
-
Aug 17th, 2012, 07:23 AM
#3
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("")
-
Aug 17th, 2012, 08:36 AM
#4
Thread Starter
PowerPoster
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.
-
Aug 20th, 2012, 01:55 PM
#5
Thread Starter
PowerPoster
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
-
Aug 22nd, 2012, 08:10 AM
#6
Thread Starter
PowerPoster
Re: Get Textbox Font Height
-
Aug 23rd, 2012, 04:34 PM
#7
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
-
Aug 24th, 2012, 08:50 AM
#8
Thread Starter
PowerPoster
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|