Delphi 6 ローテクTips/マウスジェスチャーの実装

マウスジェスチャーを自分のプログラムに組み込みたいと思いました。
右マウスボタンを押しながらの上下左右の四アクションのみの簡易なものですが、それでも使い勝手はかなり良くなると思います。

参考サイト

三角関数

「J」の字を描いたり上に移動してから左右に振ったりなどといった複雑な動きは難しいのでパス。
単純に上下左右の四方向の動きのみの対応とするならば、右マウスボタンを押した点とボタンを離した点の角度を調べれば良いので簡単にできそうです。
ということで三角関数を勉強せねばならんのかと思いつつ、調べてみたらなんのことはない。
タンジェントの逆関数一つでOKなことが分かりました。

なのだそうです。
で、Delphiはタンジェントの逆関数はArcTanというのがSystemユニットにあるのでそれでもうOKということになります。

function gfniAngleGet(ptStart, ptPos: TPoint): Integer;
//ptStartを原点としてptPosがどの方向（角度）にあるかを返す。
const
lci_NOMOVE = 3; //マウスジェスチャーとして認識しない範囲
var
li_X, li_Y: Integer;
begin
li_X := ptPos.X - ptStart.X;
li_Y := ptStart.Y - ptPos.Y; //数学の座標とはY軸が逆なので反対にしている

//ダブルクリックの範囲のlci_NOMOVE倍内であれば動いていないとみなす
if (Abs(li_X) <= (GetSystemMetrics(SM_CXDOUBLECLK) * lci_NOMOVE)) then li_X := 0;
if (Abs(li_Y) <= (GetSystemMetrics(SM_CYDOUBLECLK) * lci_NOMOVE)) then li_Y := 0;

if (li_X = 0) then begin
if (li_Y = 0) then begin
Result := -1;
end else if (li_Y > 0) then begin
Result := 90;
end else begin
Result := 270;
end;
end else if (li_Y = 0) then begin
if (li_X > 0) then begin
Result := 0;
end else begin
Result := 180;
end;
end else begin
Result := Trunc(ArcTan(li_Y / li_X) * (360 / (2 * Pi))); //ArcTanはラジアン単位なので度に直す
if (li_X > 0) and (li_Y > 0) then begin
//第一象限
//そのまま
end else if (li_X < 0) and (li_Y > 0) then begin
//第二象限
Inc(Result, 180); //第四象限と同じ値が出るのでプラス180度
end else if (li_X < 0) and (li_Y < 0) then begin
//第三象限
Inc(Result, 180); //第一象限と同じ値が出るのでプラス180度
end else {if (li_X < 0) and (li_Y > 0) then }begin
//第四象限
Inc(Result, 360); //マイナスの角度が出るのでぐるっと360度足しこむ
end;
end;
end;

このままではマウスジェスチャー用としては使いづらいので、単純に上下左右を返すラッパー関数を書きます。

function gfnsCompasGet(ptStart, ptPos: TPoint): WideString;
//上下左右を返す
var
li_Angle: Integer;
begin
li_Angle := gfniAngleGet(ptStart, ptPos);
case li_Angle of
   -1:    Result := '';
0.. 45: Result := '右';
   46..135: Result := '上';
136..225: Result := '左';
226..315: Result := '下';
316..359: Result := '右';
else    Result := ''; //保険
end;
end;

使い方

フォームのprivate部に右マウスボタンを押したときのマウスカーソルの位置を記憶させておくTPoint型の変数をF_ptMouseGestureとして宣言しておきます。

private
{ Private 宣言 }
F_ptMouseGesture: TPoint;
public
{ Public 宣言 }
end;

F_ptMouseGestureにはMouseDownイベントの引数で与えられるX, Yの値ではなくスクリーン座標の値を別に取得してセットしておきます。
わざわざスクリーン座標でのマウスカーソル位置の値を取得するのは、MouseDownイベントの引数で与えられるX, Yはコントロールのクライアント座標なので複数のコントロールをまたがった場合にやっかいなのとポップアップメニューのPopupメソッドの引数はスクリーン座標で指定するためです。

