Getting GetTextExtentExPoint to work...

[Graham R Seach]

Hi guys,

In Access 2000, I'm trying to find out the maximum number of a certain
character (MS Sans Serif lowercase "L") that will fit into a textbox, using
the GetTextExtentExPoint API. I just can't seem to get it to work, and I'm
hoping one of you kind people might be able to help.

Here's what I have now:

Private Const MM_TEXT = 1
Private Const MM_LOMETRIC = 2
Private Const MM_HIMETRIC = 3
Private Const MM_LOENGLISH = 4
Private Const MM_HIENGLISH = 5
Private Const MM_TWIPS = 6
Private Const MM_ISOTROPIC = 7
Private Const MM_ANISOTROPIC = 8

Private Type Size
cx As Long
cy As Long
End Type

Private Declare Function apiGetFocus Lib "user32" Alias "GetFocus" () As
Long
Private Declare Function GetTextExtentExPoint Lib "gdi32" Alias
"GetTextExtentExPointA" _
(ByVal hDC As Long, ByVal lpszStr As String, ByVal cchString As
Long, _
ByVal nMaxExtent As Long, lpnFit As Long, alpDx As Long, lpSize As
Size) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hDC As Long, ByVal
nMapMode As Long) As Long
Private Declare Function GetMapMode Lib "gdi32" (ByVal hDC As Long) As Long

Public Sub Init()
Dim lretval As Long
Dim hwnd As Long
Dim hDC As Long
Dim oldMapMode As Long
Dim lpszString As String
Dim SZ As Size
Dim lpnFit As Long
Dim ControlWidth As Long
Dim TextWidth As Long

'Get the control hwnd and hDC
MyTextBox.SetFocus
hwnd = apiGetFocus()
hDC = GetDC(hwnd)

'Get the current DC mapping mode, so we can change it back later
oldMapMode = GetMapMode(hDC)
'Change the DC mapping mode
SetMapMode hDC, MM_TWIPS

'Set the character we'll be using (a lowercase "L")
lpszString = "l" & Chr(0)
ControlWidth = MyTextBox.Width

'Get the maximum allowable number of characters we can put in the
textbox
lretval = GetTextExtentExPoint(hDC, lpszString, 1, MyTextBox.Width,
lpnFit, vbNull, SZ)
TextWidth = IIf(lretval > 0, lpnFit, 0)
Debug.Print TextWidth

'Reset the DC mapping mode
SetMapMode hDC, oldMapMode
End Sub

Regards,
Graham R Seach

[MikeD]

I don't use Access a whole lot, but doesn't it have a TextWidth method?
Seems to me you could use that method to accomplish what you want a helluva
lot easier than that API code which apparently doesn't work (I didn't bother
to test it though).

Perhaps posting to an Access newsgroup would get you better answers. VB and
Access are not the same thing.

Mike

"Graham R Seach" <gseach@NOSPAM_pacificdb.com.au> wrote in message
news:R5h89.311$16....@news.syd.ip.net.au...

[Monte Hansen]

At a a glance several things jump out at me.

First, Is MyTextBox.Width expressed in twips? If so, scale it to pixels.

Next, vbNULL is a "constant" that represents a data type in the VbVarType
enum, which equates to 1 not zero.

Finally, since alpDx is defined ByRef, if you want to pass a null value to
it, you will need to pass is like: ByVal 0&

Hope this helps.

+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+
Monte Hansen
http://KillerVB.com
+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+

"Graham R Seach" <gseach@NOSPAM_pacificdb.com.au> wrote in message
news:R5h89.311$16....@news.syd.ip.net.au...

[Graham R Seach]

Mike,

Thanks for your response. The Access TextWidth method returns the width of
an existing text string as it would appear in a report. It does not return
the maximum number of characters that *can* be placed into a container.

As my question is more related to using APIs in VBA, I believe the VB.API
group is the appropriate place to ask about this.

Regards,
Graham

