vbAccelerator - Contents of code file: frmMouseGesture.frm

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.dll"
Begin VB.Form frmMouseGesture 
   Caption         =   "vbAccelerator Mouse Gesture Demonstration"
   ClientHeight    =   5865
   ClientLeft      =   3315
   ClientTop       =   2175
   ClientWidth     =   5820
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMouseGesture.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   391
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   388
   Begin SHDocVwCtl.WebBrowser webBrowser 
      Height          =   2415
      Left            =   120
      TabIndex        =   3
      Top             =   3360
      Width           =   5595
      ExtentX         =   9869
      ExtentY         =   4260
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "http:///"
   End
   Begin VB.Timer tmrHighlight 
      Interval        =   350
      Left            =   180
      Top             =   2520
   End
   Begin VB.PictureBox picGesture 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1410
      Left            =   1680
      Picture         =   "frmMouseGesture.frx":1272
      ScaleHeight     =   1410
      ScaleWidth      =   2340
      TabIndex        =   0
      Top             =   1800
      Width           =   2340
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmMouseGesture.frx":BE8C
      Height          =   1215
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   5595
   End
   Begin VB.Label lblGestureType 
      Caption         =   " Gesture Type"
      Height          =   255
      Left            =   1680
      TabIndex        =   1
      Top             =   1500
      Width           =   2355
   End
End
Attribute VB_Name = "frmMouseGesture"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type RECT
   top As Long
   left As Long
   right As Long
   bottom As Long
End Type

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As
 Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
 hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
 As Long
Private Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
Private m_highlightRect As RECT
Private m_bHighlighted As Boolean

Private WithEvents mouseGestures As cMouseGestures
Attribute mouseGestures.VB_VarHelpID = -1

Private Sub Form_Load()
   Set mouseGestures = New cMouseGestures
   mouseGestures.Attach
   webBrowser.Navigate2 "/index.html"
End Sub

Private Sub mouseGestures_MouseGesture(ByVal gestureType As MouseGestureTypes,
 ByVal xGestureStart As Long, ByVal yGestureStart As Long, ByVal xGestureEnd As
 Long, ByVal yGestureEnd As Long, acceptGesture As Boolean)
   '
   HighlightGesture gestureType
   acceptGesture = True
   '
End Sub

Private Sub HighlightGesture(ByVal gestureType As MouseGestureTypes)
   
   tmrHighlight.Enabled = False
   If (m_bHighlighted) Then
      ToggleHighlight
   End If
   
   Dim width As Long
   width = 30
   Select Case gestureType
   Case MouseGestureTypes.NorthGesture:
      m_highlightRect.left = 1: m_highlightRect.top = 32
               
   Case MouseGestureTypes.SouthGesture:
      m_highlightRect.left = 1: m_highlightRect.top = 63
      
   Case MouseGestureTypes.EastGesture:
      m_highlightRect.left = 94: m_highlightRect.top = 1
      width = 61
      
   Case MouseGestureTypes.WestGesture:
      m_highlightRect.left = 32: m_highlightRect.top = 1
      width = 61

   Case MouseGestureTypes.NorthThenWestGesture:
      m_highlightRect.left = 32: m_highlightRect.top = 32
      
   Case MouseGestureTypes.WestThenNorthGesture:
      m_highlightRect.left = 63: m_highlightRect.top = 32
      
   Case MouseGestureTypes.EastThenNorthGesture:
      m_highlightRect.left = 94: m_highlightRect.top = 32
      
   Case MouseGestureTypes.NorthThenEastGesture:
      m_highlightRect.left = 125: m_highlightRect.top = 32

   Case MouseGestureTypes.SouthThenWestGesture:
      m_highlightRect.left = 32: m_highlightRect.top = 63
      
   Case MouseGestureTypes.WestThenSouthGesture:
      m_highlightRect.left = 63: m_highlightRect.top = 63
      
   Case MouseGestureTypes.EastThenSouthGesture:
      m_highlightRect.left = 94: m_highlightRect.top = 63
      
   Case MouseGestureTypes.SouthThenEastGesture:
      m_highlightRect.left = 125: m_highlightRect.top = 63
               
   End Select
   
   m_highlightRect.right = m_highlightRect.left + width
   m_highlightRect.bottom = m_highlightRect.top + 30
   
   ToggleHighlight
   tmrHighlight.Enabled = True
   
End Sub

Private Sub tmrHighlight_Timer()
   '
   If (m_bHighlighted) Then
      ToggleHighlight
   End If
   tmrHighlight.Enabled = False
   '
End Sub

Private Sub ToggleHighlight()
   m_bHighlighted = Not (m_bHighlighted)
   BitBlt picGesture.hDC, m_highlightRect.left, m_highlightRect.top, _
      m_highlightRect.right - m_highlightRect.left, m_highlightRect.bottom -
       m_highlightRect.top, _
      Me.hDC, 8, 100, SRCINVERT
End Sub