|
Code from
ctxListView.accdb.zip available below:
**************************************************
Option Compare
Database
Dim
simulateDrag As Boolean
'indicates if a dragdrop operation is being simulated
Private Sub ctxSchedule2_FirstDraw()
'Populate the
ctxSchedule control with some items Dim x As Integer
For x = 1 To 20
Me.ctxSchedule2.AddItem "Item " + Str(x)
Next x
'Set the highlight
color used to paint the currently selected item in the ctxSchedule control.
Me.ctxSchedule2.SelectBackColor =
RGB(0, 0, 255) End Sub
Private Sub ctxListView1_FirstDraw()
'Populate the
ctxListView with some items.
Dim x As Integer
For x = 1 To 30
Me.ctxListView1.AddItem "Job " + Str(x)
Next x
End Sub
Private Sub ctxListView1_MouseDown(ByVal
Button As Integer, ByVal Shift
As Integer, ByVal
x As Long, ByVal y
As Long)
'A dragdrop simulation will begin
simulateDrag =
True
End Sub
Private Sub ctxListView1_MouseMove(ByVal
Button As Integer, ByVal Shift
As Integer, ByVal x
As Long, ByVal y As Long)
'A drag is simulating, so the movement will be tracked
If simulateDrag
Then
'Check
if the mouse coordinates pass over the instance of ctxSchedule
If
x + Me.ctxListView1.Left >= Me.ctxSchedule2.Left Then
'Pass
the coordinates to a custom routine, to test against the contents of ctxSchedule
'The coordinates are made relative to the ctxSchedule
instance as they are passed to the method
'In this sample the Top of both the source control
(ctxListView) and the target control (ctxSchedule) are the same,
'so no adjustments need to be made to the y
coordinate.
CheckScheduleLocation (x + Me.ctxListView1.Left) -
Me.ctxSchedule2.Left, y, False
End If
End If
End Sub
Private Sub
ctxListView1_MouseUp(ByVal
Button As Integer, ByVal Shift As Integer, ByVal
x As Long, ByVal y As
Long)
'The simulation
drag is over
simulateDrag =
False
'Check if the
mouseup was over the ctxSchedule instance.
If x +
Me.ctxListView1.Left >= Me.ctxSchedule2.Left
Then
'Pass the coordinates to a custom routine, to
test against the contents of ctxSchedule
'The coordinates are made relative to the ctxSchedule
instance as they are passed to the method
'In this sample the Top of both the source control
(ctxListView) and the target control (ctxSchedule) are the same,
'so no adjustments need to be made to the y
coordinate.
CheckScheduleLocation (x + Me.ctxListView1.Left) -
Me.ctxSchedule2.Left, y, True
End If
End Sub
Private Sub
CheckScheduleLocation(ByVal XCoordinate
As Single, ByVal YCoordinate
As Single, ByVal MouseRelease
As Boolean)
Dim
XCoord As Integer
Dim
YCoord As Integer
'Convert the
coordinates supplied from the Mouse events from Twips to Pixels 'The control
requires the coordinates be in Pixels.
XCoord = XCoordinate / 15
YCoord = YCoordinate / 15
'Select the item
in the ctxSchedule currently under the mouse (will highlight it).
Me.ctxSchedule2.ListIndex =
Me.ctxSchedule2.LineAt(YCoord)
'Test that
the mouse was released (indicating a simulated drop) and that the cursor is over
the schedule area of the ctSchedule
If
MouseRelease And
(Me.ctxSchedule2.ScheduleItemAt(XCoord, YCoord) = 3)
Then
'Add a new timebar
Dim
newBarIndex As Integer
newBarIndex = Me.ctxSchedule2.AddTimeBar(Me.ctxSchedule2.LineAt(YCoord),
Me.ctxSchedule2.TimeAt(XCoord), Me.ctxSchedule2.TimeAt(XCoord) + 60,
Me.ctxSchedule2.DateAt(XCoord), Me.ctxSchedule2.DateAt(XCoord))
'Set the text of the timebar to the text of the item that
triggered the drag
Me.ctxSchedule2.BarText(Me.ctxSchedule2.LineAt(YCoord), newBarIndex) =
Me.ctxListView1.ListText(Me.ctxListView1.ListIndex)
End If
End Sub
|