vbAccelerator - Contents of code file: frmDragDrop.frm

VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Object = "{A3A35BDB-3B6A-46F3-B662-08B8F72ECD03}#11.1#0"; "vbalTreeView.ocx"
Begin VB.Form frmDragDrop 
   Caption         =   "vbAccelerator TreeView: Dragging Between Controls"
   ClientHeight    =   6840
   ClientLeft      =   2760
   ClientTop       =   2340
   ClientWidth     =   7890
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmDragDrop.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6840
   ScaleWidth      =   7890
   Begin vbalIml.vbalImageList ilsIcons 
      Left            =   3000
      Top             =   3840
      _ExtentX        =   953
      _ExtentY        =   953
      Size            =   22960
      Images          =   "frmDragDrop.frx":45A2
      Version         =   131072
      KeyCount        =   20
      Keys            =  
       "NEWSPELLPRINTPREVIEWNULLALLBARSTOOLBARSPELLCHKMAILPROPSFINDNEXTFINDHELPP
      RINTREDOUNDOPASTECOPYCUTSAVEOPEN"
   End
   Begin VB.CommandButton cmdRemove 
      Caption         =   "<"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2940
      TabIndex        =   5
      Top             =   2340
      Width           =   375
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   ">"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2940
      TabIndex        =   4
      Top             =   1920
      Width           =   375
   End
   Begin vbalTreeViewLib.vbalTreeView tvwSelected 
      Height          =   3615
      Left            =   3360
      TabIndex        =   1
      Top             =   840
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   6376
      Style           =   6
      OLEDropMode     =   1
      DragAutoExpand  =   -1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin vbalTreeViewLib.vbalTreeView tvwSource 
      Height          =   3555
      Left            =   60
      TabIndex        =   0
      Top             =   840
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   6271
      OLEDropMode     =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmDragDrop.frx":9F72
      Height          =   435
      Left            =   60
      TabIndex        =   6
      Top             =   60
      Width           =   7755
   End
   Begin VB.Label lblSelected 
      BackColor       =   &H80000010&
      Caption         =   " Se&lected Items"
      ForeColor       =   &H80000016&
      Height          =   255
      Left            =   3360
      TabIndex        =   3
      Top             =   540
      Width           =   2775
   End
   Begin VB.Label lblSource 
      BackColor       =   &H80000010&
      Caption         =   " &Source Items"
      ForeColor       =   &H80000016&
      Height          =   255
      Left            =   60
      TabIndex        =   2
      Top             =   540
      Width           =   2775
   End
End
Attribute VB_Name = "frmDragDrop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_lKeyID As Long

Private Sub AddBarPlaceHolder(nod As cTreeViewNode)
   If Not (nod.Text = "-") Then
      If (nod.Children.count = 0) Then
         Dim nodPlaceHolder As cTreeViewNode
         m_lKeyID = m_lKeyID + 1
         Set nodPlaceHolder = nod.AddChildNode(m_lKeyID & ":EMPTY", "(No Bar)",
          ilsIcons.ItemIndex("NULL") - 1, ilsIcons.ItemIndex("NULL") - 1)
         nodPlaceHolder.ItemData = 1
      End If
   End If
End Sub

Private Function IconIndex(ByVal sName As String) As Long
Dim i As Long
Dim sKey As String
Dim sCh As String
   For i = 1 To Len(sName)
      sCh = UCase(Mid(sName, i, 1))
      Select Case AscW(sCh)
      Case AscW("A") To AscW("Z")
         sKey = sKey & sCh
      End Select
   Next i
   
   On Error Resume Next
   i = ilsIcons.ItemIndex(sKey)
   If (Err.Number = 0) And (i > 0) Then
      IconIndex = i - 1
   Else
      IconIndex = ilsIcons.ItemIndex("NULL") - 1
   End If
   
End Function

Private Sub CreateItems( _
      nodAddTo As cTreeViewNode, _
      sName As String, _
      ParamArray items() As Variant _
   )
Dim nodRoot As cTreeViewNode
Dim i As Long
   Set nodRoot = nodAddTo.Children.Add(, , sName, sName,
    ilsIcons.ItemIndex("NULL") - 1)
   For i = LBound(items) To UBound(items)
      nodRoot.Children.Add , , sName & ":" & items(i) & ":" &
       nodRoot.Children.count, items(i), IconIndex(items(i))
   Next i
   nodRoot.Expanded = True
End Sub

