TTKMouseGestures というコンポーネントがあります。
Delphi6Proで作ってみました
最終的にWMRUを拾ってMZ配列を読んで処理すればよいでしょう
type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure AppMessage(var Msg:TMsg;var Handled:boolean); procedure WMRD; procedure WMRU; procedure WMM; end; var Form1: TForm1; EX,EY,EZ,LST,MM:Integer; //マウスジェスチャー用変数 MZ: Array [0..8] of Integer; //ジェスチャー保存用 const MARG=8; //マウス感度 implementation {$R *.dfm} function wsprintf2(Output:PChar;Format:PChar):Integer; cdecl;varargs;external user32 name 'wsprintfA'; //マウス移動 procedure TForm1.WMM; var t1,t2,X,Y:Integer; MousePos :TPoint; str: string; begin //マウスの座標取得 GetCursorPos(MousePos ); X:=MousePos.x; Y:=MousePos.y; //マウスの移動絶対値 t1:=abs(X-EX); t2:=abs(Y-EY); SetLength(str,1024); wsprintf2(PChar(str),'Mouse test %d %d[%d %d]',X,Y,EX,EY); Caption:=str; //マウスの移動量が一定量か確認 if (EZ>0) and ( (t1>MARG) or (t2>MARG) ) and (abs(t1-t2)>MARG) then begin if t1>t2 then begin if (X<EX) and (LST<>1) then begin LST:=1; if MM<8 then MZ[MM]:=LST; Inc(MM); end else if (X>EX) and (LST<>2) then begin LST:=2; if MM<8 then MZ[MM]:=LST; Inc(MM); end; end else begin if (Y<EY) and (LST<>3) then begin LST:=3; if MM<8 then MZ[MM]:=LST; Inc(MM); end else if (Y>EY) and (LST<>4) then begin LST:=4; if MM<8 then MZ[MM]:=LST; Inc(MM); end; end; EX:=X; EY:=Y; end; end; //右クリック押下 procedure TForm1.WMRD; var MousePos:TPoint; begin GetCursorPos(MousePos); EX:=MousePos.x; EY:=MousePos.y; EZ:=1; MM:=0; LST:=0; end; //右クリック離 procedure TForm1.WMRU; var i: Integer; begin Memo1.Clear(); if EZ>0 then begin EZ:=0; //ジェスチャーの検出 if MM>0 then begin Memo1.Lines.Add('マウスジェスチャー検出'); for i:=0 to MM-1 do begin if MZ[i]=1 then Memo1.Lines.Add('LEFT[←]'); if MZ[i]=2 then Memo1.Lines.Add('RIGHT[→]'); if MZ[i]=3 then Memo1.Lines.Add('UP[↑]'); if MZ[i]=4 then Memo1.Lines.Add('DOWN[↓]'); end; end; end; end; procedure TForm1.AppMessage(var Msg:TMsg;var Handled:boolean); begin //フォームとMemo1上のみ検出 if (Msg.hwnd=Form1.Handle) or (Msg.hwnd=Memo1.Handle) then begin if Msg.message=WM_MOUSEMOVE then WMM() else if Msg.message=WM_RBUTTONUP then WMRU() else if Msg.message=WM_RBUTTONDOWN then WMRD() end; end;
procedure TForm1.FormCreate(Sender: TObject); begin //ハンドラの設定 Application.OnMessage:=AppMessage; end; end.
OnMessageでマウスの移動と右クリックを拾い、
Windowハンドルから、どのコンポーネントからのメッセージか判断した上で、処理することで実現できました
http://nifberry.727.net/test/hatena194.lzh
こちらのソースはホイールによるジェスチャ-にも対応させてみましたので参考にどうぞ
ありがとうございます!
わざわざ私への回答のためにここまでしていただいたことに、感激しております!
さっそくこれから試してみます。