"MikeD" <nob...@nowhere.edu> wrote in message
news:ekZX9T$RCHA.1836@tkmsftngp12...

[Graham R Seach]

Monte,

Thanks for your reply.

Yes, MyTextBox.Width is indeed expressed in twips. I figured that since I
was changing MapMode to MM_TWIPS, the width would not need to be converted.
Is this not so?

I used vbNull because GetTextExtentExPoint didn't seem to want to take
Chr(0), Null or vbNullString.

I take your point about ByVal 0&. Thanks.

Using the following, I get lpnFit = 1 (it should be something like 100):

lretval = GetTextExtentExPoint(hDC, lpszString, 1, MyTextBox.Width, lpnFit,

ByVal 0&, SZ)

Any other ideas?

Regards,
Graham

"Monte Hansen" <mo...@nospam.com> wrote in message
news:eg1O4Z$RCHA.1800@tkmsftngp13...

[Stephen Lebans]

Graham I wrote a replacement for the Report object's TextWidth/Height
methods that works for Forms as well. See:
http://www.lebans.com/textwidth-height.htm
--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

"Graham R Seach" <gse...@REPLY2NEWSGROUPpacificdb.com.au> wrote in
message news:u3OOK6$RCHA.1652@tkmsftngp09...

[Randy Birch]

Does this provide the answer for you? It uses GetTextExtent32 instead of
GetTextExtentExPoint, and seems to work regardless of the chr passed (at
least in VB). You may need to use a couple of additional APIs to retrieve a
hdc to use, but it should be pretty close.

Private Sub Command1_Click()

Dim numChrs As Long
Dim sChar As String

sChar = "l"
numChrs = CalcCharTextExtent(sChar, Text1)

If numChrs > 0 Then

'fill the textbox with the
'max number of chrs
Text1.Text = String(numChrs, sChar)

End If

End Sub

Private Function CalcCharTextExtent(sChar As String, txt As TextBox) As Long

Dim lf As LOGFONT
Dim sz As SIZE
Dim rc As RECT
Dim hdc As Long
Dim hFont As Long
Dim iStrMax_cx As Long
Dim numLetters As Long

'Get the font used to display button text,
'(normally ms sans serif) and select it into
'a device context
Call SystemParametersInfo(SPI_GETICONTITLELOGFONT, Len(lf), lf, 0)

hdc = GetDC(txt.hwnd)
hFont = CreateFontIndirect(lf)
Call SelectObject(hdc, hFont)

'remove the text borders temporarily
txt.BorderStyle = 0

'how big?
If GetTextExtentPoint32(hdc, sChar, Len(sChar), sz) = 1 Then

'how many of the specified letters fit?
CalcCharTextExtent = (Text1.Width \ Screen.TwipsPerPixelX) \ sz.cx

End If

'clean up
Call ReleaseDC(hwnd, hdc)
Call DeleteObject(hFont)

'restore border
txt.BorderStyle = 1

End Function

In case you can't find a particular call or value in the api viewer, here
are the declares :

Private Const LF_FACESIZE = 32
Private Const SPI_GETICONTITLELOGFONT = 31
Private Const SM_CXBORDER = 5

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Private Type SIZE

cx As Long
cy As Long
End Type

Private Declare Function SystemParametersInfo Lib "user32" Alias
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef
lpvParam As Any, ByVal fuWinIni As Long) As Long

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

Private Declare Function CreateFontIndirect Lib "gdi32" Alias
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias
"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal
cbString As Long, lpSize As SIZE) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal
hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
Long

--

Randy Birch
MVP Visual Basic
http://www.mvps.org/vbnet/
Please respond only to the newsgroups so all can benefit.

[Graham R Seach]

Randy,

Many thanks. Just looking at your code showed me the light. The following is
what I ended up with. It looks to have a 1 character-count error, depending
on the textbox width, but I can live with that. Thanks again.

