Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse 
Author Message
 Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse

Hi all,
    I can't seem to get the dragicon to change in the mouse pointer when the
mouse is NOT moving.

    You know in the windows explorer how you can drag a file over to a
folder,
    and just stop moving the mouse while you press a combination of the
shift / ctrl keys to decide whether you want to Move, Copy, or Create a
Shortcut ?

    Well I can change the dragicon but it takes a few seconds for the change
to take effect.

Any help would be appreciated:

-----
'Module1.bas
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As
Integer

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long

-----
'form1.frm

 Dim ShiftStatus As Boolean

 Dim CTRLStatus As Boolean
 Dim MenuStatus As Boolean
 Dim inDrag As Boolean

 'Dim btn As Integer
' Dim shft As Integer
' Dim xpos As Single
' Dim ypos As Single

 Const VK_SHIFT = &H10 'SHIFT key
 Const VK_CONTROL = &H11 'CTRL key
 Const VK_MENU = &H12 'ALT key

 Const VK_LSHIFT = &HA0 'Left SHIFT key
 Const VK_RSHIFT = &HA1 'Right SHIFT key
 Const VK_LCONTROL = &HA2 'Left CONTROL key
 Const VK_RCONTROL = &HA3 'Right CONTROL key
 Const VK_LMENU = &HA4 'Left MENU key
 Const VK_RMENU = &HA5 'Right MENU key

Private Sub Timer1_Timer()

    Static LastShiftStatus
    Static LastCTRLStatus
    Static LastAltStatus

    Dim msgChange As Boolean

    ShiftStatus = GetKeyState(VK_SHIFT) And &H80
    CTRLStatus = GetKeyState(VK_CONTROL) And &H80
    AltStatus = GetKeyState(VK_MENU) And &H80

    msgChange = False

    'Copy Icon - ctrl and shift
   If CTRLStatus And ShiftStatus Then

        If ShiftStatus <> LastShiftStatus Then
            LastShiftStatus = ShiftStatus
            msgChange = True
        End If

        If CTRLStatus <> LastCTRLStatus Then
            LastCTRLStatus = CTRLStatus
            msgChange = True
        End If

        If msgChange = True Then
            Text1.DragIcon = ImageList1.ListImages(2).Picture
            Picture2.Picture = ImageList1.ListImages(2).Picture
        End If

    'Move Icon - shift only
   ElseIf ShiftStatus And Not CTRLStatus Then

        If ShiftStatus <> LastShiftStatus Then
             LastShiftStatus = ShiftStatus
             msgChange = True
         End If

         If CTRLStatus <> LastCTRLStatus Then
             LastCTRLStatus = CTRLStatus
             msgChange = True
         End If

        If msgChange = True Then
            Text1.DragIcon = ImageList1.ListImages(1).Picture
            Picture2.Picture = ImageList1.ListImages(1).Picture
        End If

    'No Drop Icon -
   ElseIf ShiftStatus <> LastShiftStatus Or CTRLStatus <> LastCTRLStatus
Then

        LastShiftStatus = ShiftStatus
        LastCTRLStatus = CTRLStatus
        msgChange = True

        Text1.DragIcon = ImageList1.ListImages(3).Picture
        Picture2.Picture = ImageList1.ListImages(3).Picture

   End If

    Dim msg

    If msgChange = True Then

        msg = Time & vbCrLf
        msg = msg & "Shift: " & ShiftStatus & vbCrLf
        msg = msg & "Ctrl: " & CTRLStatus & vbCrLf
        msg = msg & "Menu: " & AltStatus & vbCrLf

        Picture1.Picture = Text1.DragIcon

        Text3.Text = msg & Text3.Text

        'reported that this command immediately updates cursor - it DOES NOT
        '   still takes a few seconds for cursor to change
        SendMessage Text1.hwnd, WM_SETCURSOR, 0, 0

'        Attempting to force a mousemove ----- doesn't help
'        Call Text1_MouseMove(btn, shft, xpos + 1000, ypos)

        DoEvents

    End If

End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)

    Dim LeftDown
    Dim RightDown
    Dim CtrlDown
    Dim ShiftDown
    Dim ALTDown

    RightDown = (Button And vbRightButton) > 0
    LeftDown = (Button And vbLeftButton) > 0

    CtrlDown = (Shift And vbCtrlMask) > 0
    ShiftDown = (Shift And vbShiftMask) > 0
    ALTDown = (Shift And vbAltMask) > 0

    If LeftDown Then ' Signal a Drag operation.
          inDrag = True ' Set the flag to true.
          Text2.Text = "inDrag"
          Text1.Drag vbBeginDrag
    End If
