vb6 - objetos - visual basic caracteristicas

Título de la aplicación Corte en VB6

Question

Plataforma: plataforma de desarrollo de Windows XP: VB6

Al intentar establecer un título de la aplicación a través del cuadro de diálogo Propiedades del proyecto en la pestaña Crear, parece cortar el título en silencio en un número determinado de caracteres. También probé esto a través de la propiedad App.Title y parece sufrir el mismo problema. No me interesaría, pero el departamento de control de calidad insiste en que debemos mostrar todo el título.

¿Alguien tiene una solución o solución para esto?

Editar: Para aquellos que respondieron sobre un límite de 40 caracteres, eso es lo que sospechaba, de ahí mi pregunta sobre una posible solución alternativa :-).

De hecho, publiqué esta pregunta para tratar de ayudar a un compañero desarrollador, así que cuando la vea el lunes, la señalaré con todas sus excelentes sugerencias y veré si alguna de ellas la ayuda a enderezarla. Sí sé que, por alguna razón, algunos de los cuadros de diálogo mostrados por la aplicación parecen recoger la cadena de la configuración de App.Title y es por eso que me había preguntado sobre la limitación de la longitud de la cadena.

Desearía poder encontrar algo definitivo de Microsoft (como una especie de nota de KB) para que pueda mostrarlo a nuestro departamento de control de calidad para que se den cuenta de que esto es simplemente una limitación de VB.

Answer 1

Parece que VB6 limita la propiedad App.Title a 40 caracteres. Lamentablemente, no puedo encontrar documentación en MSDN que detalle este comportamiento. (Y desafortunadamente, no tengo la documentación cargada en la máquina donde aún reside mi copia de VB6).

Ejecuté un experimento con títulos largos, y ese fue el comportamiento observado. Si su título tiene más de 40 caracteres, simplemente se truncará.

Answer 2

+1 davidg.

¿Estás seguro de que te refieres a Título? El título es lo que aparece en la barra de tareas de Windows. Use Subtítulo para establecer el texto en la barra de título de un formulario.

Answer 3

Acabo de crear un proyecto EXE estándar en el IDE y el texto escrito en el campo de título de la aplicación en la pestaña Hacer de las propiedades del proyecto hasta que llené el campo. A partir de esta prueba rápida, parece que App.Title está limitado a 40 caracteres. Luego probé en código poniendo el siguiente código en el formulario predeterminado (Form1) creado para el proyecto:

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

Esta prueba rápida confirma el límite de 40 caracteres, porque MsgBox muestra 40, aunque el código intenta establecer App.Title en una cadena de 41 caracteres.

Si es realmente importante mostrar la cadena completa en la barra de título de un Formulario, solo la forma en que puedo pensar para garantizar que se muestre todo el título sería obtener el ancho del texto de la barra de título y usarlo para aumentar el ancho de su Formulario para que pueda acomodar la cadena de título completa. Puedo volver y publicar el código para esto si puedo encontrar los encantamientos de API correctos, pero podría parecerse a esto en el evento 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

Answer 4

La función MsgBox toma un parámetro para el título. Si no desea cambiar cada llamada a la función MsgBox, puede "anular" el comportamiento predeterminado:

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

Editar: Como señala Mike Spross: Esto solo oculta la función MsgBox normal. Si quería acceder a su MsgBox personalizado desde otro proyecto, tendría que calificarlo.

Answer 5

Una solución usando la API de Windows

Descargo de responsabilidad : en mi humilde opinión, esto parece excesivo solo para cumplir con el requisito establecido en la pregunta, pero en el espíritu de dar una respuesta (con suerte) completa al problema, aquí no pasa nada ...

Aquí está una versión de trabajo que surgió después de mirar en MSDN por un tiempo, hasta que finalmente encontré un artículo sobre vbAccelerator que hizo girar mis ruedas.

• Vea la página de vbAccelerator para el artículo original (no relacionado directamente con la pregunta, pero había suficiente para que yo formule una respuesta)

La premisa básica es calcular primero el ancho del texto del título del formulario y luego usar GetSystemMetrics para obtener el ancho de varios bits de la ventana, como el ancho del borde y de la ventana, el ancho de los botones Minimizar, Maximizar y Cerrar , y así sucesivamente (los divido en sus propias funciones para leer / aclarar). Necesitamos dar cuenta de estas partes de la ventana para calcular un nuevo ancho preciso para el formulario.

Para calcular con precisión el ancho ("extensión") del título del formulario, necesitamos obtener la fuente del título del sistema, de ahí las llamadas SystemParametersInfo y CreateFontIndirect y bondades relacionadas.

El resultado final de todo este esfuerzo es la función GetRecommendedWidth , que calcula todos estos valores y los suma, más un poco de relleno adicional para que haya espacio entre el último carácter del título y los botones de control. Si este nuevo ancho es mayor que el ancho actual del formulario, GetRecommendedWidth devolverá este ancho (mayor), de lo contrario, devolverá el ancho actual del Formulario.

Solo lo probé brevemente, pero parece funcionar bien. Sin embargo, dado que usa las funciones de la API de Windows, es recomendable que tenga cuidado, especialmente porque está copiando memoria. Tampoco agregué un manejo robusto de errores.

Por cierto, si alguien tiene una forma más limpia y menos complicada de hacerlo, o si omití algo en mi propio código, házmelo saber.

Para probarlo, pega el siguiente código en un nuevo módulo

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

A continuación, coloque lo siguiente en su evento Form_Load

Private Sub Form_Load()

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

End Sub