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