USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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      Clique aqui para enviar email para o autor  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
 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página