Fatal编程技术网
  • delphi/
  • 拖动并单击Delphi

拖动并单击Delphi

delphi pascal

拖动并单击Delphi,delphi,pascal,Delphi,Pascal,我在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;

我在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.
当我点击按钮时，信息显示出来。但当我拖动它时，它也会显示“单击”消息

请帮助我：(

（对不起我的英语）

首先我会使用枚举作为状态，但无论如何，最好在这里使用鼠标，就像这样（删除按钮1单击过程）

显然，这只是示例代码，所以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;

程序t用于m1.按钮1鼠标向下（发送者：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
状态：=1；
xx:=x；
yy:=y；
结束；
步骤t用于m1.按钮1鼠标移动（发送器：ToObject；Shift:tShift状态；X，
Y：整数）；
开始
案件状态
1, 2:
开始
状态：=2；
按钮1.左：=按钮1.左+x-xx；
按钮1.Top:=按钮1.Top+y-yy；
结束；
结束；
结束；
程序t用于m1.按钮1鼠标（发送器：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
如果状态2，则//已拖动
开始
ShowMessage（'Clicked'）；
结束；
状态：=0；
结束；
首先，我将使用枚举作为状态，但无论如何，最好在此处使用鼠标，如下所示（删除按钮1单击过程）

显然，这只是示例代码，所以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;

程序t用于m1.按钮1鼠标向下（发送者：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
状态：=1；
xx:=x；
yy:=y；
结束；
步骤t用于m1.按钮1鼠标移动（发送器：ToObject；Shift:tShift状态；X，
Y：整数）；
开始
案件状态
1, 2:
开始
状态：=2；
按钮1.左：=按钮1.左+x-xx；
按钮1.Top:=按钮1.Top+y-yy；
结束；
结束；
结束；
程序t用于m1.按钮1鼠标（发送器：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
如果状态2，则//已拖动
开始
ShowMessage（'Clicked'）；
结束；
状态：=0；
结束；
我已将所需的行为外包给一般服务。它可用于
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.
Second-一个简单的例子：

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.
我已将所需的行为外包给一般服务。它可用于
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.
Second-一个简单的例子：

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.
这不是你的真实代码。你为什么要显示不可编译的假代码？我不想显示所有代码，我想知道它是如何工作的，并将其应用到我的程序中。好的，那么我将投我的一票。你想让我们帮你，但你不准备显示代码。我们不想看到你的所有代码。只是一个。然后我们可以帮助你。对不起，我会的这不是我的问题。我保证我编译了这段代码。将来，你应该学会如何准备一段代码，而不是发布假代码。这不是你的真实代码。你为什么要显示不可编译的假代码？我不想显示所有代码，我想知道它是如何工作的，并将其应用到我的程序中。好吧，那我就投我一票。你想让我们帮忙吗p但你不准备显示代码。我们不想看到你的所有代码。只需a。然后我们可以帮助。抱歉，我将编辑我的问题。我保证我编译了此代码。将来，你应该学习如何准备a，而不是发布假代码。这不起作用。我的按钮可以移动，但当我单击它时，消息没有显示。请参阅我的编辑。第您遇到的第二个问题是，您说的是MouseDown=drag，而在现实中，MouseDown可能是Click的一部分，而真正执行拖动的是MouseMove。抱歉-对编辑进行了一些小的更正。请重试。这不起作用。我的按钮可以移动，但当我单击它时，消息没有显示。请参阅我的编辑。第二个问题是你刚才说的是MouseDown=drag，而在现实中，MouseDown可能是Click的一部分，而真正执行拖动的是MouseMove。抱歉-对编辑做了一些小更正。请重试。