PDA

View Full Version : Solved: Listbox1: Highlight Pre selected Item



Pcsm
07-13-2011, 01:32 PM
In vb6 its work fine, but in VBA the hWnd i get errror "method not find".
Any idea how to solve de problem?

Option Explicit
Private Declare Function LBItemFromPt Lib "comctl32.dll" (ByVal hLB As Long, ByVal ptx As Integer, ByVal pty As Integer, ByVal bAutoScroll As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private tPos As POINTAPI
Private Const LB_SETSEL = &H185&
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

ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim index As Long
Call SendMessage(Listbox1.hWnd, LB_SETSEL, False, ByVal -1)
GetCursorPos tPos
index = LBItemFromPt(Listbox1.hWnd, tPos.X, tPos.Y, 0)
Call SendMessage(Listbox1.hWnd, LB_SETSEL, True, ByVal index)
End Sub

Private Sub Form_Load()
Listbox1.AddItem "1"
Listbox1.AddItem "2"
Listbox1.AddItem "3"
End Sub

Bob Phillips
07-13-2011, 11:50 PM
Why do you need to use an API on the listbox, perhaps there is an easier way.

Pcsm
07-16-2011, 02:13 PM
After searching and find any solution, I created my own code to Highlight Pre selected Item in listbox. Is very simple and does not require any API, just some math. (see the attached exemple)

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Rato no interior do Buton
If (X > 3) And (Y > 3) And (X < CommandButton1.Width - 3) And (Y < CommandButton1.Height - 3) Then
CommandButton1.BackColor = vbGreen
ListBox1.Visible = True
GoTo fim
End If

'Rato no limite do Buton
If (X < CommandButton1.Width) And (Y < 3) Or (X < CommandButton1.Width) And (Y > CommandButton1.Height - 3) Or (X < 3) And (Y < CommandButton1.Height - 6) Then
CommandButton1.BackColor = vbRed
ListBox1.Visible = False
GoTo fim
End If

fim:
End Sub

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ListBox1 = "Clientes" Then UserForm2.Show
If ListBox1 = "Fornecedores" Then UserForm3.Show
If ListBox1 = "Empregados" Then UserForm4.Show
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim c, f, h, index As Integer

c = ListBox1.ListCount
h = ListBox1.Height
f = h / c

index = 0

Do Until index = c
If Y > f * index And Y < f * (index + 1) Then ListBox1.ListIndex = index
index = index + 1
Loop

End Sub

Private Sub UserForm_Initialize()
Dim c, f As Integer

ListBox1.AddItem "Clientes"
ListBox1.AddItem "Fornecedores"
ListBox1.AddItem "Empregados"
ListBox1.AddItem "Teste1"
ListBox1.AddItem "Teste2"

c = ListBox1.ListCount
f = ListBox1.FontSize
ListBox1.Height = c * (f + 2.7)

End Sub