Visual Basic – Automatsko proširenje Combo Box-a

Da li širina vaših Combo Box kontrola nikad nije dovoljna? Da li se uvek „odsecaju“ sadržaji stavki koje ne mogu cele da stanu? U ovakvim situacijama postoji rešenje, mada nije previše elegantno. Sledeći programski kod koji vam predstavljamo će automatski izvršiti promenu veličine Combo Box kontrole i to u odnosu na najširu stavku u listi. Čak će funkcija raditi i sa specijalnim i podebljanim fontovima Combo Box kontrole. Za korišćenje ove mogućnosti potrebno je da pozovete funkciju „AutosizeCombo„, kojoj ćete kao argument proslediti naziv Combo Box kontrole. Funkcija će vratiti True ili False, u zavisnosti od uspešnosti akcije. Evo primera kako pozvati funkciju:

 uspesno = AutosizeCombo(Combo1)

A evo i same funkcije AutosizeCombo:

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
    lngParentHDC = Combo.Parent.hdc

    lngListCount = Combo.ListCount
    If lngParentHDC = 0 Or lngListCount = 0 Then Exit Function
    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
    For lngCounter = 0 To lngListCount

       DrawText lngParentHDC, Combo.List(lngCounter), -1, rectCboText, _

            DT_CALCRECT

       lngTempWidth = rectCboText.Right – rectCboText.Left + 20
        If (lngTempWidth > lngWidth) Then

           lngWidth = lngTempWidth

        End If
    Next
    lngCurrentWidth = SendMessageLong(Combo.hwnd, CB_GETDROPPEDWIDTH, _

        0, 0)
    If lngCurrentWidth > lngWidth Then
        AutosizeCombo = True

        GoTo ErrorHandler

        Exit Function
    End If
    If lngWidth > Screen.Width  Screen.TwipsPerPixelX – 20 Then _

        lngWidth = Screen.Width  Screen.TwipsPerPixelX – 20
    lngRet = SendMessageLong(Combo.hwnd, CB_SETDROPPEDWIDTH, lngWidth, 0)
    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

Pratite Krstaricu na www.krstarica.com