平台：Windows XP
开发平台：VB6

当尝试通过"生成"选项卡上的"项目属性"对话框设置应用程序标题时，它似乎以一定数量的字符无声地切断了标题。还通过App.Title属性尝试了此操作，它似乎也遇到了同样的问题。我对此并不在乎，但质量检查部门坚持认为，我们需要显示整个标题。

有人对此有解决方法或者解决方法吗？

编辑：对于那些回答了大约40个字符限制的人，这就是我的怀疑-因此，我对可能的解决方法:-)提出了疑问。

实际上，我发布了这个问题来尝试帮助同一个开发人员，因此，当我周一见到她时，我将向她指出所有出色建议，看看是否有任何建议可以帮助她弄清楚这一点。我确实知道，由于某种原因，应用程序显示的某些对话框似乎从App.Title设置中拾取了字符串，这就是为什么她问我有关字符串长度的限制的原因。

我只是希望我能从Microsoft找到确定的内容(例如某种KB注释)，以便她可以向我们的质量检查部门展示它，以便他们意识到这仅仅是VB的局限性。

解决方案

似乎VB6将App.Title属性限制为40个字符。不幸的是，我无法在MSDN上找到任何详细说明此行为的文档。 (不幸的是，我没有将文档加载到仍保留我的VB6副本的计算机上。)

我进行了一个长标题的实验，这就是观察到的行为。如果标题超过40个字符，则会被截断。

我刚刚在IDE中创建了一个标准EXE项目，并在"项目属性"选项卡下的应用程序标题字段中键入了文本，直到我填写了该字段。通过此快速测试，似乎App.Title限制为40个字符。接下来，我通过将以下代码放入为项目创建的默认格式(Form1)中，在代码中进行了尝试：

Private Sub Form_Load()
    App.Title = String(41, "X")
    MsgBox Len(App.Title)
End Sub

此快速测试确认了40个字符的限制，因为即使代码尝试将App.Title设置为41个字符的字符串，MsgBox也会显示40。

如果让完整的字符串显示在Form的标题栏中确实很重要，那么我唯一能确保确保显示整个标题的唯一方法就是获取标题栏文本的宽度并使用该宽度来增加宽度表格的格式，以便可以容纳完整的标题字符串。如果可以找到正确的API实例，我可能会回来并为此发布代码，但是在Form_Load事件中可能看起来像这样：

Dim nTitleBarTextWidth As Long
Dim nNewWidth As Long

Me.Caption = "My really really really really really long app title here"

' Get titlebar text width (somehow) '
nTitleBarTextWidth = GetTitleBarTextWidth()

' Compute the new width for the Form such that the title will fit within it '
' (May have to add a constant to this to make sure the title fits correctly) '
nNewWidth = Me.ScaleX(nTitleBarTextWidth, vbPixels, Me.ScaleMode)

' If the new width is bigger than the forms current size, use the new width '
If nNewWidth > Me.Width Then
    Form.Width = nNewWidth
End If

使用Windows API的一种解决方案

免责声明：恕我直言，这似乎只是为了满足问题中所述的要求，但已过分解决了，但是本着为问题提供一个(希望)完整答案的精神，这无济于事...

这是我在MSDN中浏览了一段时间后想出的一个工作版本，直到我终于找到关于vbAccelerator的文章，使我的工作转向。

• 请参阅vbAccelerator页面以获取原始文章(与问题没有直接关系，但是我有足够的机会来制定答案)

基本前提是首先计算表单标题文本的宽度，然后使用GetSystemMetrics获取窗口各个位的宽度，例如边框和窗口框架的宽度，"最小化"，"最大化"和"关闭"按钮的宽度。 ，依此类推(为了可读性/清晰度，我将它们分成了自己的函数)。我们需要考虑窗口的这些部分，以便为表单计算出准确的新宽度。

为了准确计算表单标题的宽度("范围")，我们需要获取系统标题字体，因此需要调用SystemParametersInfo和CreateFontIndirect以及相关的优点。

所有这些工作的最终结果是GetRecommendedWidth函数，该函数计算所有这些值并将它们加在一起，外加一些额外的填充，以便在标题的最后一个字符和控制按钮之间留出一定的空间。如果此新宽度大于窗体的当前宽度，则GetRecommendedWidth将返回此(更大)宽度，否则，它将返回窗体的当前宽度。

我只是简短地测试了一下，但看起来工作正常。但是，由于它使用Windows API函数，因此我们可能要格外小心，尤其是因为它正在复制内存。我也没有添加健壮的错误处理。

顺便说一句，如果有人这样做的方式更简洁，使用更少，或者如果我错过了自己的代码中的某些内容，请告诉我。

要尝试，请将以下代码粘贴到新模块中

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

然后将以下内容放入Form_Load事件中

Private Sub Form_Load()

    Me.Caption = String(100, "x") 'replace this with your caption'
    Me.Width = GetRecommendedWidth(Me)

End Sub

+1大卫。

我们确定是标题吗？标题是Windows任务栏中显示的内容。使用标题在表单的标题栏中设置文本。

MsgBox-Function采用标题参数。如果我们不想更改对MsgBox-Function的每次调用，则可以"覆盖"默认行为：

Function MsgBox(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title, Optional HelpFile, Optional Context) As VbMsgBoxResult
    If IsMissing(Title) Then Title = String(40, "x") & "abc"
    MsgBox = Interaction.MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function

编辑：正如Mike Spross指出的那样：这只会隐藏正常的MsgBox-Function。如果要从另一个项目访问自定义MsgBox，则必须对其进行限定。