D
David C. Holley
My knowledge of the code below is somewhat limited as I'm working off of
a couple of different examples - none of which have comments that
explain the what's and the why's. Can somebody help me to understand
what exactly is happening here? Also, the Form_Timer even is throwing an
error '91 - Object variable not set' which I don't understand why -
mostly because I have a limited understanding of the code.
Here are all of the relevant SUB, 'DEV in the comments indicate code
that was copied over. There is some code that's been commented out
simply because I'm still trying to adapt the original code.
Option Compare Database
Option Explicit
Private cursorX As Single 'DEV
Private cursorY As Single 'DEV
Private tvScrollDir As Integer 'Which way to scroll 'DEV
Private tvCtrl As TreeView 'DEV
Private mfInDrag As Boolean 'DEV
Private mOldFormTimer As Long 'DEV
Private Sub Form_Load()
Call loadTreeView
'DEV Capture the Timer Interval
'DEV I'm assuming to speed up the interval at which the code checks to
see if the tree view should be scrolled
mOldFormTimer = Me.TimerInterval
End Sub
'==================================================================
'This procedure in the OLEStartDrag event of the TreeView control
'clears the selected node so you can choose a new one.
'==================================================================
Private Sub TreeView_OLEStartDrag(Data As Object, AllowedEffects As _
Long)
On Error GoTo err_oleStartDrag
Me!tvTreeView.Object.SelectedItem = Nothing
Exit Sub
err_oleStartDrag:
Stop
End Sub
'====================================================================
'Use the OLEDragOver event of the TreeView control to select the
'node to drag, and to highlight the target nodes where the drop will
'occur when you release the mouse. This procedure sets the selected
'node to drag once. After that, if a node is already selected, the
'procedure assumes it was set during an earlier call in the dragging
'process and it does not reset it. The second half of this procedure
'highlights the node you are dragging over.
'====================================================================
Private Sub TreeView_OLEDragOver(Data As Object, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
On Error GoTo Err_OleDragOver
Dim tvTreeView As TreeView
Dim m_iScrollDir As Integer
'DEV capture the x, y position for use in the FORM_TIMER event
cursorX = x
cursorY = y
Debug.Print cursorX, cursorY
On Error GoTo 0
Debug.Print Me!tvTreeView.Height, x, y
'DEV Scroll the Tree View
'Code copy & pasted
If y > 0 And y < 400 Then
'user move mouse near the top edge of treeveiw - scroll up
m_iScrollDir = -1
ElseIf y > (Me!tvTreeView.Height - 500) And y <
Me!tvTreeView.Height Then
'scroll down
m_iScrollDir = 1
Else
m_iScrollDir = 0
End If
'Code here is fine (mostly)
'Create a reference to the TreeView control.
Set tvTreeView = Me!tvTreeView.Object
'If no node is selected, select the first node you dragged over.
If tvTreeView.SelectedItem Is Nothing Then
Set tvTreeView.SelectedItem = tvTreeView.HitTest(x, y)
'------------------------------------------------------------------------------------
Else
Debug.Print "OLEDragOver"
On Error Resume Next
'Alter the style of the cursor to indicate the node cannot be
dropped on the highlighted node
Select Case tvTreeView.HitTest(x, y).Tag
Case "itinerary"
Effect = 3
Case Else
Effect = 0
End Select
Debug.Print Err.Number, Err.Description
On Error GoTo 0
'------------------------------------------------------------------------------------
End If
'Highlight the node being dragged over as a potential drop target.
Set tvTreeView.DropHighlight = tvTreeView.HitTest(x, y)
Exit Sub
Err_OleDragOver:
Stop
End Sub
'==================================================================
'The OLEDragDrop event moves the selected node on the TreeView
'control to its new location and changes the corresponding record in
'the Employees table. The procedure first checks that the TreeView
'has a selected node. If so, it continues to check if a drop target
'node is highlighted. If no node is highlighted, then the user has
'dragged the node off the tree and dropped it into a blank area, and
'the procedure adds a branch to the root of the tree. If a node is
'highlighted, the procedure modifies the Employee table's ReportTo
'field accordingly and sets the selected node's parent property
'to the node that has the drop highlight.
'==================================================================
Private Sub TreeView_OLEDragDrop(Data As Object, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo ErrTreeView_OLEDragDrop
Dim tvTreeView As TreeView
Dim strKey As String, strText As String
Dim nodeNew As Node, nodeDragged As Node
'DEV change the timer value back to the original value
Me.TimerInterval = mOldFormTimer
Set tvTreeView = Me!tvTreeView.Object
'If nothing is selected for drag, do nothing.
If tvTreeView.SelectedItem Is Nothing Then
Else
'Reference the selected node as the one being dragged.
Set nodeDragged = tvTreeView.SelectedItem
'--------------------------------------------------------------
If tvTreeView.DropHighlight.Tag = "itinerary" Then
Set nodeDragged.Parent = tvTreeView.DropHighlight
ElseIf tvTreeView.DropHighlight <> "itinerary" Then
Call MsgBox("Transfers can only be moved to
itinerary nodes.", vbExclamation, Application.Name)
ElseIf nodeDragged.Index <> tvTreeView.DropHighlight.Index Then
'do nothing
End If
'--------------------------------------------------------------
End If
'Deselect the node
Set nodeDragged = Nothing
'Unhighlight the nodes.
Set tvTreeView.DropHighlight = Nothing
ExitTreeView_OLEDragDrop:
Exit Sub
ErrTreeView_OLEDragDrop:
Stop
'Code copied over, doesn't neccessarily apply and may be deleted
'If you create a circular branch.
If Err.Number = 35614 Then
MsgBox "A supervisor cannot report to a subordinate.", _
vbCritical, "Move Cancelled"
Else
MsgBox "An error occurred while trying to move the node. " & _
"Please try again." & vbCrLf & Err.Description
End If
Resume ExitTreeView_OLEDragDrop
End Sub
Private Sub Form_Timer()
'DEV all code copied over, the SEND MESSAGE appears in a separate module
(see below for the code) I'm assuming that SEND MESSAGE is the means by
which the tree view is actually scrolled
On Error GoTo Err_FormTimer
'Static lngStayCount As Long, strStayNode As String
If mfInDrag Then
'DEV this code craps out, has something to do with not being
able to grab the highlighted code
Set tvCtrl.DropHighlight = Me.tvTreeView.HitTest(cursorX, cursorY)
If tvScrollDir = -1 Then 'Scroll Up
' Send a WM_VSCROLL message 0 is up and 1 is down
SendMessage tvCtrl.hWnd, 277&, 0&, vbNull
ElseIf tvScrollDir = 1 Then 'Scroll Down
SendMessage tvCtrl.hWnd, 277&, 1&, vbNull
End If
End If
Exit Sub
Err_FormTimer:
Stop
End Sub
Private Sub tvTreeView_OLECompleteDrag(Effect As Long)
'DEV
On Error GoTo err_OLECompleteDrag
Me.TimerInterval = mOldFormTimer
mfInDrag = False
Exit Sub
err_OLECompleteDrag:
Stop
End Sub
Private Sub tvTreeView_OLEStartDrag(Data As Object, AllowedEffects As Long)
'DEV
On Error GoTo err_oleStartDrag
mfInDrag = True
Me.TimerInterval = 200
Exit Sub
err_oleStartDrag:
Stop
End Sub
a couple of different examples - none of which have comments that
explain the what's and the why's. Can somebody help me to understand
what exactly is happening here? Also, the Form_Timer even is throwing an
error '91 - Object variable not set' which I don't understand why -
mostly because I have a limited understanding of the code.
Here are all of the relevant SUB, 'DEV in the comments indicate code
that was copied over. There is some code that's been commented out
simply because I'm still trying to adapt the original code.
Option Compare Database
Option Explicit
Private cursorX As Single 'DEV
Private cursorY As Single 'DEV
Private tvScrollDir As Integer 'Which way to scroll 'DEV
Private tvCtrl As TreeView 'DEV
Private mfInDrag As Boolean 'DEV
Private mOldFormTimer As Long 'DEV
Private Sub Form_Load()
Call loadTreeView
'DEV Capture the Timer Interval
'DEV I'm assuming to speed up the interval at which the code checks to
see if the tree view should be scrolled
mOldFormTimer = Me.TimerInterval
End Sub
'==================================================================
'This procedure in the OLEStartDrag event of the TreeView control
'clears the selected node so you can choose a new one.
'==================================================================
Private Sub TreeView_OLEStartDrag(Data As Object, AllowedEffects As _
Long)
On Error GoTo err_oleStartDrag
Me!tvTreeView.Object.SelectedItem = Nothing
Exit Sub
err_oleStartDrag:
Stop
End Sub
'====================================================================
'Use the OLEDragOver event of the TreeView control to select the
'node to drag, and to highlight the target nodes where the drop will
'occur when you release the mouse. This procedure sets the selected
'node to drag once. After that, if a node is already selected, the
'procedure assumes it was set during an earlier call in the dragging
'process and it does not reset it. The second half of this procedure
'highlights the node you are dragging over.
'====================================================================
Private Sub TreeView_OLEDragOver(Data As Object, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
On Error GoTo Err_OleDragOver
Dim tvTreeView As TreeView
Dim m_iScrollDir As Integer
'DEV capture the x, y position for use in the FORM_TIMER event
cursorX = x
cursorY = y
Debug.Print cursorX, cursorY
On Error GoTo 0
Debug.Print Me!tvTreeView.Height, x, y
'DEV Scroll the Tree View
'Code copy & pasted
If y > 0 And y < 400 Then
'user move mouse near the top edge of treeveiw - scroll up
m_iScrollDir = -1
ElseIf y > (Me!tvTreeView.Height - 500) And y <
Me!tvTreeView.Height Then
'scroll down
m_iScrollDir = 1
Else
m_iScrollDir = 0
End If
'Code here is fine (mostly)
'Create a reference to the TreeView control.
Set tvTreeView = Me!tvTreeView.Object
'If no node is selected, select the first node you dragged over.
If tvTreeView.SelectedItem Is Nothing Then
Set tvTreeView.SelectedItem = tvTreeView.HitTest(x, y)
'------------------------------------------------------------------------------------
Else
Debug.Print "OLEDragOver"
On Error Resume Next
'Alter the style of the cursor to indicate the node cannot be
dropped on the highlighted node
Select Case tvTreeView.HitTest(x, y).Tag
Case "itinerary"
Effect = 3
Case Else
Effect = 0
End Select
Debug.Print Err.Number, Err.Description
On Error GoTo 0
'------------------------------------------------------------------------------------
End If
'Highlight the node being dragged over as a potential drop target.
Set tvTreeView.DropHighlight = tvTreeView.HitTest(x, y)
Exit Sub
Err_OleDragOver:
Stop
End Sub
'==================================================================
'The OLEDragDrop event moves the selected node on the TreeView
'control to its new location and changes the corresponding record in
'the Employees table. The procedure first checks that the TreeView
'has a selected node. If so, it continues to check if a drop target
'node is highlighted. If no node is highlighted, then the user has
'dragged the node off the tree and dropped it into a blank area, and
'the procedure adds a branch to the root of the tree. If a node is
'highlighted, the procedure modifies the Employee table's ReportTo
'field accordingly and sets the selected node's parent property
'to the node that has the drop highlight.
'==================================================================
Private Sub TreeView_OLEDragDrop(Data As Object, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo ErrTreeView_OLEDragDrop
Dim tvTreeView As TreeView
Dim strKey As String, strText As String
Dim nodeNew As Node, nodeDragged As Node
'DEV change the timer value back to the original value
Me.TimerInterval = mOldFormTimer
Set tvTreeView = Me!tvTreeView.Object
'If nothing is selected for drag, do nothing.
If tvTreeView.SelectedItem Is Nothing Then
Else
'Reference the selected node as the one being dragged.
Set nodeDragged = tvTreeView.SelectedItem
'--------------------------------------------------------------
If tvTreeView.DropHighlight.Tag = "itinerary" Then
Set nodeDragged.Parent = tvTreeView.DropHighlight
ElseIf tvTreeView.DropHighlight <> "itinerary" Then
Call MsgBox("Transfers can only be moved to
itinerary nodes.", vbExclamation, Application.Name)
ElseIf nodeDragged.Index <> tvTreeView.DropHighlight.Index Then
'do nothing
End If
'--------------------------------------------------------------
End If
'Deselect the node
Set nodeDragged = Nothing
'Unhighlight the nodes.
Set tvTreeView.DropHighlight = Nothing
ExitTreeView_OLEDragDrop:
Exit Sub
ErrTreeView_OLEDragDrop:
Stop
'Code copied over, doesn't neccessarily apply and may be deleted
'If you create a circular branch.
If Err.Number = 35614 Then
MsgBox "A supervisor cannot report to a subordinate.", _
vbCritical, "Move Cancelled"
Else
MsgBox "An error occurred while trying to move the node. " & _
"Please try again." & vbCrLf & Err.Description
End If
Resume ExitTreeView_OLEDragDrop
End Sub
Private Sub Form_Timer()
'DEV all code copied over, the SEND MESSAGE appears in a separate module
(see below for the code) I'm assuming that SEND MESSAGE is the means by
which the tree view is actually scrolled
On Error GoTo Err_FormTimer
'Static lngStayCount As Long, strStayNode As String
If mfInDrag Then
'DEV this code craps out, has something to do with not being
able to grab the highlighted code
Set tvCtrl.DropHighlight = Me.tvTreeView.HitTest(cursorX, cursorY)
If tvScrollDir = -1 Then 'Scroll Up
' Send a WM_VSCROLL message 0 is up and 1 is down
SendMessage tvCtrl.hWnd, 277&, 0&, vbNull
ElseIf tvScrollDir = 1 Then 'Scroll Down
SendMessage tvCtrl.hWnd, 277&, 1&, vbNull
End If
End If
Exit Sub
Err_FormTimer:
Stop
End Sub
Private Sub tvTreeView_OLECompleteDrag(Effect As Long)
'DEV
On Error GoTo err_OLECompleteDrag
Me.TimerInterval = mOldFormTimer
mfInDrag = False
Exit Sub
err_OLECompleteDrag:
Stop
End Sub
Private Sub tvTreeView_OLEStartDrag(Data As Object, AllowedEffects As Long)
'DEV
On Error GoTo err_oleStartDrag
mfInDrag = True
Me.TimerInterval = 200
Exit Sub
err_oleStartDrag:
Stop
End Sub