B4J Question How? Correct crossplatform mouse object moving (dragging) by _Touch event

peacemaker

Expert
Licensed User
Longtime User
HI, All

Please, help to understand how to just make correct dragging the B4XView-object manually by a mouse.
The project is attached. It will be shared to any forummates when ready - it's the template of the vector objects editor.

How to make smooth dragging along the cursor ? And without going out the parent (screen).
Now coordinates during the dragging is sometimes changed back.
 

Attachments

Last edited:
Solution
And now with grid and boundaries:
Code: Copy
#if B4A
Private Sub mRoot_Touch (o As Object, ACTION As Int, x As Float, y As Float, motion As Object) As Boolean
#else
Private Sub mRoot_Touch (Action As Int, X As Float, Y As Float)
#end if
    If Action = mRoot.TOUCH_ACTION_DOWN Then
        Dragging = True
        DownX = X
        DownY = Y
    Else If Action = mRoot.TOUCH_ACTION_UP Then
        Dragging = False
    Else If Dragging And Action = mRoot.TOUCH_ACTION_MOVE Then
        mRoot.Left = Max(0, Min(mRoot.Parent.Width - mRoot.Width, ApplyGrid(mRoot.Left + X - DownX)))
        mRoot.Top = Max(0, Min(mRoot.Parent.Height - mRoot.Height, ApplyGrid(mRoot.Top + Y - DownY)))
    End If
    #if B4A
    Return True
    #end if
End Sub

Private Sub...
There are several libraries in the forum that handle dragging.

You will get smooth movement with this code:
Code: Copy
Private Sub mRoot_Touch (Action As Int, X As Float, Y As Float)
    If Action = mRoot.TOUCH_ACTION_DOWN Then
        Dragging = True
        DownX = X
        DownY = Y
    Else If Action = mRoot.TOUCH_ACTION_UP Then
        Dragging = False
    Else If Dragging And Action = mRoot.TOUCH_ACTION_MOVE Then
        'If mRoot.Left + mRoot.Width <= mParent.Width Then
        mRoot.Left = mRoot.Left + X - DownX
        mRoot.Top = mRoot.Top + Y - DownY
    End If
End Sub
 
Upvote 0
Thanks, Erel. But this code works only in B4J smoothly.
In B4A - it's strange circled dragging.
 
Upvote 0
Hmm, so _Touch event is not cross-platform ? But it works, in whole...

I see that Android sub signature is different
B4X: Copy
Private Sub Panel1_Touch (o As Object, ACTION As Int, x As Float, y As Float, motion As Object) As Boolean

Or what the trouble here to make similar crossplatform working ?
 
Upvote 0
Code: Copy
    #if B4A
    Dim r As Reflector
    r.Target = mRoot
    r.SetOnTouchListener("mRoot_Touch")
    #end if
End Sub


#if B4A
Private Sub mRoot_Touch (o As Object, ACTION As Int, x As Float, y As Float, motion As Object) As Boolean
#else
Private Sub mRoot_Touch (Action As Int, X As Float, Y As Float)
#end if
    If Action = mRoot.TOUCH_ACTION_DOWN Then
        Dragging = True
        DownX = X
        DownY = Y
    Else If Action = mRoot.TOUCH_ACTION_UP Then
        Dragging = False
    Else If Dragging And Action = mRoot.TOUCH_ACTION_MOVE Then
        'If mRoot.Left + mRoot.Width <= mParent.Width Then
        mRoot.Left = mRoot.Left + X - DownX
        mRoot.Top = mRoot.Top + Y - DownY
    End If
    #if B4A
    Return True
    #end if
End Sub
 
Upvote 0
And now with grid and boundaries:
Code: Copy
#if B4A
Private Sub mRoot_Touch (o As Object, ACTION As Int, x As Float, y As Float, motion As Object) As Boolean
#else
Private Sub mRoot_Touch (Action As Int, X As Float, Y As Float)
#end if
    If Action = mRoot.TOUCH_ACTION_DOWN Then
        Dragging = True
        DownX = X
        DownY = Y
    Else If Action = mRoot.TOUCH_ACTION_UP Then
        Dragging = False
    Else If Dragging And Action = mRoot.TOUCH_ACTION_MOVE Then
        mRoot.Left = Max(0, Min(mRoot.Parent.Width - mRoot.Width, ApplyGrid(mRoot.Left + X - DownX)))
        mRoot.Top = Max(0, Min(mRoot.Parent.Height - mRoot.Height, ApplyGrid(mRoot.Top + Y - DownY)))
    End If
    #if B4A
    Return True
    #end if
End Sub

Private Sub ApplyGrid (x As Int) As Int
    If GridSize > 0 Then
        Return x - (x Mod GridSize)
    End If
    Return x
End Sub

Private GridSize As Int = 10dip
 
Upvote 0
Solution
So, draggin is solved.

p.s. but in B4A, it seems, mRoot_Click and mRoot_LongClick are broken now, solving
 

Attachments

  • TempDownload.png
    TempDownload.png
    207.6 KB · Views: 577
Last edited:
  • Like
Reactions: byz
Upvote 0
The final (for dragging, clicks) project v.0.13 is attached.


B4X: Copy
Sub Class_Globals
...
    Private DownX, DownY As Double, Dragging As Boolean, DraggingStart As Long
    Private GridSize As Int = 5dip
End Sub

#if B4A
Private Sub mRoot_Touch (o As Object, ACTION As Int, x As Float, y As Float, motion As Object) As Boolean
#else
Private Sub mRoot_Touch (Action As Int, X As Float, Y As Float)
#end if
    If Action = mRoot.TOUCH_ACTION_DOWN Then
        Dragging = True
        DraggingStart = DateTime.Now
        DownX = X
        DownY = Y
    Else If Action = mRoot.TOUCH_ACTION_UP Then
        Dragging = False
        #if B4A
            If (DateTime.Now - DraggingStart) > 500 Then
                mRoot_LongClick
            Else
                mRoot_Click
            End If
        #end if
    Else If Dragging And Action = mRoot.TOUCH_ACTION_MOVE Then
        mRoot.Left = Max(0, Min(mRoot.Parent.Width - mRoot.Width, ApplyGrid(mRoot.Left + X - DownX)))
        mRoot.Top = Max(0, Min(mRoot.Parent.Height - mRoot.Height, ApplyGrid(mRoot.Top + Y - DownY)))
    End If
    #if B4A
    Return True
    #end if
End Sub

Private Sub ApplyGrid (x As Int) As Int
    If GridSize > 0 Then
        Return x - (x Mod GridSize)
    End If
    Return x
End Sub
 

Attachments

Upvote 0
Back
Top