Width of specific text in pixels

[Juan Pablo González]

I know I've seen this, a combobox that autoadjustes itself to the longest entry in there, but I don't remember where I saw that ! What I need is find out how "long" a text (In a specific font name, size and style) is, in pixels, so i can set the column width to that... any ideas ?

 

[Mark O'Brien]

This is basically a bump of this thread, but I'm kind of curious for the answer myself on this one. (except I'm more interested in height, not width)

_________________<font color = green> Mark O'Brien
This message was edited by Mark O'Brien on 2002-08-23 12:51

 

[Juan Pablo González]

Thanks for the *bum* Mark... Have been looking in Bullen's, Pearson's, Walchenback's, Erlandsen's, Beyond Techonology... still, no luck... I KNOW I saw it, I remember that... didn't find it useful that time ! mhmm, now that I think of it, maybe I have it at home...

 

[Mark O'Brien]

Duh, I just pulled out my Dan Appleman API book there. I'm just going out for dinner, but this should get you started (no explicit examples in the book), look for these API's:

GetCharABCWidths (for true type fonts)
GetChartABCWidthsFloat
GetCharWidth (probably the most useful one)
GetCharWidth32 (probably even more usefuller)
GetCharWidthFloat

Note:

A-B-C

A is the width from the start of the character block (i.e. left hand side) to the actual start of the character
B is the actual width of the character
C is the same as A, except obviously, it is the whitespace from the end of the character to the right hand side of the character block.

Right, Mi Mexico, here we come.

 

[Juan Pablo González]

Ahh... I think I found it:

http://www.freevbcode.com/ShowCode.Asp?ID=1800

Edit: Close, but not on the spot... still looking.
_________________
Regards,

Juan Pablo G.
MrExcel.com Consulting
This message was edited by Juan Pablo G. on 2002-08-23 17:22

 

[Juan Pablo González]

Ok, maybe the link can be used. Because using this:
<pre> DrawText lParentHDC, Combo.List(lCtr), -1, rectCboText, _
DT_CALCRECT
'adjust the number added (20 in this case to
'achieve desired right margin
lTempWidth = rectCboText.Right - rectCboText.Left + 20</pre> lTempWidth returns the "desired" width of the combobox.

DT_CALCRET is a constant = &H400
lParentHDC is this
lParentHDC = Combo.Parent.hdc

which is the same as

Form1.hdc

rectCboText is defined as RECT
Dim rectCboText As RECT

So, now the question is... do all windows have a hdc ? how do I get it ? apparently the DrawText function works with the current font of the form, not of the ComboBox itself...wich makes me wonder If I could do that with an Excel worksheet...

Still looking...

 

[Juan Pablo González]

I spoke to soon, again, about Stephen Bullen's... it's not "directly" in there, but, in the ListCols.zip example, he has all the needed code to get the width of the text. Sorry Mark, I don't see anything about Height...

Edit: Again... man, there's something wrong with me ! Mark, Apparently the funTextWidth32 can also return the height, if instead of using

TextSize.cx / 20

you use

TextSize.cy / 20
_________________
Regards,

Juan Pablo G.
MrExcel.com Consulting
This message was edited by Juan Pablo G. on 2002-08-24 08:56

 

[Legacy 98055]

Hi Juan.
<pre>
Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hdc As Long) As Long

Public Function GethDC(myControl As Control) As Long
Dim hdc As Long, FreeAPI As Long, VBA_form_hWnd As Long

VBA_form_hWnd = CreateFunctionToGetHandle myControl.Parent
'you will need to get the handle for your userform here
'I create dll's when I run into VBA limitations and have, therefor, not
'learned how to get the handle in VBA. I think it is fairly simple and
'I believe Mark has posted the necc. API's to gather it on our board.

hdc = GetDC(VBA_form_hWnd)
FreeAPI = ReleaseDC(VBA_form_hWnd, hdc)
GethDC = hdc
End Function

Function CreateFunctionToGetHandle(myForm As Object) As Long
'get your handle here
End Function

</pre>

These functions were taken out of VB help files and
edited to the best of my ability. Why does VBA not include
the properties which are included with VB?

HTH,
Tom

PS
hDC = Handle Device Context.
The helpfiles recommend that you do not store the handle
in a variable because it changes, but to call the function
everytime you need it.

 

[Juan Pablo González]

Tom, thanks. I'm still trying to get pass the API maze... , but I did find this one.

