dotNETportal.cz

Help me! :-)

Prosím, můj ComboBox se umí rozvinout pouze do výšky osmi položek (=osmi řádek). V případě většího počtu položek se již prvek nezvětšuje, pouze si zobrazí scrollbar.. Dá se nějak tato vlastnost změnit a nastavit Comboboxu např. přesný počet položek, při kterém se má scrollbar zobrazit?

Za jakýkoli nápad děkuji.

ComboBox1.ListRows = 10 'počet zobrazených položek

Díky za radu, ale prvek ComboBox žádnou takovou vlastnost nemá, alespoň ve VB6, takže mi to nefunguje :)

Jinak ComboBox se po umístění na formulář pojmenuje jako Combo1 (nikoli přímo jako ComboBox), tak doufám, že mluvíme o tomtéž prvku..

Já teď nemám VB6 k dispozici. Zkoušel jsem to ve VBA a předpokládal jsem, že to bude stejný...

Ve VB.net je to takhle

ComboBox1.MaxDropDownItems = 10

ale ve VB6... netušim

Jedině co znám tak je automatická šířka v comboboxu (už ani nevím kde jsem to získal - nepsal jsem to já, protože komentáře určitě nejsou moje - bylo by tam víc smajlíků) :)

Jinak stoprocentně to jde přes API ale musíš googlovat (zkus na freevbcode.com)

Jo kód dej do obycejného modulu a volá se to následovně

dim x as boolean
x=AutosizeCombo(combobox1)

Option Explicit

Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const DT_CALCRECT = &H400

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function SendMessageLong Lib "user32" Alias _
        "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, ByVal lparam As Long) As Long

Private Declare Function DrawText Lib "user32" Alias _
    "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, _
    ByVal nCount As Long, lpRect As RECT, ByVal wFormat _
    As Long) As Long

Public Function AutosizeCombo(Combo As ComboBox) As Boolean
    
    Dim lngRet As Long
    Dim lngCurrentWidth As Single
    Dim rectCboText As RECT
    Dim lngParentHDC As Long
    Dim lngListCount As Long
    Dim lngCounter As Long
    Dim lngTempWidth As Long
    Dim lngWidth As Long
    Dim strSavedFont As String
    Dim sngSavedSize As Single
    Dim blnSavedBold As Boolean
    Dim blnSavedItalic As Boolean
    Dim blnSavedUnderline As Boolean
    Dim blnFontSaved As Boolean

On Error GoTo ErrorHandler

    'Zjištění ukazatele na combo a počet položek
    lngParentHDC = Combo.Parent.hdc
    lngListCount = Combo.ListCount

    If lngParentHDC = 0 Or lngListCount = 0 Then Exit Function

    'Uložení fontů atd. comba na rodičovský objekt(formulář) pro testování
    'délky s API
    With Combo.Parent
        strSavedFont = .FontName
        sngSavedSize = .FontSize
        blnSavedBold = .FontBold
        blnSavedItalic = .FontItalic
        blnSavedUnderline = .FontUnderline
        
        .FontName = Combo.FontName
        .FontSize = Combo.FontSize
        .FontBold = Combo.FontBold
        .FontItalic = Combo.FontItalic
        .FontUnderline = Combo.FontItalic
    End With

    blnFontSaved = True

    'Zjištění délky nejdelší položky
    For lngCounter = 0 To lngListCount
       DrawText lngParentHDC, Combo.LIST(lngCounter), -1, rectCboText, _
            DT_CALCRECT

        'Přidání 20 jako okraje
       lngTempWidth = rectCboText.Right - rectCboText.Left + 20

        If (lngTempWidth > lngWidth) Then
           lngWidth = lngTempWidth
        End If

    Next
 
    'Zjištění aktuální délky comba
     lngCurrentWidth = SendMessageLong(Combo.hwnd, _
        CB_GETDROPPEDWIDTH, 0, 0)

    'Je-li to dost, je to v pořádku
    If lngCurrentWidth > lngWidth Then

        AutosizeCombo = True
        GoTo ErrorHandler
        Exit Function
    
    End If
 
    '... ale pokud ne, pak musíme nejprve zjistit délku obrazovky a přesvědčit se,
    'zda tuto hodnotu nepřekročíme
     If lngWidth > Screen.Width \ Screen.TwipsPerPixelX - 20 Then _
        lngWidth = Screen.Width \ Screen.TwipsPerPixelX - 20

    'Nastavení délky comba
    lngRet = SendMessageLong(Combo.hwnd, _
       CB_SETDROPPEDWIDTH, lngWidth, 0)

    'Nastavení True/False v závislosti na úspěšnosti API
    AutosizeCombo = lngRet > 0
    
ErrorHandler:
    On Error Resume Next
    
    If blnFontSaved Then
      With Combo.Parent
        .FontName = strSavedFont
        .FontSize = sngSavedSize
        .FontUnderline = blnSavedUnderline
        .FontBold = blnSavedBold
        .FontItalic = blnSavedItalic
     End With
    End If

End Function