編輯:VCL沒有問題左右拖動和下面的示例程序完美。鼠標手勢實用程序導致該問題。 (也許它掛鉤&攔截WM_RBUTTONUP事件...)如何檢測TControl的右拖動結束?
我想檢測端上的控制權,拖着。
對於左側拖動,我可以使用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.
爲什麼不使用控件/表單的OnDrag ...事件? – 2010-06-24 07:48:29
在真實情況下,我想旋轉和翻譯3D空間的視角。這只是一個簡單的示例。 – benok 2010-06-25 01:49:09