最終更新日 2007年11月15日
up
top
VB.NETでのマウスジェスチャの実装 1.1
VB.NETでのマウスジェスチャの実装ではいまいち感度が悪かったので、
Firefox のマウスジェスチャのエクステンション、
All-in-One Gestures と互換にしてみました。
斜めは検知しないので感度がよくなりました。
<![CDATA[
Public Class Form1
Dim gestureStarted As Boolean '// マウスジェスチャ中かのフラグ
Dim strokes As String '// ジェスチャの結果
Dim exX, exY, grid As Integer '// 元のマウスのX座標、Y座標、距離の閾値
'// マウスのボタンが押された
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
If e.Button = Windows.Forms.MouseButtons.Right Then '// 右ボタンなら
gestureStarted = True '// マウスジェスチャ開始！（開始！）
grid = 15 '// 15ピクセル動いたら1ストローク
strokes = "" '// 結果初期化
exX = e.X '// 右ボタンを押したときのマウス座標を保持
exY = e.Y '// 右ボタンを押したときのマウス座標を保持
End If
End Sub
'// マウスのボタンが離された
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
If e.Button = Windows.Forms.MouseButtons.Right Then '// 右ボタンなら
gestureStarted = False '// マウスジェスチャ停止
Select Case strokes '// ジェスチャ実行
Case "DR" '// 終了とか
End
Case "RU" '// ウィンドウの最大化、元に戻すとか
If Me.WindowState = FormWindowState.Normal Then
Me.WindowState = FormWindowState.Maximized
Else
Me.WindowState = FormWindowState.Normal
End If
End Select
End If
End Sub
'// マウス移動中
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
'// マウスジェスチャ中なら
If gestureStarted Then
Dim dirX, dirY, absX, absY As Integer '// 元座標からの距離とその絶対値
Dim pente As Single '// 傾き
Dim direction As String '// ジェスチャの方向
'ToolStripStatusLabel1.Text = "マウス ジェスチャ " & strokes
dirX = e.X - exX : absX = Math.Abs(dirX)
dirY = e.Y - exY : absY = Math.Abs(dirY)
If absX < grid And absY < grid Then Return '// 閾値未満なら何もせず
If absY <= 5 Then pente = 100 Else pente = absX / absY
If pente < 0.58 Or pente > 1.73 Then '// 斜めは検知せず
If pente < 0.58 Then
If dirY > 0 Then direction = "D" Else direction = "U"
Else
If dirX > 0 Then direction = "R" Else direction = "L"
End If
'// 連続した方向でないならストロークに追加
If Not strokes.EndsWith(direction) Then strokes = strokes & direction
End If
exX = e.X : exY = e.Y '// 新しい元座標を保存
End If
End Sub
End Class
]]>