2010-06-24 31 views
2

編輯: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. 
+1

爲什麼不使用控件/表單的OnDrag ...事件? – 2010-06-24 07:48:29

+0

在真實情況下,我想旋轉和翻譯3D空間的視角。這只是一個簡單的示例。 – benok 2010-06-25 01:49:09

回答

1

我用D2007試過了你的測試程序。一切工作如預期。當我釋放鼠標右鍵時,觸發FormMouseUpWMRButtonUp

你可以在另一臺機器上測試它嗎?我想你已經在Delphi中安裝了「壞」的東西,或者你的系統上有某種鉤子。但你的來源是正確的,應該工作。

+0

謝謝您的回覆,我會檢查其他一些環境。 – benok 2010-06-25 01:34:44

+0

在另一個環境中,一切都很完美。 我調查了麻煩的機器,發現了一個我忘記安裝的鼠標手勢util。 無論如何,非常感謝! – benok 2010-06-25 01:46:47

0

你的問題是,你需要直接檢測鼠標事件,沒有使用Delphi的解釋。