Private Sub CreateSourceItems()
Dim nodRoot As cTreeViewNode
Dim nodItems As cTreeViewNode
   With tvwSource
      Set nodRoot = .Nodes.Add(, etvwFirst, "ROOT", "All Items",
       ilsIcons.ItemIndex("ALLBARS") - 1)
      Set nodItems = nodRoot.Children.Add(, , "MENUS", "Main Menu",
       ilsIcons.ItemIndex("TOOLBAR") - 1)
      CreateItems nodItems, "&File", "&New", "&Open", "&Close", "-", "&Save",
       "&Save As...", "-", "Page Set&up", "Print Pre&view", "&Print", "-",
       "E&xit"
      CreateItems nodItems, "&Edit", "&Undo", "&Redo", "-", "Cu&t", "&Copy",
       "&Paste", "&Clear", "-", "Select &All", "Invert &Selection", "-",
       "&Find...", "Find &Next", "&Replace...", "&Go to..."
      nodItems.Expanded = True
      nodRoot.Expanded = True
      
      Set nodItems = nodRoot.Children.Add(, , "TOOLBARS", "Toolbars",
       ilsIcons.ItemIndex("TOOLBAR") - 1)
      CreateItems nodItems, "&Standard", "New", "Open", "Save", "Mail", "-",
       "Print", "Print Preview", "Spell", "-", "Cut", "Copy", "Paste", "-",
       "Undo", "Redo", "-", "Zoom", "-", "Help"
      nodItems.Expanded = True

   End With
End Sub

Private Sub cmdAdd_Click()
   '
   If Not (tvwSource.SelectedItem Is Nothing) Then
      Dim nodTo As cTreeViewNode
      Set nodTo = tvwSelected.SelectedItem
      duplicateFromSource nodTo, False, tvwSource.SelectedItem
   End If
   '
End Sub

Private Sub cmdRemove_Click()
   '
   If Not tvwSelected.SelectedItem Is Nothing Then
      ' Don't allow the empty bar place holder to be deleted
      If Not (tvwSelected.SelectedItem.ItemData = 1) Then
         tvwSelected.SelectedItem.Delete
         cmdRemove.Enabled = Not (tvwSelected.SelectedItem Is Nothing)
      End If
   End If
   '
End Sub

Private Sub Form_Load()
   
   tvwSelected.ImageList = ilsIcons.hIml
   tvwSource.ImageList = ilsIcons.hIml
   
   CreateSourceItems
   tvwSource.Nodes(1).Selected = True
   
End Sub

Private Sub Form_Resize()
Dim lSize As Long
Dim lHeight As Long
   
   lSize = (Me.ScaleWidth - tvwSource.left * 4 - cmdAdd.Width) \ 2
   lHeight = Me.ScaleHeight - tvwSource.tOp - 4 * Screen.TwipsPerPixelY
   On Error Resume Next
   tvwSource.Move tvwSource.left, tvwSource.tOp, lSize, lHeight
   lblSource.Width = lSize
   cmdAdd.Move tvwSource.left * 2 + tvwSource.Width, (Me.ScaleHeight -
    (cmdAdd.Height * 2 + 30)) \ 2
   cmdRemove.Move cmdAdd.left, cmdAdd.tOp + cmdAdd.Height + 30
   lblSelected.Move cmdAdd.left + cmdAdd.Width + tvwSource.left,
    lblSelected.tOp, lSize
   tvwSelected.Move lblSelected.left, tvwSource.tOp, lSize, lHeight
   
End Sub

Private Sub tvwSelected_DragDropRequest(Data As DataObject, nodeOver As
 vbalTreeViewLib.cTreeViewNode, ByVal bAbove As Boolean, ByVal hitTest As Long)
   '
   
   ' Get the node being dragged:
   Dim nod As cTreeViewNode
   Dim nodParent As cTreeViewNode
   
   Set nod = tvwSelected.NodeFromDragData(Data)
   
   ' Check that we're dragging a node:
   If Not (nod Is Nothing) Then
            
      ' Unfortunately nod.Owner returns the control, not the extender.
      ' Therefore for object equality we need to compare the hWnds
      If (nod.Owner.hwnd = tvwSelected.hwnd) Then
         ' Confirm that we're not trying to do something silly,
         ' such as make a node a child of itself
         If Not nod.IsParentOf(nodeOver) Then
            Set nodParent = nod.Parent
            ' dragging internally within tvwSelected
            nod.MoveNode nodeOver, IIf(bAbove, etvwPrevious, etvwNext)
            ' If we had an "empty bar place holder then delete it
            If (nodeOver.ItemData = 1) Then
               nodeOver.Delete
            ' If we've left a bar empty then put the place holder back in
            ElseIf Not (nodParent Is Nothing) Then
               AddBarPlaceHolder nodParent
            End If
         End If
      Else
         ' dragging from source to selected
         duplicateFromSource nodeOver, bAbove, nod
      End If
   
   End If
   '