End Sub

Private Sub Text2_DragDrop(Source As Control, X As Single, Y As Single)
    inDrag = False
    Text2.Text = "NOT inDrag"
End Sub

--------------

Thanks,
    Barry G. Sumpter



Tue, 31 May 2005 08:21:09 GMT  
 Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse
As long as you've moved the rodent a tad, a change to your sendmessage call
will toggle the cursor as the keys are pressed without further movement..

SendMessage Text1.hwnd, WM_SETCURSOR, Picture2.hwnd, ByVal -1

The problem is you don't set the drag operation until the mouse move event
fires.  You might want to drop the code from the mousemove event entirely,
add a Dim LeftDown as boolean to the general declarations, add LeftDown =
(Button = vbLeftButton) to Text1_MouseDown, then add the drag-setting code
to the timer event ...

    If msgChange = True Then

       If LeftDown Then ' Signal a Drag operation.

         inDrag = True ' Set the flag to true.
         Text2.Text = "inDrag"
         Text1.Drag vbBeginDrag

         Picture1.Picture = Text1.DragIcon
         Text3.Text = msg & Text3.Text

         SendMessage Text1.hwnd, WM_SETCURSOR, Picture2.hwnd, ByVal -1

       End If

    End If

You'll still have to play around to get things right --  and textbox isn't
the greatest to use because its i-beam cursor overrides the cursor you
assign if you move back into the text area, but this at least addresses the
instantaneous issue you had.  For my tests I had set the timer interval to
1.
--

Randy Birch
MVP Visual Basic
http://www.mvps.org/vbnet/
Please respond only to the newsgroups so all can benefit.



