Solved

VB6 How can I adjust maximum characters in a textbox depending on width of text entered so far?

Posted on 2009-04-12
12
1,095 Views
Last Modified: 2013-12-20
I need to optimize the maxchars allowed in a VB6 textbox.  It makes a big difference in the maximum number of characters that will fit if the users enter wide letters like "WWW" or narrow letters like "iii".  Since textbox.maxchars can't be changed at runtime, I'm using code in the keypress event to limit the number of characters.  

I found there may be a potential solution using a hidden picturebox to determine the width of text entered so far to determine if more characters should be allowed in the textbox.  But I have not been able to get this work very accurately yet.

intWidthRemaining = Textbox1.Width - PictureboxHidden.TextWidth(Textbox1.text)
intMaxWidthOfPossibleNextChar = PictureboxHidden.TextWidth("W")
If intWidthRemaining > intMaxWidthOfPossibleNextChar Then blnAllowAnotherCharToBeTyped

Can a picturebox be used to determine the width of the text entered so far?  Or, is there an api call that could tell me if a textbox has room for more characters?  
0
Comment
Question by:SteveQ2
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
  • 3
  • +2
12 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24125844
Hello SteveQ2,

You could select the textbox font to be a fixed rather than proportional font?

Regards,
Chris
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 24125875
(haven't tried this yet)

Can you change the character limit at run-time with this API?

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    Private Const EM_LIMITTEXT = &HC5

    ...
        SendMessage Text1.hwnd, EM_LIMITTEXT, 5, 0&
0
 

Author Comment

by:SteveQ2
ID: 24126025
Chris_Bottomley,  
I need to keep a proportional font.  The current font setting is Arial 8.  

Idle_Mind,
That API method might be very helpful to reset the character limit but first I need to determine how many characters will fit in the textbox after the user start to type in the textbox.  The number of maxchars or limittext would be very different if the users enter characters like "WWW" or "iii".
0
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 
LVL 22

Expert Comment

by:danaseaman
ID: 24126050
You must set PictureboxHidden Font to the same Font as Textbox1, Otherwise PictureboxHidden.TextWidth result will not be accurate.
0
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 24131951
If you know how to call API functions, the API function GetTextExtentPoint32() can be used to determine the text width.  You should be able to pass the API function the hDC of your TextBox.  The only difficulty is that the return value is likely in pixels, while the dimensions of your TextBox are likely in twips.
0
 
LVL 22

Expert Comment

by:danaseaman
ID: 24134453
Here is API function to return TextWidthA.
Note that TextBox hDc is not exposed so you need to call another API GetDc.
To return as Twips just multiply by Screen.TwipsPerPixelX.

Option Explicit
 
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, ByRef lpSize As Size) As Long
Private Type Size
   cx As Long
   cy As Long
End Type
 
Private Sub Command1_Click()
   Debug.Print "TextWidthA(Text1)", TextWidthA(Text1)
End Sub
 
Private Function TextWidthA(tb As TextBox) As Long
    Dim sz As Size
    Call GetTextExtentPoint32(GetDC(tb.hwnd), tb.Text, Len(tb.Text), sz)
    TextWidthA = sz.cx * Screen.TwipsPerPixelX
End Function

Open in new window

0
 

Author Comment

by:SteveQ2
ID: 24138181
Danaseaman,

The api calls you have supplied seem like they have alot of potential but they're still giving me very different results if the text I type in is "WWW" or "iiiii".  

I've attached the code I'm running.  It's very similar to the code you supplied but I've added some debugging info to see what it's doing.  Any ideas how I can get it to work as well if the user enters alot of narrow characters as it seems to work if they enter all wide upper case letters?

Option Explicit
' This code requires a new blank form, 1 textbox, and 1 label
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, ByRef lpSize As Size) As Long
Private intWidthOfTextboxText As Integer
Private intWidthOfWidestPossibleChar As Integer
Private intWidthOfNarrowestPossibleChar As Integer
Private Type Size
   cx As Long
   cy As Long
