拖动并单击 Delphi

Question

我在Delphi中制作了一个简单的表单，它包含一个按钮。

我想在单击按钮时打开一条消息。并且可以通过拖动来移动该按钮。

这是我的代码

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.

当我点击按钮时，显示消息。但是当我拖动它时，它也显示 "Clicked" 消息。

请帮帮我:(

（对不起我的英语）

Answer 1

首先我会为状态使用一个枚举，但无论如何，最好在这里使用 mouseup，就像这样（删除你的 Button1Click 过程）

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;

显然这只是示例代码，因此 ShowMessage 将被更合适的代码所取代。

（正如所说！）

编辑

您遇到的另一个问题是您设置拖动状态的时间过早。你应该在 mouseMove 上做，有点像这样

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;

Answer 2

我已将所需行为外包给一般服务人员。它可以用于 TControl.

的所有后代

代码基于 Delphi XE2.

首先 - 服务：

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.

其二-一个简单的例子：

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.

拖动并单击 Delphi

Drag and click on Delphi

delphi

pascal

编辑