VERSION 5.00 Begin VB.Form Form1 Caption = "マウスジェスチャのサンプル" ClientHeight = 3240 ClientLeft = 60 ClientTop = 345 ClientWidth = 9285 LinkTopic = "Form1" ScaleHeight = 3240 ScaleWidth = 9285 StartUpPosition = 3 'Windows の既定値 Begin VB.TextBox Text2 Height = 2055 Left = 5040 MultiLine = -1 'True TabIndex = 15 Text = "Form1.frx":0000 Top = 1080 Width = 4095 End Begin VB.Frame fra_ Height = 855 Left = 5040 TabIndex = 5 Top = 120 Width = 4095 Begin VB.CheckBox chk_Enable Caption = "マウスジェスチャを有効にする" Height = 255 Left = 240 TabIndex = 6 Top = 360 Width = 3495 End End Begin VB.ListBox lst_Hist BeginProperty Font Name = "ＭＳ ゴシック" Size = 9 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2040 Left = 1920 TabIndex = 0 Top = 1080 Width = 3015 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 7 Left = 4440 TabIndex = 14 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 6 Left = 4080 TabIndex = 13 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 5 Left = 3720 TabIndex = 12 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 4 Left = 3360 TabIndex = 11 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 3 Left = 3000 TabIndex = 10 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 2 Left = 2640 TabIndex = 9 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 2280 TabIndex = 8 Top = 600 Width = 375 End Begin VB.Label lbl_Action Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 1920 TabIndex = 7 Top = 600 Width = 375 End Begin VB.Label Label1 Alignment = 2 '中央揃え BorderStyle = 1 '実線 Caption = "コマンド履歴" Height = 255 Index = 2 Left = 120 TabIndex = 4 Top = 1080 Width = 1815 End Begin VB.Label Label1 Alignment = 2 '中央揃え BorderStyle = 1 '実線 Caption = "入力されたコマンド" Height = 255 Index = 1 Left = 120 TabIndex = 3 Top = 600 Width = 1815 End Begin VB.Label lbl_Last Alignment = 2 '中央揃え BorderStyle = 1 '実線 BeginProperty Font Name = "ＭＳ ゴシック" Size = 15.75 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1920 TabIndex = 2 Top = 120 Width = 375 End Begin VB.Label Label1 Alignment = 2 '中央揃え BorderStyle = 1 '実線 Caption = "最新の動き" Height = 255 Index = 0 Left = 120 TabIndex = 1 Top = 120 Width = 1815 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit 'マウスジェスチャのイベントを受け取るためのイベントハンドラ Private WithEvents mMouseEvent As cMouseHookEvent Attribute mMouseEvent.VB_VarHelpID = -1 'フォームロード時 Private Sub Form_Load() End Sub 'フォームアンロード時 Private Sub Form_Unload(Cancel As Integer) ResetHook If Not mMouseEvent Is Nothing Then Set mMouseEvent = Nothing End If End Sub 'マウスジェスチャのＯＮ／ＯＦＦ Private Sub chk_Enable_Click() If chk_Enable.Value Then 'ＯＮ Set mMouseEvent = SetHook(Me.hwnd) Else 'ＯＦＦ ResetHook Set mMouseEvent = Nothing End If End Sub 'ジェスチャが開始されたとき Private Sub mMouseEvent_OnActionStart(ByVal MoveDir As Long) End Sub '新しい動きがあったとき '引数 '　MoveDir 移動方向（0=上、2=右、4=下、6=左） '　MoveCount 動きの数。右ボタンアップでクリアされる。 Private Sub mMouseEvent_OnActionMove(ByVal MoveDir As Long, ByVal MoveCount As Long) '最新の動きを表示 Select Case MoveDir Case 0, 2, 4, 6 lbl_Last.Caption = GetActionDirChar$(MoveDir) End Select 'コマンドの表示 Dim x& For x = 0 To mMouseEvent.MaxAction - 1 If x < MoveCount Then lbl_Action(x).Caption = GetActionDirChar$(mMouseEvent.ActionMove(x)) Else lbl_Action(x).Caption = "" End If Next End Sub 'ジェスチャが完了したとき Private Sub mMouseEvent_OnActionEnd(ByVal MoveCount As Long) '履歴に追加 Dim x&, a$ For x = 0 To MoveCount - 1 a$ = a$ + GetActionDirChar$(mMouseEvent.ActionMove(x)) Next lst_Hist.AddItem a$ lst_Hist.ListIndex = lst_Hist.ListCount - 1 End Sub 'マウス関係のウィンドウメッセージ 'CancelがTrueの場合、そのウィンドウメッセージは捨てられる。(デフォルトはFalse） 'マウスジェスチャでは必要ないかも。 Private Sub mMouseEvent_OnGetMessage(ByVal MsgID As Long, ByVal x As Long, ByVal y As Long, ByVal hwnd As Long, ByVal HitTestCode As Long, Cancel As Boolean) End Sub 'マウスの移動方向番号から表示用文字の取得 Private Function GetActionDirChar$(ByVal ModeDir As Long) GetActionDirChar$ = Mid$("↑／→＼↓／←＼", ModeDir + 1, 1) End Function