End Type
Private Sub Form_Load()
   Label1.Width = 6000
   Text1.Text = "W"
   TextWidthA Text1
   intWidthOfWidestPossibleChar = intWidthOfTextboxText
   MsgBox "Widest possible character W: " & intWidthOfWidestPossibleChar
   Text1.Text = "i"
   TextWidthA Text1
   intWidthOfNarrowestPossibleChar = intWidthOfTextboxText
   MsgBox "Narrowest possible character i: " & intWidthOfNarrowestPossibleChar
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
  TextWidthA Text1
End Sub
Private Function TextWidthA(tb As TextBox) As Long
    Dim sz As Size
    Call GetTextExtentPoint32(GetDC(tb.hwnd), tb.Text, Len(tb.Text), sz)
    intWidthOfTextboxText = sz.cx * Screen.TwipsPerPixelX
    Label1.Caption = "Text width is in ok range: " & intWidthOfTextboxText
    If intWidthOfTextboxText >= Text1.Width Then
       Label1.Caption = "Text exceeds " & Text1.Width & ": " & intWidthOfTextboxText
    End If
 End Function
0
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 24139012
First, let me make sure I understand what you are trying to do.  
You want to limit the number of characters a user can type into a TextBox.  Your limit is basically the visual size of the TextBox (i.e. you don't want charaters to start strolling).  So basically, if the user types lots of narrow characters, they are allowed to enter more characters into the TextBox than if they use lots of wide characters.  To accomplish this, you are using a Key event to determine if the new character Keyed plus the existing text will fit within the viewable area of the Text Box.

But you are running into a problem, because what you've programmed might work for all WWW but doesn't work for iii, and if you make adjustments for iii, then WWW doesn't work.

First of all, I'd like to suggest that you simply use the KeyPress Event rather than the KeyUp event.  That way, you are only looking at characters that are going to be entered into the textbox rather than looking at every single time a key (like arrow keys) are pressed.  In the new character won't fit, you simply change the character to zero.

As for WWW v. iii, you have to keep in mind that you are only interested in the printable section of the TextBox, not the full size of the TextBox, because the full size of the TextBox includes things like the border of the textbox that is printed.

Listed below is some pseudo-code to demonstrate the idea...
Private Sub Text1_KeyUp( KeyAscii As Integer )
Dim TextBoxWidth as Integer
Dim NewTextWidth as Long
 
  TextBoxWidth = GetClientWidth( Text1.hwnd ) 
  NewTextWidth = GetTextWidth( Text1.hwnd, Text1.Text & Chr( KeyAscii )
  if NewTextWdith > TextBoxWidth then
    KeyAscii = 0
  end if
end sub
 
GetClientWidth( hwnd as long ) as long
  Dim R as RECT
  GetClientRect( hwnd, R )
  GetClientWidth = R.right - R.left
end function
  
GetTextWidth( hwnd as long, Text as String ) as long
  Dim sz as Size
  Call GetTextExtentPoint32( GetDC( hwnd), Text, Len( Text ), sz)
  GetTextWidth = sz.cx * Screen.TwipsPerPixelX
endf function 
 
'Here's the additional API declares needed that you might not already have
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Declare Function GetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As RECT) As Long

Open in new window

0
 

Author Comment

by:SteveQ2
ID: 24139862
I can see you understand what I'm trying to accomplish but it doesn't look like GetTextExtentPoint32 is doing it yet.  I can type "WWWWWW" or "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" before any characters scroll out of sight in a textbox with a width of 1215.  According to GetTextExtentPoint32, the wide letters have a width of 1260 before any characters scroll out of sight.  But GetTextExtentPoint32 says the narrow letters have a width of 2280 before the any characters scroll out of the viewing area of the same textbox.    I really expected to get back a fairly similar number from GetTextExtentPoint32 for WWWWWW" and "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii".  Instead,  what appears to be the same width with more narrow characters is returning nearly double the width measurement from GetTextExtentPoint32 that the fewer wide characters returned. It still looks like it has potential.  Any ideas?
0
 
LVL 22

Accepted Solution

by:
danaseaman earned 500 total points
ID: 24140153
Whatever GetDc is returning appears to not have the corresponding TextBox Font.
Try this code which uses DrawText and the Form hDc.
Note that Form Font has been set to TextBox Font.

Option Explicit
 
Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
 
Private Type RECT
   Left                 As Long
   Top                  As Long
   Right                As Long
   Bottom               As Long
End Type
 
Private Const DT_CALCRECT As Long = &H400
Private TextBoxClientW  As Long
 
Private Sub Form_Load()
   Dim rct              As RECT
   GetClientRect Text1.hwnd, rct
   TextBoxClientW = (rct.Right - rct.Left)
   Set Me.Font = Text1.Font
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
   Debug.Print TextWidthA(Text1, Chr(KeyAscii)), TextBoxClientW
   If KeyAscii > 31 Then
      If TextWidthA(Text1, Chr(KeyAscii)) > TextBoxClientW Then
         KeyAscii = 0
         Debug.Print "Reached limit"
      End If
   End If
End Sub
 
Private Function TextWidthA(tb As TextBox, sChar As String) As Long
   Dim rct              As RECT
   DrawText Me.hdc, tb.Text & sChar, -1, rct, DT_CALCRECT
   TextWidthA = rct.Right - rct.Left
End Function

Open in new window

0
 
LVL 16

Expert Comment

by:HooKooDooKu
ID: 24140589
I broke down and did some test code, and danaseman seems to be correct.

What did work is when I loaded the DC with a font that matches the font in the TextBox.  The following snippet is UGLY, but it works if you create a new VB6 project, and drop a TextBox and Label on the Form.

From here, you might be able to clean things up and get things working, especially if there is an easier way to load the appropriate font into the DC than to go and create a new font object as the snippet shows.
Private Type Size
        cx As Long
        cy As Long
End Type
 
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
 
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, ByRef lpSize As Size) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Const LF_FACESIZE = 32
Private Const FW_NORMAL = 400
Private Const FW_BOLD = 700
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 Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
 
