108.txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

拖拽节点时实现目录树自动翻滚 
武汉水利电力大学动力系 
郑志波 郭巧菊 
---- 目录树控件（Treeview Control）可以支持鼠标拖拽，我们可以拖动节点从一个父节点到另一个父节点、从目录树控件中移出子节点或进行相反操作。当拖拽一个子节点到目录树控件的顶部或底部时，我们希望程序能自动翻滚目录树（就象Windows 的资源管理器那样），但使用目录树控件进行程序设计时，程序并不会自动实现这项功能，如果能通过编程来完善，必将使程序增色不少。本文将通过Visual Basic 开发环境下的一个实例来演示如何实现拖拽子节点时让目录树自动翻滚。 

新建一工程（Visual Basic 会创建一缺省窗体Form1）； 

点击“工程”菜单下的“部件”子菜单项，弹出“部件”选择对话框，选中“Microsoft Windows Common Controls 6.0."； 

添加目录树（Treeview）、 图象列表（ImageList）和时钟（Timer）控件到 Form1； 

鼠标右键单击ImageList控件，从弹出菜单中选择“属性”子菜单，在“通用”属性页选择“16 x 16”，在“图象”属性页中添加两个图标（在 \Microsoft Visual Studio\Common\Graphics\Icons 目录下任选"）； 

添加以下代码到Form1 的代码窗口：
      '强制变量声明
      Option Explicit
      '声明 API 函数
      Private Declare Function SendMessage Lib 
		"user32" Alias _
             "SendMessageA" (ByVal hwnd As Long, _
             ByVal wMsg As Long, ByVal wParam As Long,
		 lParam As Any) As Long
      '声明模块级变量
      Dim msngX As Single
      Dim msngY As Single
      Dim moNode As Node
      Dim mintScrollDir As Integer '滚动方向

      ' 初始化程序  
      Private Sub Form_Load()
         Dim x As Integer
         Dim y As Integer        ' 用作循环变量 
         Timer1.Enabled = False   ' 禁止翻滚
         Timer1.Interval = 200
         TreeView1.Style = 
		tvwTreelinesPlusMinusPictureText
         TreeView1.ImageList = ImageList1
         '填充 TreeView 控件
         For x = 1 To 50
           TreeView1.Nodes.Add Text:="节点 "
		 & x, Image:=1, _
              SelectedImage:=2
         Next x
         For x = 1 To 50
           For y = 1 To 5
              TreeView1.Nodes.Add Relative:=x, 
		Relationship:=tvwChild, _
               Text:="子节点 " & y, _
               Image:=1, SelectedImage:=2
           Next y
         Next x
      End Sub

      Private Sub Form_DragOver(Source As Control,
	 x As Single, y As _Single, State As Integer)
         If Source.Name = "TreeView1" Then 
	Timer1.Enabled = False    ' 停止翻滚
      End Sub

      Private Sub Timer1_Timer()  
	 '翻滚目录树（TreeView）控件
         Set TreeView1.DropHighlight = 
	TreeView1.HitTest(msngX, msngY)
         '通过发送 WM_VSCROLL 消息实现翻滚
         If mintScrollDir = -1 Then '向上翻滚
             SendMessage TreeView1.hwnd, 277&, 0&, vbNull
         Else '向下翻滚
           SendMessage TreeView1.hwnd, 277&, 1&, vbNull
         End If
      End Sub
      
      ' 一个完整的拖放动作（即将一个控件拖动到
      '	一个对象上，并释放鼠标按钮）完成
      ' 后的处理
      Private Sub TreeView1_DragDrop(Source
		As Control, x As Single, _
        y As Single)
        If Not TreeView1.DropHighlight Is Nothing Then
          MsgBox moNode.Text & " 拖放到 " & _
          TreeView1.DropHighlight.Text
        End If
        Set TreeView1.DropHighlight = Nothing
        Set moNode = Nothing
        Timer1.Enabled = False  ' 停止滚动
      End Sub


      ' 在拖放操作正在进行时发生 DragOver 事件。
      当鼠标指针在一个有效目标上
      ' 的进入、离开或停顿会触发此事件。
      ' 鼠标指针的位置决定接收此事件的目标对象。
      Private Sub TreeView1_DragOver(Source As Control,
	 x As Single, _y As Single, State As Integer)
        Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
        msngX = x
        msngY = y
        ' 当拖拽鼠标指针到TreeView 控件顶部
        （坐标为0 ~ 100 Twips 时，
        ' TreeView向上翻滚
        If y > 0 And y < 100 Then
          mintScrollDir = -1
          Timer1.Enabled = True    ' 开始翻滚  
        ' 当拖拽鼠标指针到TreeView 控件底部
          （距离TreeView 控件底端
        ' 200 ~ 0 Twips）时，TreeView向下翻滚
        ElseIf y > (TreeView1.Height - 200) And
	 y < TreeView1.Height Then
        '向下翻滚
          mintScrollDir = 1
          Timer1.Enabled = True  ' 开始翻滚
        Else
          Timer1.Enabled = False  ' 停止滚动
        End If
      End Sub
     
      ' 释放鼠标
      Private Sub TreeView1_MouseUp(Button As Integer, 
	Shift As Integer, _x As Single, y As Single)
       Timer1.Enabled = False  '停止翻滚
      End Sub

      ' 按下鼠标  
      Private Sub TreeView1_MouseDown
     (Button As Integer, Shift As _
      Integer, x As Single, y As Single)
       TreeView1.DropHighlight = TreeView1.HitTest(x, y)
       '判断是否选中一个节点
       If Not TreeView1.DropHighlight Is Nothing Then
          TreeView1.SelectedItem = TreeView1.HitTest(x, y)
          Set moNode = TreeView1.SelectedItem
       End If
       Set TreeView1.DropHighlight = Nothing
      End Sub

      ' 鼠标移动
      Private Sub TreeView1_MouseMove
      (Button As Integer, Shift As _
      Integer, x As Single, y As Single)
       If Button = vbLeftButton Then    '左键
          TreeView1.DragIcon =
           TreeView1.SelectedItem.CreateDragImage
          TreeView1.Drag vbBeginDrag
       End If
      End Sub
---- 保存这个实例程序并运行它，拖拽任意节点到TreeView控件的顶部或底部，可以看到TreeView控件实现自动翻滚。以上程序在Windows95 系统, Visual Basic 6.0(中文企业版)开发环境调试运行通过。