Another ListView Drag Drop Question

[Nitesh]

Hi All,

Please tell me how to do this. When I drag across from one listview to another I want the dragimage to show the actual text being dragged accross but with sort of a watermarked effect. Any help would be greatly appreciated.

Thanks.

[RhinoBull]

That is not an easy thing to accomplish so you may want to drop that idea for now.

[Mark Gambo]

How about something like this:

Option Explicit
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
 
Const LB_FINDSTRING = &H18F
Const LB_FINDSTRINGEXACT = &H1A2
Const CB_FINDSTRING = &H14C
Const CB_FINDSTRINGEXACT = &H158
 
Dim strText As String
Dim blnFlag As Boolean
 
Private Sub Form_Load()
Dim a As Integer
    For a = 1 To 10
        List1.AddItem "Item " & a
    Next a
    
    With Text1
        .Appearance = 0
        .BackColor = BackColor
        .BorderStyle = 0
        .ForeColor = &HC0C0C0
        .Text = ""
        .Visible = False
    End With
 
End Sub
 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = 1 Then
        strText = List1.Text
        Text1.Text = strText
        Text1.Visible = True
        blnFlag = True
    End If
 
End Sub
 
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If blnFlag Then
        Text1.Move X, Y
    End If
End Sub
 
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If blnFlag Then
        List2.AddItem strText
        List1.RemoveItem (ListBoxFindString(List1, strText)) 
    End If
 
Text1.Visible = False
blnFlag = False
End Sub
 
Private Function ListBoxFindString(ctrl As Control, ByVal search As String, _
    Optional startIndex As Long = -1, Optional ExactMatch As Boolean) As Long
    
    'This Function was created by: Francesco Balena
    'and can be found at: [url]http://www.devx.com/vb2themax/Tip/19121[/url]
    
    Dim uMsg As Long
    If TypeOf ctrl Is ListBox Then
        uMsg = IIf(ExactMatch, LB_FINDSTRINGEXACT, LB_FINDSTRING)
    ElseIf TypeOf ctrl Is ComboBox Then
        uMsg = IIf(ExactMatch, CB_FINDSTRINGEXACT, CB_FINDSTRING)
    Else
        Exit Function
    End If
    ListBoxFindString = SendMessage(ctrl.hWnd, uMsg, startIndex, ByVal search)
End Function

But you will have to figure out how to make the textbox transparent but you can probably do that use the code in this LINK to do that

[Nitesh]

How about something like this:

Option Explicit
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
 
Const LB_FINDSTRING = &H18F
Const LB_FINDSTRINGEXACT = &H1A2
Const CB_FINDSTRING = &H14C
Const CB_FINDSTRINGEXACT = &H158
 
Dim strText As String
Dim blnFlag As Boolean
 
Private Sub Form_Load()
Dim a As Integer
    For a = 1 To 10
        List1.AddItem "Item " & a
    Next a
    
    With Text1
        .Appearance = 0
        .BackColor = BackColor
        .BorderStyle = 0
        .ForeColor = &HC0C0C0
        .Text = ""
        .Visible = False
    End With
 
End Sub
 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = 1 Then
        strText = List1.Text
        Text1.Text = strText
        Text1.Visible = True
        blnFlag = True
    End If
 
End Sub
 
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If blnFlag Then
        Text1.Move X, Y
    End If
End Sub
 
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If blnFlag Then
        List2.AddItem strText
        List1.RemoveItem (ListBoxFindString(List1, strText)) 
    End If
 
Text1.Visible = False
blnFlag = False
End Sub
 
Private Function ListBoxFindString(ctrl As Control, ByVal search As String, _
    Optional startIndex As Long = -1, Optional ExactMatch As Boolean) As Long
    
    'This Function was created by: Francesco Balena
    'and can be found at: [url]http://www.devx.com/vb2themax/Tip/19121[/url]
    
    Dim uMsg As Long
    If TypeOf ctrl Is ListBox Then
        uMsg = IIf(ExactMatch, LB_FINDSTRINGEXACT, LB_FINDSTRING)
    ElseIf TypeOf ctrl Is ComboBox Then
        uMsg = IIf(ExactMatch, CB_FINDSTRINGEXACT, CB_FINDSTRING)
    Else
        Exit Function
    End If
    ListBoxFindString = SendMessage(ctrl.hWnd, uMsg, startIndex, ByVal search)
End Function

But you will have to figure out how to make the textbox transparent but you can probably do that use the code in this LINK to do that

Thanks alot Mark,

I'll give it a go now.

[Mark Gambo]

Good Luck!!!!