Problem with combined Click and Drag

[bobbie100]

I am using a descendant of TGraphicControl as a display for a large number of objects presented on a form. I need to implement a simple capability for 2 different responses dependent on whether the user clicks or drags an object. I identify which object from the coordinates at the MouseDown event.

I am having difficulty implementing this system because the BeginDrag function generates a MouseUp event and then there are no more MouseUp events.

To overcome this I use the MouseMove event to detect when the mouse has moved more than the drag threshold (nominally set to 5) and then call BeginDrag(True) to immediately transition to Drag.

This works fine EXCEPT if the mouse is outside the form at the DragDrop, the drag process then seems to get completely stuck with no further mouse messages.

Below is a simple example using a TImage to illustrate the problem. Simply place a TImage on the form and set the Align property to alClient to fill the client area. The DragKind and DragMode should be left at the defaults of dkDrag and dmManual. The TImage event handlers for the DragDrop, DragOver, MouseDown, MouseMove and MouseUp events then need to be selected.

When you run this you should see the drag cursor change appropriately when you drag and drop within the TImage (anywhere in the client area of the form). However, if you try to drop outside the form, there will be no further drag or drop activity.

I would greatly appreciate any advice on how to overcome this behaviour or better ways to do it. I am using Delphi7 Enterprise running on XP.

unit Unit1;

interface

uses
  SysUtils, Forms, Classes, Types, Controls, ExtCtrls;

const
  DRAG_THRESHOLD = 5;
  DEFAULT_POS: TPoint = (X: -1; Y: -1);

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FDragging: Boolean;
    FLeftDown: Boolean;
    FLeftDownPos: TPoint;
  protected
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDragging := False;
  FLeftDown := False;
  FLeftDownPos := DEFAULT_POS;
end;

procedure TForm1.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Source is TImage then
  begin
    FDragging := False;             //End of dragging
    FLeftDownPos := DEFAULT_POS;    //Reset stored MouseDown position
    { Response to drag-drop goes here }
  end;
end;

procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source is TImage);
  FLeftDown := False;         //Left button no longer down for click
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FLeftDown := True;             //Left button is down for click
    FLeftDownPos := Point(X, Y);   //Store position at MouseDown
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FLeftDown and (not FDragging) then   //Only use until MouseUp or drag
    if (Abs(X - FLeftDownPos.X) > DRAG_THRESHOLD) or
       (Abs(Y - FLeftDownPos.Y) > DRAG_THRESHOLD) then
    begin                        //Mouse movement exceeds drag threshold
      FDragging := True;
      Image1.BeginDrag(True);    //Immediately start drag
    end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FLeftDown := False;         //Left button no longer down
    if not FDragging then       //Stops response to MouseUp at BeginDrag
    begin
      FLeftDownPos := DEFAULT_POS;     //Clear stored MouseDown position
      { Response to pseudo-click goes here }
    end;
  end;
end;

end.

 

[bobbie100]

Inspiration!!

Suddenly realised I was looking at this from the wrong direction. Instead of trying to have a click period followed by the drag, much easier to start the drag at MouseDown, but treat DragOver and DragDrop as though they are MouseMove and MouseUp until the mouse moves by more than the threshold distance. This greatly simplifies things.

The other problem is that I misunderstood the significance of the EndDrag event. I should have been using it to reset the GraphicControl and related data after an unsuccessful attempted drop. This is my first attempt at Drag & Drop, so I apologise if I've wasted anybody's time.

The program is now simpler and seems to work properly. What more could I ask for!!