| Hi all,
|     I can't seem to get the dragicon to change in the mouse pointer when
the
| mouse is NOT moving.
|
|
|     You know in the windows explorer how you can drag a file over to a
| folder,
|     and just stop moving the mouse while you press a combination of the
| shift / ctrl keys to decide whether you want to Move, Copy, or Create a
| Shortcut ?
|
|     Well I can change the dragicon but it takes a few seconds for the
change
| to take effect.
|
| Any help would be appreciated:
|
| -----
| 'Module1.bas
| Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
As
| Integer
|
| Public Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal
| hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
| Long
|
|
| -----
| 'form1.frm
|
|
|  Dim ShiftStatus As Boolean
|
|  Dim CTRLStatus As Boolean
|  Dim MenuStatus As Boolean
|  Dim inDrag As Boolean
|
|
|  'Dim btn As Integer
| ' Dim shft As Integer
| ' Dim xpos As Single
| ' Dim ypos As Single
|
|  Const VK_SHIFT = &H10 'SHIFT key
|  Const VK_CONTROL = &H11 'CTRL key
|  Const VK_MENU = &H12 'ALT key
|
|  Const VK_LSHIFT = &HA0 'Left SHIFT key
|  Const VK_RSHIFT = &HA1 'Right SHIFT key
|  Const VK_LCONTROL = &HA2 'Left CONTROL key
|  Const VK_RCONTROL = &HA3 'Right CONTROL key
|  Const VK_LMENU = &HA4 'Left MENU key
|  Const VK_RMENU = &HA5 'Right MENU key
|
|
| Private Sub Timer1_Timer()
|
|     Static LastShiftStatus
|     Static LastCTRLStatus
|     Static LastAltStatus
|
|     Dim msgChange As Boolean
|
|     ShiftStatus = GetKeyState(VK_SHIFT) And &H80
|     CTRLStatus = GetKeyState(VK_CONTROL) And &H80
|     AltStatus = GetKeyState(VK_MENU) And &H80
|
|
|     msgChange = False
|
|
|     'Copy Icon - ctrl and shift
|    If CTRLStatus And ShiftStatus Then
|
|         If ShiftStatus <> LastShiftStatus Then
|             LastShiftStatus = ShiftStatus
|             msgChange = True
|         End If
|
|         If CTRLStatus <> LastCTRLStatus Then
|             LastCTRLStatus = CTRLStatus
|             msgChange = True
|         End If
|
|         If msgChange = True Then
|             Text1.DragIcon = ImageList1.ListImages(2).Picture
|             Picture2.Picture = ImageList1.ListImages(2).Picture
|         End If
|
|     'Move Icon - shift only
|    ElseIf ShiftStatus And Not CTRLStatus Then
|
|         If ShiftStatus <> LastShiftStatus Then
|              LastShiftStatus = ShiftStatus
|              msgChange = True
|          End If
|
|          If CTRLStatus <> LastCTRLStatus Then
|              LastCTRLStatus = CTRLStatus
|              msgChange = True
|          End If
|
|         If msgChange = True Then
|             Text1.DragIcon = ImageList1.ListImages(1).Picture
|             Picture2.Picture = ImageList1.ListImages(1).Picture
|         End If
|
|     'No Drop Icon -
|    ElseIf ShiftStatus <> LastShiftStatus Or CTRLStatus <> LastCTRLStatus
| Then
|
|         LastShiftStatus = ShiftStatus
|         LastCTRLStatus = CTRLStatus
|         msgChange = True
|
|         Text1.DragIcon = ImageList1.ListImages(3).Picture
|         Picture2.Picture = ImageList1.ListImages(3).Picture
|
|    End If
|
|
|     Dim msg
|
|     If msgChange = True Then
|
|         msg = Time & vbCrLf
|         msg = msg & "Shift: " & ShiftStatus & vbCrLf
|         msg = msg & "Ctrl: " & CTRLStatus & vbCrLf
|         msg = msg & "Menu: " & AltStatus & vbCrLf
|
|         Picture1.Picture = Text1.DragIcon
|
|
|         Text3.Text = msg & Text3.Text
|
|         'reported that this command immediately updates cursor - it DOES
NOT
|         '   still takes a few seconds for cursor to change
|         SendMessage Text1.hwnd, WM_SETCURSOR, 0, 0
|
| '        Attempting to force a mousemove ----- doesn't help
| '        Call Text1_MouseMove(btn, shft, xpos + 1000, ypos)
|
|         DoEvents
|
|
|     End If
|
|
| End Sub
|
|
|
| Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As
| Single, Y As Single)
|
|     Dim LeftDown
|     Dim RightDown
|     Dim CtrlDown
|     Dim ShiftDown
|     Dim ALTDown
|
|     RightDown = (Button And vbRightButton) > 0
|     LeftDown = (Button And vbLeftButton) > 0
|
|     CtrlDown = (Shift And vbCtrlMask) > 0
|     ShiftDown = (Shift And vbShiftMask) > 0
|     ALTDown = (Shift And vbAltMask) > 0
|
|     If LeftDown Then ' Signal a Drag operation.
|           inDrag = True ' Set the flag to true.
|           Text2.Text = "inDrag"
|           Text1.Drag vbBeginDrag
|     End If
| End Sub
|
| Private Sub Text2_DragDrop(Source As Control, X As Single, Y As Single)
|     inDrag = False
|     Text2.Text = "NOT inDrag"
| End Sub
|
| --------------
|
| Thanks,
|     Barry G. Sumpter
|
|
|
|
|
|



Tue, 31 May 2005 11:35:00 GMT  
 Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse
Thanks for the help Randy.

My code cleaned up and working well enough for posting as example here.

Barry G. Sumpter

Module1.bas

Public Type POINTAPI
    x As Long
    y As Long
End Type
Public mousePT As POINTAPI

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As
Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y
As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As
Integer

Public x As Long, y As Long

Form1.frm  (code only)

 Option Explicit

 Dim ShiftDown As Boolean
 Dim CTRLDown As Boolean

 Dim LeftButtonDown As Boolean ' left mouse

 Const VK_SHIFT = &H10 'SHIFT key
 Const VK_CONTROL = &H11 'CTRL key
 Const VK_LBUTTON = &H1 'Left Mouse Button

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)

    Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

    Static PrevShiftDown As Boolean
    Static PrevCTRLDown As Boolean

    Dim KeyChange As Boolean

    ShiftDown = GetKeyState(VK_SHIFT) And &H80
    CTRLDown = GetKeyState(VK_CONTROL) And &H80
    LeftButtonDown = GetKeyState(VK_LBUTTON) And &H80

    If LeftButtonDown >= 0 Then
        Timer1.Enabled = False
        Exit Sub
    End If

    KeyChange = False

    'Copy Icon - shift and ctrl
    If CTRLDown And ShiftDown Then

        If ShiftDown <> PrevShiftDown Then
            PrevShiftDown = ShiftDown
            KeyChange = True
        End If

        If CTRLDown <> PrevCTRLDown Then
            PrevCTRLDown = CTRLDown
            KeyChange = True
        End If

        If KeyChange = True Then
            Text1.DragIcon = ImageList1.ListImages(2).Picture
        End If

    'Move Icon - shift only
   ElseIf ShiftDown And Not CTRLDown Then

        If ShiftDown <> PrevShiftDown Then
             PrevShiftDown = ShiftDown
             KeyChange = True
         End If

         If CTRLDown <> PrevCTRLDown Then
             PrevCTRLDown = CTRLDown
             KeyChange = True
         End If

        If KeyChange = True Then
            Text1.DragIcon = ImageList1.ListImages(1).Picture
        End If

    'No Drop Icon -
   ElseIf ShiftDown <> PrevShiftDown Or CTRLDown <> PrevCTRLDown Then

        PrevShiftDown = ShiftDown
        PrevCTRLDown = CTRLDown
        KeyChange = True

        Text1.DragIcon = ImageList1.ListImages(3).Picture

   End If

    If KeyChange = True Then

         Call GetCursorPos(mousePT)

         x = mousePT.x
         y = mousePT.y

         Text1.Drag vbBeginDrag

         SetCursorPos x, y

    End If