procedure TForm1.Form1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbRight) then begin
//マウスジェスチャーの開始
//スクリーン座標でカーソル位置を取得しておく
GetCursorPos(F_ptMouseGesture);
end;
end;

procedure TForm1.Form1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
lpt_Pos: TPoint;
ls_Compas: WideString;
begin
if (Button = mbRight) then begin
//ボタンを離したときのカーソル位置を取得
GetCursorPos(lpt_Pos);
//ボタンを押したときと離したときの位置情報を比較して動かした方向を取得
ls_Compas := gfnsCompasGet(F_ptMouseGesture, lpt_Pos);
if (ls_Compas = '') then begin
//ポップアップメニュー
PopupMenu1.Popup(lpt_Pos.X, lpt_Pos.Y);
end else if (ls_Compas = '上') then begin
//上へ動かしたときの処理
end else if (ls_Compas = '下') then begin
//下へ動かしたときの処理
end else if (ls_Compas = '左') then begin
//左へ動かしたときの処理
end else if (ls_Compas = '右') then begin
//右へ動かしたときの処理
end;
end;
end;

上の例ではマウスダウンして動かさずにマウスアップしたとき（戻り値は空文字）はポップアップメニューを表示するようにしています。
またForm1のPopupMenuプロパティには何も指定しません。
もしForm1のPopupMenuプロパティにPopupMenu1が指定されていて、そのAutoPopupプロパティがTrueになっていると右ボタンを押しながら上下左右に動かしたあとマウスアップした場合にPopupMenu1がポップアップしてしまいます。

フォームの中でマウスボタンを押し、そのままフォームの外にマウスを持っていってボタンを離した場合OnMouseUpイベントは起きません。
通常はそれでも問題ないと思うのですが、フォームが小さい場合などフォームの外でもマウスアップイベントが起きて欲しいこともあります。
その場合マウスボタンを押したままある程度の時間が経ったらキャンセル扱いにできるよう、マウスダウンに入った時間を保存しておくのが良いでしょう。

type
T_MouseInfo = record
Time: DWORD;
case Integer of
1:(X, Y: Integer);
2:(Pos: TPoint);
end;

private
{ Private 宣言 }
F_rMouseGesture: T_MouseInfo;
public
{ Public 宣言 }
end;

const
lciMOUSEEVENTLIMIT = 2000; //マウスジェスチャーと認識するタイムリミット。

procedure TForm1.Form1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbRight) then begin
//マウスジェスチャーの開始
//スクリーン座標でカーソル位置を取得しておく
GetCursorPos(F_rMouseGesture.Pos);
F_rMouseGesture.Time := GetTickCount;
//フォーム外でマウスボタンを離してもマウスアップイベントが起きるように
SetCaptureControl(Self);
end;
end;

procedure TForm1.Form1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
lpt_Pos: TPoint;
ls_Compas: WideString;
begin
if (Button = mbRight) then begin
ReleaseCapture;
//マウスジェスチャーと認識するタイムリミット
if (GetTickCount - F_rMouseGesture.Time <= lciMOUSEEVENTLIMIT) then begin
GetCursorPos(lpt_Pos);
ls_Compas := gfnsCompasGet(F_rMouseGesture.Pos, lpt_Pos);
if (ls_Compas = '上') then begin
//上に動かしたときの処理
end else if (ls_Compas = '下') then begin
//下に動かしたときの処理
end else if (ls_Compas = '左') then begin
//左へ動かしたときの処理
end else if (ls_Compas = '右') then begin
//右へ動かしたときの処理
end else begin
//ポップアップメニュー
PopupMenu1.Popup(lpt_Pos.X, lpt_Pos.Y);
end;
end;
end;
end;

OnMouseDownイベントでSetCaptureControl(Self);とし、OnMouseUpイベントでReleaseCapture;します。
SetCaptrueControlの引数はOnMouseDownイベントを受け取るTWinControlを指定します。
あるいはSetCapture APIでSetCapture(Self.Handle);としても同じようにいけます。