如何检测TControl的右拖动结束?

发布于 2024-09-06 16:33:14 字数 2587 浏览 2 评论 0原文

编辑: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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

旧故 2024-09-13 16:33:14

我用 D2007 尝试了你的测试程序。一切都按预期进行。当我释放鼠标右键时,FormMouseUpWMRButtonUp 被触发。

可以在另一台机器上测试一下吗?我猜你在 Delphi 中安装了一些“坏”的东西,或者你的系统上有某种钩子。但你的来源是正确的并且应该有效。

I tried your test program with D2007. Everything works like expected. The FormMouseUp and WMRButtonUp 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.

独行侠 2024-09-13 16:33:14

你的问题是你需要直接检测鼠标事件,而不是使用Delphi的解释。

Your problem is that you need to detect mouse events directly, not using Delphi's interpretation.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文