End Sub

Private Sub Text2_DragDrop(Source As Control, x As Single, y As Single)
    Text2.Text = "Dropped"
End Sub



Fri, 03 Jun 2005 03:30:12 GMT  
 Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse
And for multiple controls:

 Option Explicit

 Dim ShiftDown As Boolean
 Dim CTRLDown As Boolean

 Dim LeftButtonDown As Boolean ' left mouse

 Const VK_SHIFT = &H10 'SHIFT key
 Const VK_CONTROL = &H11 'CTRL key
 Const VK_LBUTTON = &H1 'Left Mouse Button

 Dim DragControl As Control

Private Sub Form_Load()
   Dim nodX As Node
   Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
   Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
   Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
   Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
   Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
   nodX.EnsureVisible
   TreeView1.Style = tvwTreelinesText ' Style 4.
   TreeView1.BorderStyle = vbFixedSingle

End Sub

Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)

    Set DragControl = TreeView1
    DragTimer.Enabled = True

End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)

    Set DragControl = Text1
    DragTimer.Enabled = True

End Sub

Private Sub DragTimer_Timer()

    Static TimerInitialized As Boolean

    Static PrevShiftDown As Boolean
    Static PrevCTRLDown As Boolean

    Dim KeyChange As Boolean

    LeftButtonDown = GetKeyState(VK_LBUTTON) And &H80

    If LeftButtonDown >= 0 Then
        DragTimer.Enabled = False
        TimerInitialized = False
        Exit Sub
    End If

    ShiftDown = GetKeyState(VK_SHIFT) And &H80
    CTRLDown = GetKeyState(VK_CONTROL) And &H80

    KeyChange = False

    If Not TimerInitialized Then
         KeyChange = True
         TimerInitialized = True
    End If

    'Move Icon - Not shift and Not Ctrl
    If Not ShiftDown And Not CTRLDown Then

        If ShiftDown <> PrevShiftDown Then
             PrevShiftDown = ShiftDown
             KeyChange = True
         End If

         If CTRLDown <> PrevCTRLDown Then
             PrevCTRLDown = CTRLDown
             KeyChange = True
         End If

        If KeyChange = True Then
            DragControl.DragIcon = ImageList1.ListImages(1).Picture
        End If

    'Copy Icon - shift and Not ctrl
    ElseIf ShiftDown And Not CTRLDown Then 'And ShiftDown Then

        If ShiftDown <> PrevShiftDown Then
            PrevShiftDown = ShiftDown
            KeyChange = True
        End If

        If CTRLDown <> PrevCTRLDown Then
            PrevCTRLDown = CTRLDown
            KeyChange = True
        End If

        If KeyChange = True Then
            DragControl.DragIcon = ImageList1.ListImages(2).Picture
        End If

    'No Drop Icon -
   Else 'If ShiftDown <> PrevShiftDown Or CTRLDown <> PrevCTRLDown Then

        PrevShiftDown = ShiftDown
        PrevCTRLDown = CTRLDown
        KeyChange = True

        DragControl.DragIcon = ImageList1.ListImages(3).Picture

   End If

    If KeyChange = True Then

         Call GetCursorPos(mousePT)

         x = mousePT.x
         y = mousePT.y

         DragControl.Drag vbBeginDrag

         SetCursorPos x, y

    End If