Public Sub Init()
Dim lReturn As Long 'A utility return value.
Dim hDC As Long 'The screen device context handle.
Dim sChar As String 'The character being loaded into the control.
Dim lOldBorderStyle As Long 'The old border style of the control.
Dim lTwipsPerPixel As Long 'Pretty obvious!
Dim lDPI As Long 'The screen's current DPI.
Dim hFont As Long 'Logical font handle (MS Sans Serif).
Dim SZ As Size 'Size type.
Dim lf As LOGFONT 'Logfont type.
Dim rc As RECT 'Rect type.

On Error GoTo Init_ErrorHandler

'Get the font used to display button text (MS Sans Serif).
'Select the font into a device context.
'Note: Don't change the font, either here, or in MyTextBox!

Call SystemParametersInfo(SPI_GETICONTITLELOGFONT, Len(lf), lf, 0)

hDC = GetDC(0&) 'Get a device context (screen).
lDPI = GetDeviceCaps(hDC, LOGPIXELSX) 'Get the screen's current DPI.
lTwipsPerPixel = TWIPSPERINCH / lDPI 'Calculate twips per pixel.

hFont = CreateFontIndirect(lf) 'Create the logical font.
Call SelectObject(hDC, hFont) 'Select the font.

'Temporarily remove the control's borders.
lOldBorderStyle = Me.MyTextBox.BorderStyle
Me.MyTextBox.BorderStyle = 0

'Set the character we'll be using (a lowercase MS San Serif "L").
sChar = "l" 'Note: Don't change this!

'Get the maximum allowable number of characters we can put in MyTextBox.
lReturn = GetTextExtentPoint32(hDC, sChar, Len(sChar), SZ)

If lReturn = 1 Then
lTextWidth = (Me.MyTextBox.Width \ lTwipsPerPixel) \ SZ.cx
Else
lTextWidth = 0
End If

'Clean up
Call ReleaseDC(0&, hDC) 'Release the DC.
Call DeleteObject(hFont) 'Release the font.

'Restore the control's border style.
Me.MyTextBox.BorderStyle = lOldBorderStyle

Exit_Init:
Exit Sub

Init_ErrorHandler:
RaiseEvent Error(Err.Number & vbCrLf & Err.Description)
Resume Exit_Init
End Sub

Regards,
Graham R Seach

"Randy Birch" <r...@mvps.org> wrote in message
news:#cGkzJLSCHA.1676@tkmsftngp12...

[Graham R Seach]

Stephen,

Thanks for your code. It looks pretty damned good!

I took Randy's advice (see his post below) and switched to a slightly
different API. He also provided the missing link (setting the logical font
in the DC), which I used. It's all working fine now.

Thanks again.

Regards,
Graham R Seach

"Stephen Lebans" <Stephe...@mvps.org> wrote in message
news:evQ40IFSCHA.4328@tkmsftngp09...

[Stephen Lebans]

Graham there are a couple of other variables involved. I haven't worked
on this in a while but if I remember correctly:

1) Access, prior to A2K, always left a 2 pixel left hand margin when
rendering the contents of a TextBox. A2K or higher also has a Left
margin property.

2) WHen Access draws the Border of a TextBox control, it renders the
border centered on the edge of the TextBox control. A wide enough border
will be drawn both inside and outside of the control therefore reducing
the space available to render text.

If you have a look at the older FormatByCriteria code on my site I think
it explains this in detail. Also if examine the code behind the
TextWIdthHeight function I pointed you to I think it mentions this fudge
factor.

Finally if you are considering following your logic for Reports and not
just Forms you really should be using the Printer's DC for your
calculations.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

"Graham R Seach" <gse...@REPLY2NEWSGROUPpacificdb.com.au> wrote in

message news:u1dH7TRSCHA.3732@tkmsftngp11...

[Monte Hansen]

Yeah, didn't notice that you changed the mapping mode.

It' sounds like your on the way. But just for kix, you might also try the
Wide version of that function, which is supported on all Win32 platforms.
I've never had the Wide version fail for me:

