ACC2000: How to Limit Number of Characters to Size of Text Box
ID: Q198649
|
The information in this article applies to:
Advanced: Requires expert coding, interoperability, and multiuser skills.
SUMMARY
This article shows you how to limit the amount of text a user can type into a text box so that the width of the text does not exceed the width of the text box.
Microsoft provides programming examples for illustration only, without warranty
either expressed or implied, including, but not limited to, the implied warranties of
merchantability and/or fitness for a particular purpose. This article assumes that you
are familiar with the programming language being demonstrated and the tools used to
create and debug procedures. Microsoft support professionals can help explain the functionality
of a particular procedure, but they will not modify these examples to provide added
functionality or construct procedures to meet your specific needs. If you have limited
programming experience, you may want to contact a Microsoft Certified Solution Provider
or the Microsoft fee-based consulting line at (800) 936-5200. For more information about
Microsoft Certified Solution Providers, please see the following page on the World Wide Web:
http://www.microsoft.com/mcsp/
For more information about the support options available from Microsoft, please see the
following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/overview/overview.asp
MORE INFORMATION
What follows is a Visual Basic for Applications procedure, LimitTextToControlWidth, that you can call from the KeyPress
event of a text box to limit the amount of text a user can enter.
This procedure is ideal for developers who want to use a non-
proportionally spaced font to print text into a fixed location on a pre-
printed form. The LimitTextToControlWidth procedure ensures that a user
will not be able to type more text than can fit in the defined area on the
form.
A number of factors affect the width of text. The larger the font size, the fewer the characters that you can type. The font that you select also affects the width of characters in the text. Characters in a non-proportionally spaced font, such as Arial or Times New Roman, have different widths. The letter "i" is narrower in width than the letter "X." In addition, the letter "i" in one font may have a different width in another font. For example, the "i" in Arial font is much narrower than the "i" in Courier New font.
The following steps provide both 16-bit and 32-bit versions of the
procedure, followed by an example of how to apply the procedure to
controls on a form.
NOTE: The following code uses the GetTextExtentPoint Windows application programming interface (API) function. You can call this API function only from the control that has focus on an Access form.
- Create a new module and type the following in the Declarations section:
Option Explicit
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440
Type Size
cx As Long
cy As Long
End Type
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Declare Function GetFocus Lib "user32" () As Long
Declare Function GetTextExtentPoint Lib "gdi32" Alias _
"GetTextExtentPointA" (ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSIZE As Size) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
- Type the following procedures:
Sub ConvertPixelsToTwips(X As Long, Y As Long)
Dim hDC As Long, hWnd As Long, RetVal As Long
Dim XPIXELSPERINCH As Long, YPIXELSPERINCH As Long
'' Retrieve the current number of pixels per inch, which is
'' resolution-dependent.
hDC = GetDC(0)
XPIXELSPERINCH = GetDeviceCaps(hDC, LOGPIXELSX)
YPIXELSPERINCH = GetDeviceCaps(hDC, LOGPIXELSY)
RetVal = ReleaseDC(0, hDC)
'' Compute and return the measurements in twips.
X = (X / XPIXELSPERINCH) * TWIPSPERINCH
Y = (Y / YPIXELSPERINCH) * TWIPSPERINCH
End Sub
Sub LimitTextToControlWidth(KeyAscii As Integer)
Dim AC As Control
Dim Txt As String
Dim TxtWidth As Long, SpaceWidth As Long
Dim hWnd As Long, hDC As Long
Dim lpSIZE As Size
Dim RetVal As Long
'' Exit if a non-printable character is typed.
If KeyAscii < 32 Then Exit Sub
'' Record active control.
Set AC = Screen.ActiveControl
'' Get the control text.
Txt = AC.Text & ""
'' Append typed character into the text.
If KeyAscii > 32 Then
Txt = Left(Txt, AC.SelStart)
Txt = Txt & Chr$(KeyAscii)
Txt = Txt & Mid(Txt, AC.SelStart + 1 + AC.SelLength)
End If
hWnd = GetFocus()
hDC = GetDC(hWnd)
'' Compute the width of the text.
RetVal = GetTextExtentPoint(hDC, Txt, Len(Txt), lpSIZE)
ConvertPixelsToTwips lpSIZE.cx, lpSIZE.cy
TxtWidth = lpSIZE.cx
'' Compute width of a space.
RetVal = GetTextExtentPoint(hDC, " ", 1, lpSIZE)
ConvertPixelsToTwips lpSIZE.cx, lpSIZE.cy
SpaceWidth = lpSIZE.cx
'' Are there trailing spaces to contend with?
If AC.SelStart + 1 > Len(Txt) Then
'' Add number of spaces * SpaceWidth to width of string.
TxtWidth = TxtWidth + ((AC.SelStart + 1 - Len(Txt)) * _
SpaceWidth)
End If
If TxtWidth + (SpaceWidth / 2) > AC.Width Then
Beep
KeyAscii = 0
End If
End Sub
How to use the LimitTextToControlWidth Procedure
- Create a new, blank form not based on any table or query, with the following properties:
Form: Test1
-----------------
Caption: TestForm
Text box
---------------
Name: One
Left: 1"
Top: .5"
Width: 1"
Height: 0.1667"
FontName: Arial
FontSize: 12
Text box
---------------
Name: Two
Left: 1"
Top: 1"
Width: 1"
Height: 0.1667"
FontName: Arial
FontSize: 8
Text box
---------------
Name: Three
Left: 1"
Top: 1.5"
Width: 1"
Height: 0.3743"
FontName: Arial
FontSize: 24
- Call the LimitTextToControlWidth procedure from the KeyPress event of
each text box above, for example:
Sub One_KeyPress(KeyAscii As Integer)
LimitTextToControlWidth KeyAscii
End Sub
- View the form and try typing the following text in each text box:
This is a test of the emergency broadcast system
Note that the result appears as follows:
Text box Text allowed to type
---------------------------------
One This is a test
Two This is a test of the
Three This is
Additional query words:
Keywords : kbusage FmsHowto
Version : WINDOWS:2000
Platform : WINDOWS
Issue type : kbhowto
|