Drag and click on Delphi

Question

I made a simple form in Delphi, it contain a button.

I want to when I click on button, a message was opened. And that button can be move by drag on it.

This is my code

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  xx,yy:integer;
  state:integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
    showmessage('Clicked');
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    state:=1;
    xx:=x;
    yy:=y;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    case state of
        1:
            begin
                button1.Left:=button1.Left+x-xx;
                button1.Top:=button1.Top+y-yy;
            end;
    end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    state:=0;
end;

end.

When I click on button, message showed. But when I drag it, it also show "Clicked" message.

Please help me :(

(Sorry about my English)

Answer 1

I have outsourced the desired behavior to a general service. It can be used for all descendants of TControl.

The Code is based on Delphi XE2.

First - The Service:

unit VCLServices;

interface

uses
  Winapi.Windows, System.Classes, Vcl.Controls;

type

  IDragClickService = interface(IInterface)
    procedure attachClick(Event: TNotifyEvent);
    procedure attachDragStart(Event: TStartDragEvent);
    procedure attachDragOver(Event: TDragOverEvent);
    procedure attachDragDrop(Event: TDragDropEvent);
  end;

  TDragClickService = class(TInterfacedObject, IDragClickService)
  type
    TMyControl = class(TControl); // get access to TControl's protected-visibility
  strict private
    FOwner : TControl;
    FDragging : boolean;
    FLeftMouseDown : boolean;
    FLeftMouseDownPos : TPoint;
    FOnClickCallBack : TNotifyEvent;
  strict private
    procedure onMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure onMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure resetMouseContext();
  public
    constructor Create(AOwner : TControl);
    // IDragClickService
    procedure attachClick(Event: TNotifyEvent);
    procedure attachDragStart(Event: TStartDragEvent);
    procedure attachDragOver(Event: TDragOverEvent);
    procedure attachDragDrop(Event: TDragDropEvent);
  end;

implementation

{ TDragClickService }

constructor TDragClickService.Create(AOwner : TControl);
begin
  inherited Create();
  self.FOwner := AOwner;
  resetMouseContext();

  // Register Events
  TMyControl(self.FOwner).OnMouseDown := onMouseDown;
  TMyControl(self.FOwner).onMouseMove := onMouseMove;
  TMyControl(self.FOwner).onMouseUp := onMouseUp;
end;

// -------------------------------
// Callbacks
// -------------------------------
procedure TDragClickService.attachClick(Event: TNotifyEvent);
begin
  self.FOnClickCallBack := Event;
end;

procedure TDragClickService.attachDragDrop(Event: TDragDropEvent);
begin
  TMyControl(self.FOwner).OnDragDrop := Event;
end;

procedure TDragClickService.attachDragOver(Event: TDragOverEvent);
begin
  TMyControl(self.FOwner).OnDragOver := Event;
end;

procedure TDragClickService.attachDragStart(Event: TStartDragEvent);
begin
  TMyControl(self.FOwner).OnStartDrag := Event;
end;

// -------------------------------
// Events
// -------------------------------
procedure TDragClickService.onMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  self.FLeftMouseDown := (Button = mbLeft);
  self.FLeftMouseDownPos := Point(X, Y);
end;

procedure TDragClickService.onMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
  DRAG_THRESHOLD = 50;
begin

  if not self.FLeftMouseDown then begin
    exit;
  end;

  // The mouse may have been moved while the user clicked (to fast?)...
  if (Abs(X - self.FLeftMouseDownPos.X) > DRAG_THRESHOLD) or
     (Abs(Y - self.FLeftMouseDownPos.Y) > DRAG_THRESHOLD) then begin

    self.FDragging := true;
    self.FOwner.BeginDrag(true);
  end;
end;

procedure TDragClickService.onMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if self.FLeftMouseDown AND (not self.FDragging) AND Assigned(self.FOnClickCallBack) then begin
    self.FOnClickCallBack(sender);
  end;

  resetMouseContext();
end;

procedure TDragClickService.resetMouseContext;
begin
  self.FDragging := false;
  self.FLeftMouseDown := false;
  self.FLeftMouseDownPos := Point(-1, -1);
end;

end.

Second - An simple example:

unit MainForm;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,
  Vcl.StdCtrls, Vcl.Imaging.jpeg,
  VCLServices;

type
  TFormDragDrop = class(TForm)
    Image: TImage;
    EventConsole: TMemo;
    procedure FormCreate(Sender: TObject);
  strict private
    Service : IDragClickService;
  strict private
    procedure logToEventConsole(text: String);

    procedure onClick(Sender: TObject);
    procedure onDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure onDragOver(Sender, Source: TObject; X, Y: Integer; State:
        TDragState; var Accept: Boolean);
    procedure onStartDrag(Sender: TObject; var DragObject: TDragObject);
  end;

implementation

{$R *.dfm}

procedure TFormDragDrop.FormCreate(Sender: TObject);
begin
  self.Service := TDragClickService.Create(self.Image);
  self.Service.attachClick(onClick);
  self.Service.attachDragStart(onStartDrag);
  self.Service.attachDragOver(onDragOver);
  self.Service.attachDragDrop(onDragDrop);
end;

// -------------------------------
// Events/Callbacks
// -------------------------------

procedure TFormDragDrop.onClick(Sender: TObject);
begin
  logToEventConsole('Click');
end;

procedure TFormDragDrop.onDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  logToEventConsole('Drag Drop');
end;

procedure TFormDragDrop.onDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  logToEventConsole('Drag Over');
end;

procedure TFormDragDrop.onStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  logToEventConsole('Start Drag');
end;

procedure TFormDragDrop.logToEventConsole(text: String);
begin
  self.EventConsole.Lines.Add(Format('%s: %s', [FormatDateTime('ss:zzz', Now()), text]));
end;

end.

Answer 2

Firstly I would use an enum for state, but anyway, it is better to use mouseup here, like this (Remove your Button1Click procedure)

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if State = '' then // not dragging, so
    begin
       ShowMessage('Clicked');
    end
    else
      State:='';

end;

Obviously this is just sample code so ShowMessage would be replaced by something more appropriate.

(as would state!)

Edit

The other problem that you have is that you are setting drag state too early. You should do it on mouseMove, so a bit like this

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    state:=1;
    xx:=x;
    yy:=y;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    case state of
        1, 2:
            begin
                State := 2;
                button1.Left:=button1.Left+x-xx;
                button1.Top:=button1.Top+y-yy;
            end;
    end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if State <> 2 then // have dragged
    begin
       ShowMessage('Clicked');
    end;

    state:=0;
end;