Question

Platform: Windows XP Development Platform: VB6

When trying to set an application title via the Project Properties dialog on the Make tab, it seems to silently cut off the title at a set number of characters. Also tried this via the App.Title property and it seems to suffer from the same problem. I wouldn’t care about this but the QA Dept. insists that we need to get the entire title displayed.

Does anyone have a workaround or fix for this?

---

Edit: To those who responded about a 40 character limit, that’s what I sort of suspected–hence my question about a possible workaround 🙂 .

Actually I posted this question to try to help a fellow developer so when I see her on Monday, I’ll point her to all of your excellent suggestions and see if any of them help her get this straightened out. I do know that for some reason some of the dialogs displayed by the app seem to pick up the string from the App.Title setting which is why she had asked me about the limitation on the length of the string.

I just wish I could find something definitive from Microsoft (like some sort of KB note) so she could show it to our QA department so they’d realize this is simply a limitation of VB.

Answer 1

One solution using the Windows API

Disclaimer: IMHO this seems like overkill just to meet the requirement stated in the question, but in the spirit of giving a (hopefully) complete answer to the problem, here goes nothing…

Here is a working version I came up with after looking around in MSDN for awhile, until I finally came upon an article on vbAccelerator that got my wheels turning.

• See the vbAccelerator page for the original article (not directly related to the question, but there was enough there for me to formulate an answer)

The basic premise is to first calculate the width of the form’s caption text and then to use GetSystemMetrics to get the width of various bits of the window, such as the border and window frame width, the width of the Minimize, Maximize, and Close buttons, and so on (I split these into their own functions for readibility/clarity). We need to account for these parts of the window in order to calculate an accurate new width for the form.

In order to accurately calculate the width (‘extent’) of the form’s caption, we need to get the system caption font, hence the SystemParametersInfo and CreateFontIndirect calls and related goodness.

The end result all this effort is the GetRecommendedWidth function, which calculates all of these values and adds them together, plus a bit of extra padding so that there is some space between the last character of the caption and the control buttons. If this new width is greater than the form’s current width, GetRecommendedWidth will return this (larger) width, otherwise, it will return the Form’s current width.

I only tested it briefly, but it appears to work fine. Since it uses Windows API functions, however, you may want to exercise caution, especially since it’s copying memory around. I didn’t add robust error-handling, either.

By the way, if someone has a cleaner, less-involved way of doing this, or if I missed something in my own code, please let me know.

To try it out, paste the following code into a new module

