Do not show drag image immediately?

[aehimself 396]

Hello,

 

I have a pagecontrol descendant, where I overridden the DoDrag method to show the picture of the dragged tab:

Procedure TPageControl.DoStartDrag(Var DragObject: TDragObject);
Var
 tab: TRect;
 bmp, tabbmp: TBitMap;
Begin
 inherited;
 If DragObject <> nil Then Exit;

 // Create a bitmap of the tab button under cursor
 tab := Self.TabRect(Self.ActivePage.TabIndex);
 bmp := TBitmap.Create;
 bmp.Canvas.Lock;
 tabbmp := TBitmap.Create;
 Try
  bmp.Height := Self.Height;
  bmp.Width := Self.Width;
  tabbmp.Height := tab.Height;
  tabbmp.Width := tab.Width;
  Self.PaintTo(bmp.Canvas.Handle, 0, 0);
  tabbmp.Canvas.CopyRect(tabbmp.Canvas.ClipRect, bmp.Canvas, tab);
  DragObject := TPageControlExtraDragObject.Create(tabbmp);
 Finally
  bmp.Canvas.Unlock;
  FreeAndNil(tabbmp);
  FreeAndNil(bmp);
 End;
End;

When the user clicks on one of the tabs I'm manually initiating the dragging process by Self.BeginDrag(False);. When I went into BeginDrag, I saw that if you do not specify a dragging threshold, it takes this value from Mouse.DragThreshold, which is 5 pixels. This - to me - means that the dragging is NOT initiated unless the button is still down, and the cursor went at least 5 pixels away from the initiating position.

What happens now is that the DoStartDrag event fires immediately, the bitmap is taken and is drawn as a fly-out immediately. Even it I am just switching tabs, which is kind of annoying.

 

So the question is... if my logic is right (and the DoStartDrag should be fired based on distance) why it is firing immediately? If not, is there a simple setting I forgot to add or I manually have to handle this by MouseMove?

 

I'm using Delphi 10.4.1, but the "issue" was present in 10.4 and 10.3 as well.

[aehimself 396]

Manually handling it in OnMouseMove works perfectly.

[Anders Melander 1780]

On 9/16/2020 at 3:10 PM, aehimself said:

the DoStartDrag event fires immediately, the bitmap is taken and is drawn as a fly-out immediately.

First of all, I can confirm that this happens.

I'm responding to this old post because I just had to deal with this problem myself; Our product has had this bug for many years but it was low priority and none of the attempts to fix it had any success.

 

Anyway, when calling BeginDrag(False):

1. The drag isn't started until the mouse movement exceeds the configured threshold.
2. The drag image is displayed immediately.

#1 is as excepted and documented. #2 is a bug in the VCL and it's been there for decades.
The way one would normally use BeginDrag(False) is from within a OnMouseDown event handler. Since the drag image is shown immediately, before a drag is detected or not, it means that simply clicking on the drag source will display the drag image and then immediately hide it again. Clearly not the intention.

Like the VCL docking code, the dragdrop code is so convoluted that I imagine that the Embarcadero engineers would rather find a new job than try to fix it. Instead they changed the documentation so it's now unclear when the image is shown.

 

In the end the only way to solve this is to avoid BeginDrag(False) and implement the start-drag logic manually. This means:

• Capturing the mouse.
• Monitoring mouse messages for mouse-up and mouse-move and detect movement beyond the drag threshold.
• Monitoring keyboard messages for the [Esc] key.
• Start the drag, regardless of movement, if the mouse stays down for 500mS.

Luckily Windows provides us with a function that does all this for us: DragDetect
Unfortunately DragDetect has some side-effects (and a few bugs of its own). Notably it eats the mouse-up message (WM_LBUTTONUP et al.). For us this was a problem because it meant that the control that was clicked (if it was indeed a click and not a drag) didn't get to handle mouse-up. In our case the control was a DevExpress grid and without the mouse-up message it became impossible to get a cell into edit-mode by clicking on it with the mouse; Not acceptable.

 

So what to do? Well, I finally remembered that I had solved a similar problem, many, many years ago and, long story short, the solution is to use the DragDetectPlus function from the Drag and Drop Component Suite.

procedure TMyForm.SomeControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button <> mbLeft) then
    exit;

  // Various additional logic to determine if we should initiate a drag goes here...

  // Initiate a drag
  
  (* Doesn't work; Drag image is shown immediately
  SomeControl.BeginDrag(False);
  *)

  (* Doesn't work; DragDetect eats WM_LBUTTONUP
  if DragDetect(SomeControl.Handle, ClientToScreen(Point(X, Y))) then
    SomeControl.BeginDrag(True);
  *)
  
  // This works; DragDetectPlus doesn't eat WM_LBUTTONUP
  if DragDetectPlus(SomeControl.Handle, ClientToScreen(Point(X, Y))) then
    SomeControl.BeginDrag(True);
end;

With this solution the drag is only started, and the drag image is only shown, when and if the mouse is moved (or the time expires) - and the mouse-up event is left in the message queue.