form1.frm

vb控件vb控件vb控件vb控件vb控件vb控件vb控件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   4  'Fixed ToolWindow
   ClientHeight    =   6330
   ClientLeft      =   45
   ClientTop       =   225
   ClientWidth     =   6600
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6330
   ScaleWidth      =   6600
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1710
      Top             =   4020
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   16777215
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0114
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0228
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":033C
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView Trw 
      Height          =   6315
      Index           =   0
      Left            =   45
      TabIndex        =   0
      Top             =   30
      Width           =   3195
      _ExtentX        =   5636
      _ExtentY        =   11139
      _Version        =   393217
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
      OLEDropMode     =   1
   End
   Begin MSComctlLib.TreeView Trw 
      Height          =   6315
      Index           =   1
      Left            =   3330
      TabIndex        =   1
      Top             =   30
      Width           =   3195
      _ExtentX        =   5636
      _ExtentY        =   11139
      _Version        =   393217
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
      OLEDropMode     =   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FSO As New Scripting.FileSystemObject
Dim SourceTreeView As TreeView
Dim SourceNode As Node
Dim ShiftState As Integer

Private Sub AddRootNode(Index As Integer)
    Dim dr As Scripting.Drive
    Dim RootNode As Node
    Dim nd As Node
    On Error Resume Next
    Set RootNode = Trw(Index).Nodes.Add(, , "我的电脑", "我的电脑", 1)
    RootNode.Expanded = True
    For Each dr In FSO.Drives
        If dr.Path <> "A:" Then
            Err.Clear
            Set nd = Trw(Index).Nodes.Add(RootNode.Key, tvwChild, dr.Path & "\", dr.Path & dr.VolumeName, 2)
            If Err = 0 Then AddDynamic Index, nd
        End If
    Next
End Sub

Private Sub AddDynamic(Index As Integer, Note As MSComctlLib.Node)
    If Note.Children = 0 Then
        Trw(Index).Nodes.Add Note.Key, tvwChild, , "***"
    End If
End Sub

Private Sub Form_Load()
    AddRootNode 0
End Sub

Private Sub AddSubFolder(Index As Integer, Node As MSComctlLib.Node)
    On Error Resume Next
    Dim fl As Scripting.Folder
    Dim nd As Node
    For Each fl In FSO.GetFolder(Node.Key).SubFolders
        Set nd = Trw(Index).Nodes.Add(Node.Key, tvwChild, fl.Path, fl.Name, 3)
        nd.ExpandedImage = 4
        If fl.SubFolders.Count Then AddDynamic Index, nd
    Next
End Sub

Private Sub Trw_Expand(Index As Integer, ByVal Node As MSComctlLib.Node)
    If Node.Children = 0 Or Node.Children > 1 Then Exit Sub
    If Node.Child.Text <> "***" Then Exit Sub
    Trw(Index).Nodes.Remove Node.Child.Index
    AddSubFolder Index, Node
End Sub

Private Sub Trw_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button <> 2 Then Exit Sub
    Set SourceNode = Trw(Index).HitTest(x, y)
    If SourceNode Is Nothing Then Exit Sub
    Set SourceTreeView = Trw(Index)
    ShiftState = Shift
    Trw(indwx).OLEDrag
End Sub

Private Sub Trw_OLEDragDrop(Index As Integer, Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim dest As Node, nd As Node
    '得到这目标节点
    Set dest = Trw(Index).DropHighlight
    If dest Is Nothing Then
        '添加这个节点为目标控件的根节点
        Set nd = Trw(Index).Nodes.Add(, , , SourceNode.Text, SourceNode.Image)
    Else
        If SourceTreeView Is Trw(Index) Then
            Set nd = dest
            Do
                If nd Is SourceNode Then
                    MsgBox "不能拖放到这个节点,源和目标在同一节点", vbExclamation
                    Exit Sub
                End If
                Set nd = nd.Parent
            Loop Until nd Is Nothing
    End If
    Set nd = Trw(Index).Nodes.Add(dest.Index, tvwChild, , SourceNode.Text, SourceNode.Image)
    End If
    nd.ExpandedImage = SourceNode.ExpandedImage: nd.Expanded = True
    CopySubTree SourceTreeView, SourceNode, Trw(Index), nd
    If Effect = vbDropEffectMove Then
        SourceTreeView.Nodes.Remove SourceNode.Index
    End If
    Set Trw(Index).DropHighlight = Nothing
End Sub

Sub CopySubTree(SourceTv As TreeView, sourceNd As Node, DestTv As TreeView, destND As Node)
    Dim i As Long, so As Node, de As Node
    If sourceNd.Children = 0 Then Exit Sub
    Set so = sourceNd.Child
    For i = 1 To sourceNd.Children
        Set de = DestTv.Nodes.Add(destND, tvwChild, , so.Text, so.Image, so.SelectedImage)
        de.ExpandedImage = so.ExpandedImage
        CopySubTree SourceTv, so, DestTv, de
        Set so = so.Next
    Next
End Sub

Private Sub Trw_OLEDragOver(Index As Integer, Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    Set Trw(Index).DropHighlight = Trw(Index).HitTest(x, y)
End Sub

Private Sub Trw_OLEStartDrag(Index As Integer, Data As MSComctlLib.DataObject, AllowedEffects As Long)
    Data.SetData SourceNode.Key
    If ShiftState And vbCtrlMask Then
        AllowedEffects = vbDropEffectCopy
    Else
        AllowedEffects = vbDropEffectMove
    End If
End Sub