Option Explicit  Private Type SIZE     cx As Long     cy As Long End Type  Private Const LF_FACESIZE = 32  'NMLOGFONT: This declaration came from vbAccelerator (here is what he says about it):' '                                                                  ' ' For some bizarre reason, maybe to do with byte                   ' ' alignment, the LOGFONT structure we must apply                   ' ' to NONCLIENTMETRICS seems to require an LF_FACESIZE              ' ' 4 bytes smaller than normal:                                     '  Private Type NMLOGFONT    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(LF_FACESIZE - 4) As Byte 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(LF_FACESIZE) As Byte End Type  Private Type NONCLIENTMETRICS    cbSize As Long    iBorderWidth As Long    iScrollWidth As Long    iScrollHeight As Long    iCaptionWidth As Long    iCaptionHeight As Long    lfCaptionFont As NMLOGFONT    iSMCaptionWidth As Long    iSMCaptionHeight As Long    lfSMCaptionFont As NMLOGFONT    iMenuWidth As Long    iMenuHeight As Long    lfMenuFont As NMLOGFONT    lfStatusFont As NMLOGFONT    lfMessageFont As NMLOGFONT End Type  Private Enum SystemMetrics     SM_CXBORDER = 5     SM_CXDLGFRAME = 7     SM_CXFRAME = 32     SM_CXSCREEN = 0     SM_CXICON = 11     SM_CXICONSPACING = 38     SM_CXSIZE = 30     SM_CXEDGE = 45     SM_CXSMICON = 49     SM_CXSMSIZE = 52 End Enum  Private Const SPI_GETNONCLIENTMETRICS = 41 Private Const SPI_SETNONCLIENTMETRICS = 42  Private Declare Function GetTextExtentPoint32 Lib 'gdi32' Alias 'GetTextExtentPoint32A' _     (ByVal hdc As Long, _      ByVal lpszString As String, _      ByVal cbString As Long, _      lpSize As SIZE) As Long  Private Declare Function GetSystemMetrics Lib 'user32' (ByVal nIndex As SystemMetrics) As Long  Private Declare Function SystemParametersInfo Lib 'user32' Alias 'SystemParametersInfoA' ( _    ByVal uAction As Long, _    ByVal uParam As Long, _    lpvParam As Any, _    ByVal fuWinIni As Long) As Long  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 CreateFontIndirect Lib 'gdi32' Alias 'CreateFontIndirectA' (lpLogFont As LOGFONT) As Long  Private Declare Sub CopyMemory Lib 'kernel32' Alias 'RtlMoveMemory' (Destination As Any, Source As Any, ByVal Length As Long)  Private Function GetCaptionTextWidth(ByVal frm As Form) As Long      '-----------------------------------------------'     ' This function does the following:             '     '                                               '     '   1. Get the font used for the forms caption  '     '   2. Call GetTextExtent32 to get the width in '     '      pixels of the forms caption              '     '   3. Convert the width from pixels into       '     '      the scaling mode being used by the form  '     '                                               '     '-----------------------------------------------'      Dim sz As SIZE     Dim hOldFont As Long     Dim hCaptionFont As Long     Dim CaptionFont As LOGFONT     Dim ncm As NONCLIENTMETRICS      ncm.cbSize = LenB(ncm)      If SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, ncm, 0) = 0 Then         ' What should we do if we the call fails? Change as needed for your app,'         ' but this call is unlikely to fail anyway'         Exit Function     End If      CopyMemory CaptionFont, ncm.lfCaptionFont, LenB(CaptionFont)      hCaptionFont = CreateFontIndirect(CaptionFont)     hOldFont = SelectObject(frm.hdc, hCaptionFont)      GetTextExtentPoint32 frm.hdc, frm.Caption, Len(frm.Caption), sz     GetCaptionTextWidth = frm.ScaleX(sz.cx, vbPixels, frm.ScaleMode)      'clean up, otherwise bad things will happen...'     DeleteObject (SelectObject(frm.hdc, hOldFont))  End Function  Private Function GetControlBoxWidth(ByVal frm As Form) As Long      Dim nButtonWidth As Long     Dim nButtonCount As Long     Dim nFinalWidth As Long      If frm.ControlBox Then          nButtonCount = 1                            'close button is always present'         nButtonWidth = GetSystemMetrics(SM_CXSIZE)  'get width of a single button in the titlebar'          ' account for min and max buttons if they are visible'         If frm.MinButton Then nButtonCount = nButtonCount + 1         If frm.MaxButton Then nButtonCount = nButtonCount + 1          nFinalWidth = nButtonWidth * nButtonCount      End If      'convert to whatever scale the form is using'     GetControlBoxWidth = frm.ScaleX(nFinalWidth, vbPixels, frm.ScaleMode)  End Function  Private Function GetIconWidth(ByVal frm As Form) As Long      Dim nFinalWidth As Long      If frm.ControlBox Then          Select Case frm.BorderStyle              Case vbFixedSingle, vbFixedDialog, vbSizable:                 'we have an icon, gets its width'                 nFinalWidth = GetSystemMetrics(SM_CXSMICON)             Case Else:                 'no icon present, so report zero width'                 nFinalWidth = 0          End Select      End If      'convert to whatever scale the form is using'     GetIconWidth = frm.ScaleX(nFinalWidth, vbPixels, frm.ScaleMode)  End Function  Private Function GetFrameWidth(ByVal frm As Form) As Long      Dim nFinalWidth As Long      If frm.ControlBox Then          Select Case frm.BorderStyle              Case vbFixedSingle, vbFixedDialog:                 nFinalWidth = GetSystemMetrics(SM_CXDLGFRAME)             Case vbSizable:                 nFinalWidth = GetSystemMetrics(SM_CXFRAME)         End Select      End If      'convert to whatever scale the form is using'     GetFrameWidth = frm.ScaleX(nFinalWidth, vbPixels, frm.ScaleMode)  End Function  Private Function GetBorderWidth(ByVal frm As Form) As Long      Dim nFinalWidth As Long      If frm.ControlBox Then          Select Case frm.Appearance              Case 0 'flat'                 nFinalWidth = GetSystemMetrics(SM_CXBORDER)             Case 1 '3D'                 nFinalWidth = GetSystemMetrics(SM_CXEDGE)         End Select      End If      'convert to whatever scale the form is using'     GetBorderWidth = frm.ScaleX(nFinalWidth, vbPixels, frm.ScaleMode)  End Function  Public Function GetRecommendedWidth(ByVal frm As Form) As Long      Dim nNewWidth As Long      ' An abitrary amount of extra padding so that the caption text '     ' is not scrunched up against the min/max/close buttons '      Const PADDING_TWIPS = 120      nNewWidth = _         GetCaptionTextWidth(frm) _         + GetControlBoxWidth(frm) _         + GetIconWidth(frm) _         + GetFrameWidth(frm) * 2 _         + GetBorderWidth(frm) * 2 _         + PADDING_TWIPS      If nNewWidth > frm.Width Then         GetRecommendedWidth = nNewWidth     Else         GetRecommendedWidth = frm.Width     End If  End Function 

Then place the following in your Form_Load event

Private Sub Form_Load()      Me.Caption = String(100, 'x') 'replace this with your caption'     Me.Width = GetRecommendedWidth(Me)  End Sub