我在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"消息。
请帮帮我:(
(抱歉我的英文)
答案 0 :(得分:4)
首先我会使用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;
答案 1 :(得分: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.