Visual Basic

Namespace nsMouseHook
    Public Delegate Function LowLevelMouseHookProc(ByVal nCode As Integer, ByVal wParam As UInteger, ByRef lParam As MSLLHOOKSTRUCT) As Integer

    Public Structure MSLLHOOKSTRUCT
        Public pt As API_POINT
        Public mouseData As UInteger
        Public flags As UInteger
        Public time As UInteger
        Public dwExtraInfo As IntPtr
    End Structure

    Public Structure API_POINT
        Public x As Integer
        Public y As Integer
    End Structure
End Namespace


Public Class GlobalMouseHook
    Implements IDisposable

    Private hhook As IntPtr = IntPtr.Zero
    Private disposedValue As Boolean = False        ' To detect redundant calls

    Public Event MouseDown As MouseEventHandler
    Public Event MouseUp As MouseEventHandler
    Public Event MouseMove As MouseEventHandler
    Private Const WM_MOUSEMOVE As UInteger = &H200
    Private Const WM_LBUTTONDOWN As UInteger = &H201
    Private Const WM_LBUTTONUP As UInteger = &H202
    Private Const WM_MBUTTONDOWN As UInteger = &H207
    Private Const WM_MBUTTONUP As UInteger = &H208
    Private Const WM_RBUTTONDOWN As UInteger = &H204
    Private Const WM_RBUTTONUP As UInteger = &H205
    Private Const WH_MOUSE_LL As Integer = 14
   
    Private Declare Auto Function LoadLibrary Lib "kernel32" (ByVal lpFileName As String) As IntPtr
    Private Declare Auto Function SetWindowsHookEx Lib "user32.dll" (ByVal idHook As Integer, ByVal lpfn As nsMouseHook.LowLevelMouseHookProc, ByVal hInstance As IntPtr, ByVal dwThreadId As UInteger) As IntPtr
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As UInteger, ByRef lParam As nsMouseHook.MSLLHOOKSTRUCT) As Integer
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As IntPtr) As Boolean

    Public Sub New()
             MouseHook()
            GC.KeepAlive(Me)
      End Sub

    Private Sub MouseHook()
      Dim hInstance As IntPtr = LoadLibrary("User32")
             hhook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf Me.MouseHookProc, hInstance, 0) ' AddressOf Me.HookProc,
       End Sub

    Private Sub MouseUnhook()
             UnhookWindowsHookEx(hhook)
      End Sub

    Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As UInteger, ByRef lParam As nsMouseHook.MSLLHOOKSTRUCT) As Integer
        If nCode >= 0 Then
            Select Case wParam
                Case WM_LBUTTONDOWN
                    RaiseEvent MouseDown(Me, New MouseEventArgs(MouseButtons.Left, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_RBUTTONDOWN
                    RaiseEvent MouseDown(Me, New MouseEventArgs(MouseButtons.Right, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_MBUTTONDOWN
                    RaiseEvent MouseDown(Me, New MouseEventArgs(MouseButtons.Middle, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_LBUTTONUP
                    RaiseEvent MouseUp(Me, New MouseEventArgs(MouseButtons.Left, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_RBUTTONUP
                    RaiseEvent MouseUp(Me, New MouseEventArgs(MouseButtons.Right, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_MBUTTONUP
                    RaiseEvent MouseUp(Me, New MouseEventArgs(MouseButtons.Middle, 0, lParam.pt.x, lParam.pt.y, 0))
                Case WM_MOUSEMOVE
                    RaiseEvent MouseMove(Me, New MouseEventArgs(WM_MOUSEMOVE, 0, lParam.pt.x, lParam.pt.y, 0))
                Case Else
                    Console.WriteLine(wParam)
            End Select
        End If
            Return CallNextHookEx(hhook, nCode, wParam, lParam)
       End Function

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
             If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: free other state (managed objects).
                End If
                MouseUnhook()
            End If
            Me.disposedValue = True
    End Sub

    Public Sub Dispose() Implements IDisposable.Dispose
        GC.SuppressFinalize(Me)
        Dispose(True)
    End Sub

End Class

Option Strict On
Option Explicit On
Option Infer Off

Imports System.Runtime.InteropServices
Imports System.IO

Public Class MainForm
    Private intTimeOfLastEvent As Double = 0    ' Time of the last recorded event
    Private intTimeRecording As Double = 0      ' Recording time elaspesd
    Private intTimePlaying As Double = 0        ' Timer value  for playback
   
    Private WithEvents gmh As GlobalMouseHook

    Public Sub New()
        InitializeComponent()
    End Sub

    ' Form overrides dispose to clean up the component list.
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Catch ex As Exception
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    Private Sub MainForm_FormClosed(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed
        If gmh IsNot Nothing Then gmh.Dispose()
    End Sub

    ''' <summary>Called when recording is started</summary>
    ''' <remarks></remarks>
    Private Sub startRecording()
        butPlay.Enabled = False
        tRecordTime.Start()
        bolRecording = True
        gmh = New GlobalMouseHook
    End Sub

    ''' <summary>Called when recording is stopped</summary>
    ''' <remarks></remarks>
    Private Sub stopRecording()
        tRecordTime.Stop()
        bolRecording = False
        gmh.Dispose()
    End Sub

    Private Sub gmh_MouseClickDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles gmh.MouseDown
        lbLog.Items.Add(String.Format("Time:{0}", (intTimeRecording - intTimeOfLastEvent) / 1000))
        lbLog.Items.Add(String.Format("Mouse Click Down:{0}" & vbTab & "X:{1}" & vbTab & "Y:{2}", e.Button, e.X, e.Y))
        lbLog.SelectedIndex = lbLog.Items.Count - 1
        intTimeOfLastEvent = intTimeRecording
    End Sub

    Private Sub gmh_MouseClickUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles gmh.MouseUp
        lbLog.Items.Add(String.Format("Time:{0}", (intTimeRecording - intTimeOfLastEvent) / 1000))
        lbLog.Items.Add(String.Format("Mouse Click Up:{0}" & vbTab & "X:{1}" & vbTab & "Y:{2}", e.Button, e.X, e.Y))
        intTimeOfLastEvent = intTimeRecording
        lbLog.SelectedIndex = lbLog.Items.Count - 1
    End Sub

    Private Sub gmh_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles gmh.MouseMove
        lblMousePosition.Text = e.X & ", " & e.Y
        lbLog.Items.Add("Move")
        lbLog.SelectedIndex = lbLog.Items.Count - 1
    End Sub

    Private Sub butRecord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butRecord.Click
        If butRecord.Text = "Record" Then
            butRecord.Text = "Stop Recording"
            startRecording()
        ElseIf butRecord.Text = "Stop Recording" Then
            butRecord.Text = "Record"
            stopRecording()
        End If
    End Sub

    Private Sub tRunTime_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tRecordTime.Tick
        intTimeRecording += tRecordTime.Interval
        lblRecordTime.Text = (intTimeRecording / 1000).ToString("###.##")
        lblRecordTime.Text = String.Format("Record Time:{0:###.##}", (intTimeRecording / 1000))
    End Sub

    Private Sub butExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butExit.Click, ExitToolStripMenuItem.Click
        Me.Close()
    End Sub

End Class

Imports System.Drawing

Public Class FontClass
    Inherits ComboBox
    Dim wait As Boolean
    Public Sub New()
        Me.DrawMode = Windows.Forms.DrawMode.OwnerDrawFixed
        Me.DropDownStyle = ComboBoxStyle.DropDownList
        Me.Text = ""
        Dim ff As FontFamily
        Dim fc As New FontConverter

        For Each ff In FontFamily.Families
            Dim comboitem As New ComboBoxItem
            If ff.IsStyleAvailable(FontStyle.Regular) Then
                comboitem.Text = ff.Name
                comboitem.Font = fc.ConvertFromString(ff.Name)
                Me.Items.Add(comboitem)

            End If
        Next

    End Sub

    Protected Overrides Sub OnDrawItem(ByVal e As System.Windows.Forms.DrawItemEventArgs)
        e.DrawBackground()
        e.DrawFocusRectangle()
        Dim item As New ComboBoxItem
        Dim bounds As New Rectangle
        bounds = e.Bounds
        Try
            item = Me.Items(e.Index)
            e.Graphics.DrawString(item.Text, item.Font, New SolidBrush(e.ForeColor), bounds.Left, bounds.Top)

        Catch ex As Exception
            If (e.Index <> -1) Then
                e.Graphics.DrawString((e.Index).ToString(), e.Font, New SolidBrush(e.ForeColor), bounds.Left, bounds.Top)
            Else
                e.Graphics.DrawString(Text, e.Font, New SolidBrush(e.ForeColor), bounds.Left, bounds.Top)
            End If

        End Try

        MyBase.OnDrawItem(e)
    End Sub

    Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)
        wait = False
        MyBase.OnMouseLeave(e)
    End Sub

    Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
        wait = False
        MyBase.OnMouseUp(e)
    End Sub


    Protected Overrides Sub OnSelectedIndexChanged(ByVal e As System.EventArgs)
        Try
            If wait = False Then
                Dim fc As New FontConverter

                Me.Font = fc.ConvertFromString(Me.Text)
            End If
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub
    


End Class

Public Class ComboBoxItem

    Private ctext As String
    Private cSelFont As Font

    Property Text() As String
        Get
            Return ctext
        End Get
        Set(ByVal Value As String)
            ctext = Value
        End Set
    End Property
    Property Font() As Font
        Get
            Return cSelFont
        End Get
        Set(ByVal Value As Font)
            cSelFont = Value
        End Set
    End Property
    Public Overrides Function ToString() As String
        Return ctext
    End Function



End Class

Public DBConn As ADODB.Connection

DBConn.ConnectionString = "Provider=MSDATASHAPE; Data Provider=SQLOLEDB.1;Data Source=TOSHIBA\SQLEXPRESS; Initial Catalog=" & App.Path & "\AVON_AIR_Data.mdf; User ID=sa; Password=; Integrated Security=SSPI; Persist Security Info=False;"
 DBConn.Open DBConn.ConnectionString