|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Ajustando a Largura do Drop-Down de um ComboBox
|
 |
|
|
|
Postada em 14/8/2000 por Webmaster
webmaster@vbweb.com.br
Descobrindo a largura atual do Drop-Down
'Coloque este código num módulo:
Private Const CB_GETDROPPEDWIDTH As Long = &H15F
Private Const CB_ERR As Long = -1
Private Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Function GetDropdownWidth(cbohWnd As _
Long) As Long
Dim lRetVal As Long
'Descobrindo a largura atual do Drop Down:
lRetVal = SendMessage(cbohWnd, _
CB_GETDROPPEDWIDTH, 0&, 0&)
If lRetVal <> CB_ERR Then
'Ele retornará a largura do Drop Down
'em pixels.
GetDropdownWidth = lRetVal
Else
GetDropdownWidth = 0
End If
End Function
'P/ chamar use assim:
Dim iLargura As Integer
iLargura = GetDropdownWidth(Combo1.hWnd)
'Pronto. A variável iLargura conterá a
'largura do Drop Down em pixels.
Adicionando itens ao ComboBox em Run-Time
Você pode adicionar itens e atualizar a largura do Drop Down automaticamente. Veja como:
'Coloque este código num módulo:
Option Explicit
Private Const CB_GETDROPPEDWIDTH As Long = &H15F
Private Const CB_SETDROPPEDWIDTH As Long = &H160
Private Const CB_ERR As Long = -1
Private Const DT_CALCRECT As Long = &H400
Public Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Any) As Long
Public Function cboAdiciona(ByRef ctl As Control, _
ByVal sNewItem As String, Optional ByVal _
dwNewItemData As Variant) As Long
Dim RC As Rect
Dim newWidth As Long
Dim currWidth As Long
Dim sysScrollWidth As Long
Dim OldFont As StdFont
If ctl.Tag <> "" Then
currWidth = CLng(ctl.Tag)
End If
Set OldFont = ctl.Parent.Font
Set ctl.Parent.Font = ctl.Font
Call DrawText(ctl.Parent.hDC, sNewItem, -1&, _
RC, DT_CALCRECT)
newWidth = RC.Right + 5
Set ctl.Parent.Font = OldFont
If newWidth > currWidth Then
Call SendMessage(ctl.hwnd, CB_SETDROPPEDWIDTH, _
newWidth, 0&)
ctl.Tag = newWidth
End If
ctl.AddItem sNewItem
If Not IsMissing(dwNewItemData) Then
If IsNumeric(dwNewItemData) Then
ctl.ItemData(ctl.NewIndex) = dwNewItemData
End If
End If
cboAdiciona = ctl.NewIndex
End Function
'P/ usar, adicione os itens desta maneira (se
'você usar com Combo1.AddItem NÃO FUNCIONARÁ!):
Call cboAdiciona(Combo1, "Texto")
'Esta função retorna o valor do ListIndex do
'novo item. Então, você pode usar esta função
'recebemdo o valor do ListIndex p/ usa-lo de
'alguma forma. Veja como fazer isto:
Dim NovoIndex As Long
NovoIndex = cboAdiciona(Combo1, "Texto")
MsgBox "O Item " & NovoIndex & " foi adicionado!"
Adicionando itens ao ComboBox em Design-Time
Se você quizer adicionar os itens em Design-Time e atualizar a largura do Drop Down Run-Time, faça da seguinte maneira:
'Coloque este código num módulo:
Private Const CB_SETDROPPEDWIDTH As Long = &H160
Private Const CB_ERR As Long = -1
Private Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Function SetDropdownWidth(cboHwnd As Long, _
NewWidthPixel As Long) As Boolean
Dim lRetVal As Long
'Ajustando a largura do Drop-Down:
lRetVal = SendMessage(cboHwnd, _
CB_SETDROPPEDWIDTH, NewWidthPixel, 0)
If lRetVal <> CB_ERR Then
SetDropdownWidth = True
Else
SetDropdownWidth = False
End If
End Function
'No Form, coloque:
Private Sub Form_Load()
Dim iLar1 As Integer, iLar2 As Integer
Dim iNum As Integer, OldFont As StdFont
iLar2 = 0
OldFont = Me.Font
Me.Font = Combo1.Font
Me.ScaleMode = 3
For iNum = 0 To Combo1.ListCount - 1
Combo1.ListIndex = iNum
iLar1 = Me.TextWidth (Combo1.Text)
If iLar1 > iLar2 Then
iLar2 = iLar1
End If
Next
iLar2 = iLar2 + 5
Call SetDropdownWidth(Combo1.hWnd, iLar2)
Me.Font = OldFont
End Sub
|
|
|
|
|
