There
may be a time when the selection or detection of the list item beneath the mouse pointer needs to be determined
or made from outside of a mouse
event. This demo shows how this is possible using the same basic
LBItemFromPt method and concept shoen in Brad Martinez' LBItemFromPt
method above, extended with GetCursorPos() to determine the mouse
coordinates in relation to the controls.
To
keep the code simple (i.e. not complicate the code with, say, a huge
complex set of routines just to provide a base to show how to do this),
I'll take a cheesy shortcut and use existing OLEDragxx events and simply
ignore fact that the mouse x,y coordinates are passed to the events. The
actual technique would prove useful inside, for example, a
control-subclassing routine where the x,y coordinates may not be passed to the WindowProc.
The demo will copy filenames from a file list box into a regular list box,
inserting as the list item highlighted using these events. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const LB_ITEMFROMPOINT As Long = &H1A9
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function LBItemFromPt Lib "comctl32" _
(ByVal hwnd As Long, _
ByVal ptx As Long, _
ByVal pty As Long, _
ByVal bAutoScroll As Long) As Long
'flag to abort the click event
Dim bInDrag As Boolean
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
'Add a few items
Dim cnt As Long
For cnt = 0 To 20
List1.AddItem "List item no" & Str$(cnt)
Next
End Sub
Private Sub File1_MouseDown(Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
If Button = vbLeftButton Then
bInDrag = True
File1.OLEDragMode = 1
File1.OLEDrag
End If
End Sub
Private Sub File1_OLECompleteDrag(Effect As Long)
'clear the flag if the selection
'is cancelled over the file list
'to resume normal click operations
bInDrag = False
End Sub
Private Sub List1_Click()
'prevent inadvertent firing of
'the click event
If bInDrag Then Exit Sub
'your normal click routine goes here
End Sub
Private Sub List1_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
Dim cnt As Integer
Dim curritem As Long
Dim pt As POINTAPI
'only if the data is a file
If Data.GetFormat(vbCFFiles) = True Then
'determine the rodent position and
'get the index of the nearest item
Call GetCursorPos(pt)
curritem = LBItemFromPt(List1.hwnd, pt.X, pt.Y, False)
'add the items to the list
Do
cnt = cnt + 1
List1.AddItem Data.Files.Item(cnt), curritem
'select the dropped item
List1.Selected(curritem) = True
Loop While cnt < Data.Files.Count
End If
'clear the flag to resume normal
'click operations
bInDrag = False
End Sub
Private Sub List1_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, Y As Single, _
State As Integer)
Dim curritem As Long
Dim pt As POINTAPI
'this gives the visual feedback of the
'listindex of the item that is to inserted
'determine the rodent position, and
'map to the client coordinates
Call GetCursorPos(pt)
'get the list item and highlight if valid
curritem = LBItemFromPt(List1.hwnd, pt.X, pt.Y, False)
If curritem > -1 Then List1.Selected(curritem) = True
End Sub |