有没有办法把列表框里的项往外拖？

Question

就是那种想文件拖曳一样的效果，比如说直接从一个列表框拖到另一个列表框。

Answer 1

Private Sub Form_Load()
Dim i As Long
For i = 0 To 10
List1.AddItem "item" & i
Next
End SubPrivate Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   If List1.ListIndex <> -1 Then
      List1.DragIcon = Image1.Picture
      List1.Drag 1
   End If
End If
End SubPrivate Sub List2_DragDrop(Source As Control, X As Single, Y As Single)
Dim itmText As String
itmText = Source
For i = 0 To List1.ListCount - 1
    If List1.List(i) = itmText Then
       List1.RemoveItem (i)
       Exit For
    End If
NextList2.AddItem itmTextEnd Sub

Answer 2

这是一个双向的例子
在Form上添加两个List控件，一个Image控件，选择一个图片作为拖曳的鼠标指针.Private Sub Form_Load()
Dim i As Long
For i = 0 To 10
List1.AddItem "item" & i
Next
End SubPrivate Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   If List1.ListIndex <> -1 Then
      List1.DragIcon = Image1.Picture
      List1.Drag 1
   End If
End If
End SubPrivate Sub List2_DragDrop(Source As Control, X As Single, Y As Single)
Dim itmText As String
itmText = Source
For i = 0 To List1.ListCount - 1
    If List1.List(i) = itmText Then
       List1.RemoveItem (i)
       Exit For
    End If
NextList2.AddItem itmTextEnd SubPrivate Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   If List2.ListIndex <> -1 Then
      List2.DragIcon = Image1.Picture
      List2.Drag 1
   End If
End If
End SubPrivate Sub List1_DragDrop(Source As Control, X As Single, Y As Single)
Dim itmText As String
itmText = Source
For i = 0 To List2.ListCount - 1
    If List2.List(i) = itmText Then
       List2.RemoveItem (i)
       Exit For
    End If
NextList1.AddItem itmTextEnd Sub

Answer 3

谢谢了，我试过了，完全OK，再问一个别的问题，就是现在不是用的Image里面的图片吗，有没有办法让鼠标变成当前选中的文字，就想拖曳文件的时候显示的文件名一样。

Answer 4

可以用一个label控件跟着鼠标移动
用label控件显示

Answer 5

回复人： qsqwmy(禽兽) ( ) 信誉：100  2003-06-10 10:35:00  得分:0   可以用一个label控件跟着鼠标移动
  用label控件显示
你用这个方法吧

Answer 6

我的程序片段，拖动动画的例子，原理就是使用一个隐藏的LabelOption ExplicitPublic RepeatList2 As Boolean, RepeatList3 As BooleanConst LB_SETHORIZONTALEXTENT = &H194Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
If File1.ListCount <> 0 Then  Dim dy
  
  dy = TextHeight("A")
  
  DragLabel.Move File1.Left, File1.Top + Y - dy / 2, File1.Width, dy
  
  DragLabel.Drag
  
End If
    
End SubPrivate Sub Drive1_Change()    Dir1.Path = Drive1.Drive
    
End SubPrivate Sub Drive1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)    If State = 0 Then Source.MousePointer = 12
    
    If State = 1 Then Source.MousePointer = 0
    
End SubPrivate Sub File1_DragDrop(Source As Control, X As Single, Y As Single)    If ListDrop.ActiveControl.Name = "List2" Then
    
      If List2.ListCount <> 0 Then
      
         List2.RemoveItem List2.ListIndex
    
      End If
      
      If List2.ListCount = 0 Then
      
         Call SendMessage(List2.hwnd, LB_SETHORIZONTALEXTENT, 0, ByVal &O0) 
         
      End If
    
    ElseIf ListDrop.ActiveControl.Name = "List3" Then
    
      If List3.ListCount <> 0 Then
      
         List3.RemoveItem List3.ListIndex
         
      End If
      
      If List3.ListCount = 0 Then
      
         
         Call SendMessage(List3.hwnd, LB_SETHORIZONTALEXTENT, 0, ByVal &O0)
         
      End If
    
    End If
    
End Sub
Private Sub List2_DragDrop(Source As Control, X As Single, Y As Single)
    
    If ListDrop.ActiveControl.Name = "File1" Then 
      
       If Not RepeatList2 Then
          
          List2.AddItem Dir1 & "\" & File1.FileName
          
          '当路径长于37个字符，用API激活HScroll
          If LenB(StrConv(Trim(List2.List(List2.ListCount - 1)), vbFromUnicode)) > 45 Then
          
               Call SendMessage(List2.hwnd, LB_SETHORIZONTALEXTENT, 3975, ByVal 0&)
             
          End If
          
       Else
       
          RepeatList2 = False
          
       End If
    
    End IfEnd Sub
Private Sub List2_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    If ListDrop.ActiveControl.Name = "File1" Then
    
       Dim pathfile As String, i As Integer, Current As Integer
       
           pathfile = Trim(Dir1 & "\" & File1.FileName)
           
           Current = List2.ListIndex
           
           
       For i = 0 To List2.ListCount   'Delphi的ListIndexOf()巨好用:(
       
           If Trim(List2.List(i)) = pathfile Then
           
              RepeatList2 = True
              
              Exit For
           
           End If
       Next
       
            List2.ListIndex = Current
           
       If RepeatList2 Then  '已存在添加的项目，则处理鼠标使不能拖动
                 
          If State = 0 Then Source.MousePointer = 12
    
          If State = 1 Then Source.MousePointer = 0
       
       End If
    End If
    
End SubPrivate Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
  
 If List2.ListCount <> 0 Then
 
  Dim dy
    
      dy = TextHeight("A")    ' 用A字符来计算当前行高
      
      DragLabel.Move List2.Left, List2.Top + Y - dy / 2, File1.Width, dy
      
'      List2.Drag     ' List2 虽然设为手动拖动，但drag事件将拖动整体，用隐藏的label模拟一行被拖动      DragLabel.Drag  End If
      
End Sub
Private Sub List3_DragDrop(Source As Control, X As Single, Y As Single)    If ListDrop.ActiveControl.Name = "File1" Then  'Visiable Control 始终不算ActiveControl
      
      If Not RepeatList3 Then
      
         List3.AddItem Dir1 & "\" & File1.FileName
         
         If LenB(StrConv(Trim(List3.List(List3.ListCount - 1)), vbFromUnicode)) > 45 Then
         
            Call SendMessage(List3.hwnd, LB_SETHORIZONTALEXTENT, 3975, ByVal 0&)
            
         End If
         
      Else
      
         RepeatList3 = False
         
      End If
    
    End IfEnd SubPrivate Sub List3_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    
    
    If ListDrop.ActiveControl.Name = "File1" Then
    
       Dim pathfile As String, i As Integer, Current As Integer
       
           pathfile = Trim(Dir1 & "\" & File1.FileName)
           
           Current = List3.ListIndex
           
           
       For i = 0 To List3.ListCount  
       
           If Trim(List3.List(i)) = pathfile Then
           
              RepeatList3 = True
              
              Exit For
           
           End If
       Next
       
            List3.ListIndex = Current
           
       If RepeatList3 Then 
                 
          If State = 0 Then Source.MousePointer = 12
    
          If State = 1 Then Source.MousePointer = 0
       
       End If
    End IfEnd SubPrivate Sub List3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
 If List3.ListCount <> 0 Then
 
  Dim dy
  
  dy = TextHeight("A")
  
  DragLabel.Move List3.Left, List3.Top + Y - dy / 2, File1.Width, dy
    DragLabel.Drag End If
 
End Sub