I have a textbox where the Font is set at:
Font Name: Tahoma
Font Size: 8.25.
I am now trying to get this information (using API not VB) from the textbox during routine.
I have two different routines and NEITHER returns the above Font Size NOR does either routine return the same information
Routine1: (Returns Text Length = 36, Text Height = 16):
Routine2 (Returns Text Length = 28, Text Height = 13):
QUESTIONS:
1) What am I getting back?
2) How does the 8.25 Font Size shown in Textbox properties correlate with the Height property (in pixels) returned by the above procedures?
Font Name: Tahoma
Font Size: 8.25.
I am now trying to get this information (using API not VB) from the textbox during routine.
I have two different routines and NEITHER returns the above Font Size NOR does either routine return the same information
Routine1: (Returns Text Length = 36, Text Height = 16):
Code:
'**************************************
' Name: Get text size in pixels
' Description:How to get the width and height from a character or a complete string? here is a simple piece of code to get that
' Source: My modification of: http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=31934&lngWId=1
Public Sub GetTextSize2(ctrl As Control, strText As String)
#If kDEBUGON Then
Debug.Print "Begin GetTextSize2"
#End If
On Error GoTo Error_GetTextSize2
'-----------------
Dim TextSize As POINTAPI
Dim hDC As Long
'*******
'STARTUP
'*******
'*****
'MAIN
'*****
hDC = GetDC(ctrl.hwnd)
Call GetTextExtentPoint32(hDC, strText, Len(strText), TextSize)
MsgBox "The size from '" & strText & "'" & vbCrLf & "Width : " & TextSize.X & " Pixels" & vbCrLf & "Height : " & TextSize.Y & " Pixels", vbInformation
'*******
'WRAPUP
'*******
#If kDEBUGON Then
Debug.Print "End GetTextSize2"
#End If
Exit Sub
Error_GetTextSize2:
End SubCode:
Public Function GetTextSize(ctrl As Control, Text As String, font As StdFont) As SIZE
' GetTextSize
' -> Measures the size in pixels of a string, given a particular font. This uses
' the GetTextExtentPoint32 API to measure the string. The API is defined as
' follows:
'
' GetTextExtendPoint(ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE)
' hdc: The device context which is attached to the font to be used
' lpsz: The string to measure, based on the font contained in the hdc specified
' cbString: The length of the string which was passed in 'lpsz'
' lpSize: The SIZE structure which the measurements will be returned to
Dim tempDC As Long
Dim tempBMP As Long
Dim f As Long
Dim lf As LOGFONT
Dim TextSize As SIZE
' Create a device context and a bitmap that can be used to store a
' temporary font object
tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
' Assign the bitmap to the device context
DeleteObject SelectObject(tempDC, tempBMP)
' Set up the LOGFONT structure and create the font
lf.lfFaceName = font.Name & Chr$(0)
lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(GetDC(ctrl.hwnd), LOGPIXELSY), 72)
lf.lfItalic = font.Italic
lf.lfStrikeOut = font.Strikethrough
lf.lfUnderline = font.Underline
If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
f = CreateFontIndirect(lf)
' Assign the font to the device context
DeleteObject SelectObject(tempDC, f)
' Measure the text, and return it into the textSize SIZE structure
GetTextExtentPoint32 tempDC, Text, Len(Text), TextSize
' Clean up (very important to avoid memory leaks!)
DeleteObject f
DeleteObject tempBMP
DeleteDC tempDC
' Test the Return measurements
' Dim x As Long
' Dim y As Long
' x = textSize.cx
' y = textSize.cy
GetTextSize = TextSize
End Function1) What am I getting back?
2) How does the 8.25 Font Size shown in Textbox properties correlate with the Height property (in pixels) returned by the above procedures?