Private Declare Function GetTextExtentExPointW Lib "gdi32" _
(ByVal hDC As Long, ByVal lpszStr As Long, ByVal cchString As Long, _
ByVal nMaxExtent As Long, lpnFit As Long, _

alpDx As Long, lpSize As Size) As Long

Private Declare Function GetTextExtentPointW Lib "gdi32" _
(ByVal hDC As Long, ByVal lpszString As Long, _
ByVal cbString As Long, lpSize As Size) As Long

Private Declare Function GetTextExtentPoint32W Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As Long, _
ByVal cbString As Long, lpSize As Size) As Long

+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+
Monte Hansen
http://KillerVB.com
+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+

"Graham R Seach" <gse...@REPLY2NEWSGROUPpacificdb.com.au> wrote in message

news:u3OOK6$RCHA.1652@tkmsftngp09...

[Michael (michka) Kaplan]

There are actually several subtle bugs for the "W" function when you are on
Win9x (particular on Win95).

--
MichKa

Michael Kaplan
Trigeminal Software, Inc. -- http://www.trigeminal.com/

International VB? -- http://www.i18nWithVB.com/
C++? MSLU -- http://msdn.microsoft.com/msdnmag/issues/01/10/

"Monte Hansen" <mo...@nospam.com> wrote in message

news:eJ#mE6VSCHA.1668@tkmsftngp13...

[Monte Hansen]

Thanks for the heads up. That's good to know.

And it's yet another good reason to dump Win9X <bg>.

+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+
Monte Hansen
http://KillerVB.com
+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+

"Michael (michka) Kaplan" <mic...@spamless.trigeminal.nospamcom> wrote in
message news:#Aks7#VSCHA.1632@tkmsftngp11...

[Michael (michka) Kaplan]

(as if we needed another reason?)

<grin>

MichKa

"Monte Hansen" <mo...@nospam.com> wrote in message

news:OoCcpEWSCHA.1804@tkmsftngp13...

[Monte Hansen]

There you go again <grin>

+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+
Monte Hansen
http://KillerVB.com
+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+

"Michael (michka) Kaplan" <mic...@spamless.trigeminal.nospamcom> wrote in

message news:#BW2WQWSCHA.2008@tkmsftngp12...

[Graham R Seach]

Stephen,

Thanks heaps for the info. That certainly explains the anomaly I observed. I
will take a look at both the FormatByCriteria and TextWIdthHeight code.

I was aware that I should use the printer's DC for reports, but I just
wanted to get it working first.

Again, many thanks. :-)

Regards,
Graham R Seach

"Stephen Lebans" <Stephe...@mvps.org> wrote in message

news:uNCIAyUSCHA.2024@tkmsftngp08...

[Graham R Seach]

Monte,

Thanks for your continuing support on this, but I ended up taking Randy's
advice and using GetTextExtentPoint32. I have it working now, and with
Stephen having explained how Access renders borders, I'll soon (hopefully)
resolve the only small anomaly I have.

Regards,
Graham R Seach

"Monte Hansen" <mo...@nospam.com> wrote in message

news:eJ#mE6VSCHA.1668@tkmsftngp13...

[Monte Hansen]

Well, I can definately babble with the best. Well maybe not as good as Joe
nuke-me-xemo.

The bleeping last word my friend. =] But i'm just giving you a hard time cuz
no else will.

+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+
Monte Hansen
http://KillerVB.com
+|+|+|+|+|+|+|+|+|+|+|+|+|+|+|+

"Michael (michka) Kaplan" <mic...@spamless.trigeminal.nospamcom> wrote in

message news:#RcA5LXSCHA.1876@tkmsftngp13...
> What in the bleeping heck are you babbling about?

>
> MichKa
>
> "Monte Hansen" <mo...@nospam.com> wrote in message

> news:e5yKtmWSCHA.1640@tkmsftngp11...

[Michael (michka) Kaplan]

What in the bleeping heck are you babbling about?

MichKa

"Monte Hansen" <mo...@nospam.com> wrote in message

news:e5yKtmWSCHA.1640@tkmsftngp11...