End Sub

Private Sub Text2_DragDrop(Source As Control, x As Single, y As Single)
    Text2.Text = Source.Name '   "Dropped"
End Sub



Quote:
> Thanks for the help Randy.

> My code cleaned up and working well enough for posting as example here.

> Barry G. Sumpter

> Module1.bas

> Public Type POINTAPI
>     x As Long
>     y As Long
> End Type
> Public mousePT As POINTAPI

> Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As
> Long
> Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal
y
> As Long) As Long
> Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
As
> Integer

> Public x As Long, y As Long

> Form1.frm  (code only)

>  Option Explicit

>  Dim ShiftDown As Boolean
>  Dim CTRLDown As Boolean

>  Dim LeftButtonDown As Boolean ' left mouse

>  Const VK_SHIFT = &H10 'SHIFT key
>  Const VK_CONTROL = &H11 'CTRL key
>  Const VK_LBUTTON = &H1 'Left Mouse Button

> Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, x As
> Single, y As Single)

>     Timer1.Enabled = True

> End Sub

> Private Sub Timer1_Timer()

>     Static PrevShiftDown As Boolean
>     Static PrevCTRLDown As Boolean

>     Dim KeyChange As Boolean

>     ShiftDown = GetKeyState(VK_SHIFT) And &H80
>     CTRLDown = GetKeyState(VK_CONTROL) And &H80
>     LeftButtonDown = GetKeyState(VK_LBUTTON) And &H80

>     If LeftButtonDown >= 0 Then
>         Timer1.Enabled = False
>         Exit Sub
>     End If

>     KeyChange = False

>     'Copy Icon - shift and ctrl
>     If CTRLDown And ShiftDown Then

>         If ShiftDown <> PrevShiftDown Then
>             PrevShiftDown = ShiftDown
>             KeyChange = True
>         End If

>         If CTRLDown <> PrevCTRLDown Then
>             PrevCTRLDown = CTRLDown
>             KeyChange = True
>         End If

>         If KeyChange = True Then
>             Text1.DragIcon = ImageList1.ListImages(2).Picture
>         End If

>     'Move Icon - shift only
>    ElseIf ShiftDown And Not CTRLDown Then

>         If ShiftDown <> PrevShiftDown Then
>              PrevShiftDown = ShiftDown
>              KeyChange = True
>          End If

>          If CTRLDown <> PrevCTRLDown Then
>              PrevCTRLDown = CTRLDown
>              KeyChange = True
>          End If

>         If KeyChange = True Then
>             Text1.DragIcon = ImageList1.ListImages(1).Picture
>         End If

>     'No Drop Icon -
>    ElseIf ShiftDown <> PrevShiftDown Or CTRLDown <> PrevCTRLDown Then

>         PrevShiftDown = ShiftDown
>         PrevCTRLDown = CTRLDown
>         KeyChange = True

>         Text1.DragIcon = ImageList1.ListImages(3).Picture

>    End If

>     If KeyChange = True Then

>          Call GetCursorPos(mousePT)

>          x = mousePT.x
>          y = mousePT.y

>          Text1.Drag vbBeginDrag

>          SetCursorPos x, y

>     End If

> End Sub

> Private Sub Text2_DragDrop(Source As Control, x As Single, y As Single)
>     Text2.Text = "Dropped"
> End Sub



Fri, 03 Jun 2005 20:19:28 GMT  
 Changing to a Copy or Move DragIcon while in Drag mode but NOT moving the mouse
Oops !  Don't waste your time on this !

Have a good look at
    OLEGiveFeedback

Jeez!  I feel absolutly horrible about wasting anyones time on this
makeshift code.

I'll post my findings in a Cupladays!

baz



Wed, 08 Jun 2005 17:41:42 GMT  
 
 [ 5 post ] 

 Relevant Pages 

1. move a mouse pointer to a different location without moving the mouse

2. Move resize drag controls in runtime using mouse...

3. To Move or not to Move

4. dragged outline stays-not moved to currentx or y

5. Mouseenter event fires only when the mouse is not moving

6. Mouse move event not trapped over Scroll bars of ListView Control

7. Moving a form with mouse on bgrn, not caption

8. Moving mouse in VB (instead of regular mouse)?

9. mouse move event detected with no mouse movement?!?

10. move shape between pages / Move-Event ?

11. Moving Pictures?!!!!!!!!! Need help to move a picture

12. Move one form - the other moves with it?

 

 
Powered by phpBB® Forum Software