Visual Basic – Automatsko proširenje Combo Box-a

Krstarica 30. avgust 2001. 00:00

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

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 i preko mobilne aplikacije za Android i iPhone.

programiranje