Private Function TextWidthA() As Long
    Dim sz As Size
    Dim hDC As Long
    Dim F As Font
    Dim lf As LOGFONT
    Dim I As Long
    Dim hFont As Long
    Dim hOldFont As Long
    
    Set F = Text1.Font
    lf.lfWeight = IIf(F.Bold, FW_BOLD, FW_NORMAL)
    lf.lfCharSet = F.Charset
    lf.lfItalic = F.Italic
    For I = 1 To Len(F.Name)
        lf.lfFaceName(I) = Asc(Mid$(F.Name, I, 1))
    Next I
    lf.lfFaceName(I) = 0
    lf.lfHeight = F.Size
    lf.lfStrikeOut = F.Strikethrough
    lf.lfUnderline = F.Underline
    lf.lfWeight = F.Weight
    
    hFont = CreateFontIndirect(lf)
    
    hDC = GetDC(Text1.hwnd)
    hOldFont = SelectObject(hDC, hFont)
    
    Call GetTextExtentPoint32(hDC, Text1.Text, Len(Text1.Text), sz)
    TextWidthA = sz.cx * Screen.TwipsPerPixelX
 
    Call SelectObject(hDC, hOldFont)
    Call DeleteObject(hFont)
    Call ReleaseDC(Text1.hwnd, hDC)
 
End Function
 
Private Sub Text1_Change()
    Label1.Caption = CStr(TextWidthA)
End Sub

Open in new window

0
 

Author Closing Comment

by:SteveQ2
ID: 31569321
Danaseaman(Guru), thank you!  I am so impressed!  I had tried and tried but could not get this problem solved.  It was beginning to seem like it might be impossible.  Thank you!  
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question