Name: GetTextExtentPoint32

Description: The GetTextExtentPoint32 function computes the width and height of the specified string of text. This function supersedes the GetTextExtentPoint function.

Declaration:

Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long

Where POINTAPI is a defined type, as follows

Private Type POINTAPI
X As Long
Y As Long
End Type

Bullen uses this functions to get the hWnd and hDC of Excel:

'Get the handle of the main Excel window, which we can use for the device context
hWnd = FindWindow32("XLMAIN", Application.Caption)

'Get a device context for the window
hDC = GetDC32(hWnd)

 

[Juan Pablo González]

Here's what I came up with:<pre>Option Explicit

Type SIZE32
cx As Long
cy As Long
End Type

Const MM_TWIPS = 6

Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetDC32 Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
Declare Function GetMapMode32 Lib "gdi32" Alias "GetMapMode" ( _
ByVal hDC As Long) As Long
Declare Function SetMapMode32 Lib "gdi32" Alias "SetMapMode" (ByVal hDC As Long, _
ByVal nMapMode As Long) As Long
Declare Function CreateFont32 Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, _
ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, _
ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, _
ByVal F As String) As Long
Declare Function SelectObject32 Lib "gdi32" Alias "SelectObject" ( _
ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPointA" ( _
ByVal hDC As Long, ByVal lpszString As String, ByVal cbString As Long, _
lpSIZE32 As SIZE32) As Long
Declare Function DeleteObject32 Lib "gdi32" Alias "DeleteObject" ( _
ByVal hObject As Long) As Long
Declare Function ReleaseDC32 Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long

Function TextSize(ByVal sText, sFontName As String, iFontSize As Long, _
iFontWeight As Long, Width As Boolean)
'iFontWeight = 400 not bold, 700 bold

Dim iOldMapMode As Long
Dim hOldFont As Long
Dim hWnd As Long
Dim hDC As Long
Dim hFont As Long

Dim a As Long

'Declare a variable to store the text dimensions
Dim TSize As SIZE32

hWnd = FindWindow32("XLMAIN", Application.Caption) 'Get the handle of the main Excel window, which we can use for the device context
hDC = GetDC32(hWnd) 'Get a device context for the window
iOldMapMode = GetMapMode32(hDC) 'Store the old mapping mode
a = SetMapMode32(hDC, MM_TWIPS) 'Set the new mapping mode to Twips (1/20 of a point - VBA functions use points)
hFont = CreateFont32(iFontSize * -20, 0, 0, 0, iFontWeight, 0, 0, 0, 0, 0, _
0, 0, 0, _
sFontName) 'Create a font object with the correct size, weight and style
hOldFont = SelectObject32(hDC, hFont) 'Load the font into the device context, storing the original font object
a = GetTextExtentPoint32(hDC, sText, Len(sText), TSize) 'Get the text dimensions
hFont = SelectObject32(hDC, hOldFont) 'Retrieve the original font back into the device context
a = SetMapMode32(hDC, iOldMapMode) 'Reset the original mapping mode
a = DeleteObject32(hFont) 'Delete the font object we created
a = ReleaseDC32(hWnd, hDC) 'Release the device context
If Width Then
TextSize = TSize.cx / 20 'Return the width in points (The API call returns values in twips = 1/20pt)
Else
TextSize = TSize.cy / 20
End If
End Function</pre>
To set the "actual" column width to fit the text, I had to multiply the result of this function by 0.224638. Don't ask why, but, that worked... for row height, It worked ok by itself.

I used it like this:<pre>Sub Test()
Dim Rng As Range
Dim Cll As Range

Set Rng = Range("H17:J19")
For Each Cll In Rng
If Len(Cll) Then
Cll.EntireColumn.ColumnWidth = TextSize(Cll.Value, Cll.Font.Name, _
Cll.Font.Size, IIf(Cll.Font.Bold, 700, 400), True) * 0.224638
Cll.EntireRow.RowHeight = TextSize(Cll.Value, Cll.Font.Name, _
Cll.Font.Size, IIf(Cll.Font.Bold, 700, 400), False)
End If
Next Cll
End Sub</pre>
This is a funny post, I had a nice conversation with myself ! :wink: anyway, thanks Mark and Tom for your assistance.

_________________
Regards,

Juan Pablo G.
MrExcel.com Consulting
This message was edited by Juan Pablo G. on 2002-08-24 10:13
This message was edited by Juan Pablo G. on 2002-08-24 10:15