ACC: How to Limit Number of Characters to Size of Text Box

MORE INFORMATION

The following information includes a Visual Basic for Applications procedure, LimitTextToControlWidth, that can be called from the KeyPress event of a text box to limit the amount of text entered so that the sum of the width of all characters in the text does not exceed the width of the text box.

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.

There are a number of factors that affect the width of text. The larger the font size, the fewer the characters that you will be able to type. The selection of font 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, for the same font size, the letter "i" in one font may have a different width in another font. 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. This API function can only be called from the control that has focus on a Microsoft Access form.

32 Bit Code - Microsoft Access 97 and Microsoft Access 7.0

1. 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
   						

2. 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
   						

16-Bit Code - Microsoft Access 2.0

NOTE: In the following sample code, an underscore (_) at the end of a line is used as a line-continuation character. Remove the underscore from the end of the line when re-creating this code in Access Basic,

1. 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 Integer
            cy As Integer
         End Type
   
         Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
         Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, _
            ByVal nIndex As Integer) As Integer
         Declare Function GetTextExtentPoint Lib "GDI" (ByVal hDC As _
              Integer, ByVal lpszString As String, ByVal cbString As _
              Integer, lpSIZE As SIZE) As Integer
         Declare Function GetFocus Lib "User" () As Integer
         Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, _
            ByVal hDC As Integer) As Integer
   						

2. Type the following procedures:

         S
         Sub LimitTextToControlWidth (KeyAscii)
            Dim AC As Control
            Dim Txt As String
            Dim TxtWidth As Integer, SpaceWidth As Integer
            Dim hWnd As Integer, hDC As Integer
            Dim lpSIZE As SIZE
            Dim RetVal As Integer
   
            '' 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
   
         Sub ConvertPixelsToTwips (X As Integer, Y As Integer)
            Dim hDC As Integer, hWnd As Integer, RetVal As Integer
            Dim XPIXELSPERINCH As Integer, YPIXELSPERINCH As Integer
   
            '' 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
   						

How to use the LimitTextToControlWidth Procedure

1. Create a new, blank form not based on any table or query.
2. Place 3 text boxes on the form with the following properties:

   Name: One
   Left: 1"
   Top: .5"
   Width: 1"
   Height: 0.1667"
   FontName: Arial
   FontSize: 12
   
   Name: Two
   Left: 1"
   Top: 1"
   Width: 1"
   Height: 0.1667"
   FontName: Arial
   FontSize: 8
   
   Name: Three
   Left: 1"
   Top: 1.5"
   Width: 1"
   Height: 0.3743"
   FontName: Arial
   FontSize: 24

3. 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
   						

4. 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