End Sub

Private Sub duplicateFromSource(nodeOver As cTreeViewNode, ByVal bAbove As
 Boolean, nodeDrag As cTreeViewNode)
   
   '
   ' Confirm that nodeOver is not a virtual node allowing subitems to
   ' be added:
   recurseDuplicateFromSource nodeOver, etvwNext, nodeDrag
   ' If we had an "empty bar" place holder then delete it
   If Not (nodeOver Is Nothing) Then ' dragging to the root
      If (nodeOver.ItemData = 1) Then ' place holder flag
         nodeOver.Delete
      End If
   End If
   '
   
End Sub

Private Sub recurseDuplicateFromSource( _
      nodeTo As cTreeViewNode, _
      ByVal eRelationship As ETreeViewRelationshipContants, _
      nodeFrom As cTreeViewNode _
   )
Dim newNode As cTreeViewNode
Dim i As Long
Dim sNewKey As String
   
   ' Generate new key:
   m_lKeyID = m_lKeyID + 1
   sNewKey = m_lKeyID & ":" & nodeFrom.Key
   ' Add the node:
   Set newNode = tvwSelected.Nodes.Add(nodeTo, eRelationship, sNewKey,
    nodeFrom.Text, nodeFrom.Image, nodeFrom.SelectedImage)
   ' If the node has children, then recursively duplicate them,
   ' otherwise add an "empty bar" place holder if appropriate
   If (nodeFrom.Children.count > 0) Then
      For i = 1 To nodeFrom.Children.count
         recurseDuplicateFromSource newNode, etvwChild, nodeFrom.Children(i)
      Next i
   Else
      AddBarPlaceHolder newNode
   End If
   
End Sub

Private Sub tvwSelected_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
   ' From Selected we move items internally
   AllowedEffects = vbDropEffectMove
End Sub

Private Sub tvwSelected_SelectedNodeChanged()
   cmdRemove.Enabled = Not (tvwSelected.SelectedItem Is Nothing)
End Sub

Private Sub tvwSource_DragDropRequest(Data As DataObject, nodeOver As
 vbalTreeViewLib.cTreeViewNode, ByVal bAbove As Boolean, ByVal hitTest As Long)
Dim nodeDrag As cTreeViewNode
   
   Set nodeDrag = tvwSource.NodeFromDragData(Data)
   If Not (nodeDrag Is Nothing) Then
      '
      If (nodeDrag.Owner.hwnd = tvwSelected.hwnd) Then
         ' We just delete the item from the selected items tree
         nodeDrag.Delete
      End If
      '
   End If
   
End Sub

Private Sub tvwSource_OLEDragOver(Data As DataObject, Effect As Long, Button As
 Integer, Shift As Integer, x As Single, y As Single, State As Integer)
Dim nodeDrag As cTreeViewNode
      
   Effect = vbDropEffectNone
   
   ' Allow selected items to be deleted by dropping them
   ' back onto source:
   Set nodeDrag = tvwSource.NodeFromDragData(Data)
   If Not (nodeDrag Is Nothing) Then
      ' Owner returns a control, not an extender so use
      ' hWnd to compare object equality
      If (nodeDrag.Owner.hwnd = tvwSelected.hwnd) Then
         Effect = vbDropEffectMove
      End If
   End If
   
End Sub

Private Sub tvwSource_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
Dim cNod As cTreeViewNode
   
   Set cNod = tvwSource.NodeFromDragData(Data)
   If Not (cNod Is Nothing) Then
      ' Don't allow the root node to be copied
      If (cNod.Key = tvwSource.Nodes(1).Key) Then
         AllowedEffects = vbDropEffectNone
      Else
         AllowedEffects = vbDropEffectCopy
      End If
   End If
   
End Sub

Private Sub tvwSource_SelectedNodeChanged()
   cmdAdd.Enabled = Not (tvwSource.SelectedItem Is Nothing)
End Sub