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.

当我点击按钮时，显示消息。但是当我拖动它时，它也会显示＆＃34; Clicked＆＃34;消息。

请帮帮我:(

（抱歉我的英文）

Answer 1

首先我会使用enum for state，但无论如何，最好在这里使用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

2 个答案:

修改