Fix propagation of drag and drop events by the highlighting frame.

[GB.GUI.BASE]
* BUG: Fix propagation of drag and drop events by the highlighting frame.
This commit is contained in:
gambas 2021-10-22 22:44:29 +02:00
parent da50778ffa
commit c70de03c09

View file

@ -293,6 +293,7 @@ Static Public Sub DndFrame_DragMove()
Dim hCtrl As Control Dim hCtrl As Control
Dim X As Integer Dim X As Integer
Dim Y As Integer Dim Y As Integer
Dim bStopEvent As Boolean
'Debug 'Debug
@ -306,9 +307,7 @@ Static Public Sub DndFrame_DragMove()
While hCtrl Is Container While hCtrl Is Container
hCont = hCtrl hCont = hCtrl
'$aFrame[0].Hide
'hCtrl = hCont.FindChild(Drag.X - hCont.ClientX, Drag.Y - hCont.ClientY)
'$aFrame[0].Show
hCtrl = FindChild(hCont, Drag.X - hCont.ClientX, Drag.Y - hCont.ClientY) hCtrl = FindChild(hCont, Drag.X - hCont.ClientX, Drag.Y - hCont.ClientY)
If Not hCtrl Then If Not hCtrl Then
@ -319,7 +318,8 @@ Static Public Sub DndFrame_DragMove()
Drag.X -= hCtrl.X + hCont.ClientX Drag.X -= hCtrl.X + hCont.ClientX
Drag.Y -= hCtrl.Y + hCont.ClientY Drag.Y -= hCtrl.Y + hCont.ClientY
If hCtrl.Drop Then If hCtrl.Drop Then
Object.Raise(hCtrl, "Drag") bStopEvent = Object.Raise(hCtrl, "Drag")
If bStopEvent Then Break
Else Else
If hCtrl Is Container Then Continue If hCtrl Is Container Then Continue
Drag.X += hCtrl.X + hCont.ClientX Drag.X += hCtrl.X + hCont.ClientX
@ -330,17 +330,24 @@ Static Public Sub DndFrame_DragMove()
Break Break
Wend Wend
Object.Raise(hCtrl, "DragMove") If Not bStopEvent Then
While hCtrl <> $hFrameCtrl
If hCtrl.Drop Then Break
hCtrl = hCtrl.Parent
Wend
bStopEvent = Object.Raise(hCtrl, "DragMove")
Endif
Drag.X = X Drag.X = X
Drag.Y = Y Drag.Y = Y
If bStopEvent Then Stop Event
End End
Static Public Sub DndFrame_Drop() Static Public Sub DndFrame_Drop()
'Debug
Drag.X += $iFrameX Drag.X += $iFrameX
Drag.Y += $iFrameY Drag.Y += $iFrameY
Drag._Target = $hFrameCtrl Drag._Target = $hFrameCtrl