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
こちらのソースはホイールによるジェスチャ-にも対応させてみましたので参考にどうぞ
ありがとうございます!
わざわざ私への回答のためにここまでしていただいたことに、感激しております!
さっそくこれから試してみます。