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:  Colocando ScrollBar Horizontal num ListBox
Postada em 14/8/2000 por Webmaster      Clique aqui para enviar email para o autor  webmaster@vbweb.com.br
'Coloque o seguinte código num módulo:
Option Explicit

Private Const LB_GETHORIZONTALEXTENT As Long = &H193
Private Const LB_SETHORIZONTALEXTENT As Long = &H194
Private Const DT_CALCRECT As Long = &H400
Private Const SM_CXVSCROLL As Long = 2

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 GetSystemMetrics Lib _
        "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" _
        Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, _
        lParam As Any) As Long

Public Function AdicionaItem(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)
  Set ctl.Parent.Font = OldFont
  sysScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
  newWidth = RC.Right + sysScrollWidth

  If newWidth > currWidth Then
    Call SendMessage(ctl.hwnd, _
         LB_SETHORIZONTALEXTENT, newWidth, _
         ByVal 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
  AdicionaItem = ctl.newIndex
End Function

'No form:
Private Sub Form_Load()
  'Detalhe, NÃO use o List1.AddItem!!!
  'Veja como adiciona algumas linhas...
  Call AdicionaItem(List1, "Coloque o texto que será adicionado aqui")
  Call AdicionaItem(List1, "Não se preocupe se o texto for muito grande")
  Call AdicionaItem(List1, "Ele será exibido, seja como for!!!")
End Sub
Uma dica legal é usar a propriedade TopIndex. Veja o exemplo:

  Dim NovoIndex As Long
  NovoIndex = AdicionaItem(List1, "Texto")
  List1.TopIndex = NovoIndex
O resultado isso é que ele irá posicionar a barra de rolagem vertical da ListBox para que este item recem-adicionado possa ficar visível..
 


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