如何检测TControl的右拖动结束?
编辑:VCL 在右键拖动方面没有问题,下面的示例程序运行完美。鼠标手势实用程序会导致该问题。 (也许它挂钩并拦截 WM_RBUTTONUP 事件...)
我想检测控件上右键拖动的结束。
对于左拖动,我可以使用 MouseUp 事件,但右拖动后不会发生。
在下面的测试程序上(在表格右侧放置一个备忘录并拖动表格), 我想在右键拖动后重置鼠标光标。
我怎样才能做到这一点? (WM_RBUTTONUP 没有出现。)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ShiftStateToStr(Shift: TShiftState): string;
begin
if ssShift in Shift then
Result := Result + 'S-';
if ssCtrl in Shift then
Result := Result + 'C-';
if ssAlt in Shift then
Result := Result + 'A-';
if ssDouble in Shift then
Result := Result + 'D-';
if ssLeft in Shift then
Result := Result + 'L';
if ssRight in Shift then
Result := Result + 'R';
if ssMiddle in Shift then
Result := Result + 'M';
end;
function MouseButtonToStr(Btn: TMouseButton): string;
begin
if Btn = mbLeft then
Result := 'Left'
else if Btn = mbRight then
Result := 'Right'
else if Btn = mbMiddle then
Result := 'Middle';
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
begin
SetCapture(Handle);
Memo1.Lines.Add(Format('Down(Btn=%s, Shift=[%s])', [MouseButtonToStr(Button), ShiftStateToStr(Shift)]));
if Button = mbLeft then
Screen.Cursor := crDrag
else if Button = mbRight then
Screen.Cursor := crSize;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
Memo1.Lines.Add(Format('Move(Shift=[%s])', [ShiftStateToStr(Shift)]));
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Memo1.Lines.Add(Format('Up(Btn=%s, Shift=[%s])', [MouseButtonToStr(Button), ShiftStateToStr(Shift)]));
Screen.Cursor := crDefault;
end;
procedure TForm1.WMRButtonUp(var Message: TWMRButtonUp);
begin
Memo1.Lines.Add('WMRbuttonUp');
inherited;
end;
end.
edit: VCL has no problem around right dragging and the sample program below works perfect. A mouse gesture utility causes the problem. (Perhaps it hooks & intercept WM_RBUTTONUP event...)
I want to detect end of right-dragging on the control.
For left-dragging, I can use MouseUp event, but it doesn't occur after right dragging.
On the test program below(put a memo on the right side of the form and drag form),
I want to reset mouse cursor after right dragging.
How can I achieve this ? (WM_RBUTTONUP doesn't come.)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ShiftStateToStr(Shift: TShiftState): string;
begin
if ssShift in Shift then
Result := Result + 'S-';
if ssCtrl in Shift then
Result := Result + 'C-';
if ssAlt in Shift then
Result := Result + 'A-';
if ssDouble in Shift then
Result := Result + 'D-';
if ssLeft in Shift then
Result := Result + 'L';
if ssRight in Shift then
Result := Result + 'R';
if ssMiddle in Shift then
Result := Result + 'M';
end;
function MouseButtonToStr(Btn: TMouseButton): string;
begin
if Btn = mbLeft then
Result := 'Left'
else if Btn = mbRight then
Result := 'Right'
else if Btn = mbMiddle then
Result := 'Middle';
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
begin
SetCapture(Handle);
Memo1.Lines.Add(Format('Down(Btn=%s, Shift=[%s])', [MouseButtonToStr(Button), ShiftStateToStr(Shift)]));
if Button = mbLeft then
Screen.Cursor := crDrag
else if Button = mbRight then
Screen.Cursor := crSize;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
Memo1.Lines.Add(Format('Move(Shift=[%s])', [ShiftStateToStr(Shift)]));
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Memo1.Lines.Add(Format('Up(Btn=%s, Shift=[%s])', [MouseButtonToStr(Button), ShiftStateToStr(Shift)]));
Screen.Cursor := crDefault;
end;
procedure TForm1.WMRButtonUp(var Message: TWMRButtonUp);
begin
Memo1.Lines.Add('WMRbuttonUp');
inherited;
end;
end.
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
我用 D2007 尝试了你的测试程序。一切都按预期进行。当我释放鼠标右键时,
FormMouseUp
和WMRButtonUp
被触发。可以在另一台机器上测试一下吗?我猜你在 Delphi 中安装了一些“坏”的东西,或者你的系统上有某种钩子。但你的来源是正确的并且应该有效。
I tried your test program with D2007. Everything works like expected. The
FormMouseUp
andWMRButtonUp
get triggerd when i release the right mouse button.Can you test it on another machine? I guess you have installed something "bad" in Delphi or you have some kind of hook on your system. But your source is correct and should work.
你的问题是你需要直接检测鼠标事件,而不是使用Delphi的解释。
Your problem is that you need to detect mouse events directly, not using Delphi's interpretation.