none
accurate and stable metronome RRS feed

  • Question

  • Hello,
    I've been struggling with building an accurate and stable metronome with audio playback of short wave files 
    and counters and flashing controls.  Initially I was building a standalone app but also want to incorporate 
    it into a musicians 'gig list' application I developing.   The app needs to be thread safe, I guess, because 
    currently it will slow down a bit if the computer is doing something else such as loading a web page.   I'm a pretty new programmer especially with multi-threading applications.    Would it be a more reliable app in WPF - which I've never done.  

    Some things the application needs it to do:   
    Ability to change BPM with slider and keyboard (typing numbers)
    Ability to start and stop metronome
    Ability to change number of beats per measure
    Ability to visualy display beats - button control or other control change colors on beats
    Ability to count beats in a measure
    Nice to have: ability to tap a button to determine a new tempo.

    My code is pasted below.   
    Some of this I used from  dbasnett's code.  ( https://social.msdn.microsoft.com/Forums/en-US/186110b7-a3ec-4047-b5fa-c6260f50c84c/metronome-quality-timer-at-last?forum=Vsexpressvb ) 

    Imports System
    Imports System.Collections.Generic
    Imports System.Data
    Imports System.Windows.Forms
    Imports System.ComponentModel
    Imports System.Runtime.InteropServices
    Imports System.Media
    Imports System.Threading
    
    
    'Inherits System.Windows.Forms.Form
    Public Class Form1
        Dim TimeSignature As Integer
    
    
    
    
        Public Sub Waiter(n As Integer)
            Dim gWaiting As Integer
            '*******************************************************************************
            ' 1. Wait
            ' Purpose:      Produces a pause
            ' Inputs:       n = desired pause in tenths of a second
            ' Returns:      nothing
            '*******************************************************************************
            Dim i As Long
            gWaiting = True
            i = GetTickCount()
            'While GetTickCount() < i + (n * 1000)  ' 1 second
            While GetTickCount() < i + (n * 100)  ' 1/10 of a  second
                Application.DoEvents() 'let other apps keep running
            End While
            gWaiting = False
        End Sub
    
    
    
    
    
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            HScrollBar2.Value = txtTempo.Text
            Me.Text = "Metronome Standalone"
            DomainUpDown1.SelectedIndex = 7
            SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, New IntPtr(APPCOMMAND_VOLUME_MUTE))
            Waiter(10)
            btnStart.PerformClick()
            Waiter(16)
            btnStart.PerformClick()
            Waiter(4)
            SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, New IntPtr(APPCOMMAND_VOLUME_MUTE))
            TimeSignature = 4
        End Sub
        'AUDIO STUFF ------------------------------------------------------------------------  
        'https://social.msdn.microsoft.com/Forums/vstudio/en-US/8308f020-b9e6-472c-aaac-93619a8a5a7d/vbnet-control-the-system-volume-mute-and-output-the-current-level-to-the-user?forum=vbgeneral
    
        Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H80000
        Private Const APPCOMMAND_VOLUME_UP As Integer = &HA0000
        Private Const APPCOMMAND_VOLUME_DOWN As Integer = &H90000
        Private Const WM_APPCOMMAND As Integer = &H319
    
        <DllImport("user32.dll")> Public Shared Function SendMessageW(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        End Function
        'AUDIO STUFF ----------------------------------------------------------------------
        Declare Function GetTickCount Lib "kernel32" () As Long
    
        '--------------------------------METRONOME
        '  https://social.msdn.microsoft.com/Forums/en-US/186110b7-a3ec-4047-b5fa-c6260f50c84c/metronome-quality-timer-at-last?forum=Vsexpressvb
    
    
    
    
        Private WithEvents myMetro As New Metronome ' added 
    
        Private Sub Metronome_MetroTick(sender As Object, e As EventArgs) Handles myMetro.MetroTick
            'added this sub ----------
            Static thistick As Boolean
    
            thistick = Not thistick
            If thistick Then
                btnTempoDummyLight.BackColor = Color.LawnGreen
                btnTempoDummyLight2.BackColor = Color.Red 'lawngreen
                'lblCounter.BackColor = Color.Black
                'lblCounter.ForeColor = Color.White
                AccessControl()
    
            Else
    
                btnTempoDummyLight.BackColor = Color.Red  ' white
                btnTempoDummyLight2.BackColor = Color.LawnGreen ' 
                'Me.BackColor = Color.Black
                AccessControl()
    
            End If
    
        End Sub
    
    
    
        Private Sub AccessControl()
            'SyncLock lockThis
            'Dim BeatCounter As Integer
            'BeatCounter = 1
            'Dim BeatCounter2 As Integer
            'BeatCounter2 = 2
            'BeatCounter = BeatCounter + 1
            'Debug.Print(BeatCounter)
            'Me.lblCounter.Text = BeatCounter.ToString
            'Dim BeatsPerMeas As Int64
            'BeatsPerMeas = DomainUpDown1.SelectedItem
            'index  Beats
            '0      2
            '1      3
            '2      4
            '3      5  
            '4      6
            '5      7
            '6      8
            '7      9
            '8      10
            '9      14
    
            'For TimeSignature As Integer = 1 To 5
            '    If Me.InvokeRequired Then
            '        Me.Invoke(New MethodInvoker(AddressOf AccessControl))
            '    Else
            '        lblCounter.Text = lblCounter.Text + 1
            '        If lblCounter.Text = intr Then  'was 3 which is '3beats
            '            lblCounter.Text = 1
            '            If lblCounter.Text = 1 Then
            '                btnTempoDummyLight.BackColor = Color.White
            '            End If
            '        End If
    
            '    End If
            'Next
    
            If TimeSignature = 2 Then '2beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 3 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
            ElseIf TimeSignature = 3 Then '3beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
    
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 4 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
            ElseIf TimeSignature = 4 Then '4beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 5 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
                End If
            ElseIf TimeSignature = 5 Then '5beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 6 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
            ElseIf TimeSignature = 6 Then '6beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 7 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
            ElseIf TimeSignature = 7 Then '7beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 8 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
            ElseIf TimeSignature = 8 Then '8beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 9 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
            ElseIf TimeSignature = 9 Then '9beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 10 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
            ElseIf TimeSignature = 10 Then '10beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 11 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
            ElseIf TimeSignature = 14 Then '14beats
                If Me.InvokeRequired Then
                    Me.Invoke(New MethodInvoker(AddressOf AccessControl))
                Else
                    lblCounter.Text = lblCounter.Text + 1
                    If lblCounter.Text = 15 Then
                        lblCounter.Text = 1
                        If lblCounter.Text = 1 Then
                            btnTempoDummyLight.BackColor = Color.White
                            lblCounter.BackColor = Color.White
                            lblCounter.ForeColor = Color.Black
                        End If
                    End If
    
                End If
    
    
            End If
            '    End SyncLock
        End Sub
    
        Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
            '  MsgBox("Closing down")
            myMetro.Dispose()
        End Sub
    
        Public Class Metronome
            Implements IDisposable
            Public Event MetroTick As EventHandler ' added
            Private _bpm As Integer
            Private _beatTS As TimeSpan
            Private _OnOff As Long '<=0 = off, > 0 = on
            Private _beatMS As Long
    
            Public Property BPM() As Integer
                Get
                    Return Me._bpm
                End Get
                Set(ByVal value As Integer)
                    Me._bpm = value
                    Me._beatTS = New TimeSpan(0, 0, 0, 0, 60000 \ Me._bpm) 'set ms between beats
                    Threading.Interlocked.Exchange(Me._beatMS, CLng(Me._beatTS.TotalMilliseconds))
                End Set
            End Property
    
            Private tmkThrd As System.Threading.Thread
            Public Sub New()
                Me.BPM = -1
                Threading.Interlocked.Exchange(Me._OnOff, 0L) 'set to off
                'start thread to do timekeeping
                Me.tmkThrd = New System.Threading.Thread(AddressOf Me.TimeKeeper)
                't.IsBackground can be set to false IF the application calls Dispose
                't.IsBackground = True
                Me.tmkThrd.IsBackground = False
                Me.tmkThrd.Priority = Threading.ThreadPriority.Highest
                tmkThrd.Start()
    
            End Sub
    
            Public Sub New(ByVal BPM As Integer)
                MyBase.New()
                Me.BPM = BPM 'set beats per minute
            End Sub
    
            Public Sub StartMetronome()
    
                Threading.Interlocked.Exchange(Me._OnOff, 1L) 'start
                Me.tmkThrd.Interrupt() 'wake the thread
    
            End Sub
    
            Public Sub StopMetronome()
                Threading.Interlocked.Exchange(Me._OnOff, 0L) 'stop
            End Sub
            Private Sub TimeKeeper()
                Dim stpw As New Stopwatch
                Dim newSound As New Action(AddressOf MakeSound) 'play sound
                stpw.Start()
                Do
                    Dim btMS As Long = Threading.Interlocked.Read(Me._beatMS)
                    Dim offSlp As Long = btMS \ 4
                    If Threading.Interlocked.Read(Me._OnOff) = 0L Then 'not running
                        stpw.Reset()
                        Try
                            Threading.Thread.Sleep(100)   ' 100
                        Catch ex As Exception
                        End Try
                    ElseIf Not stpw.IsRunning Then
                        stpw.Start()
                        Threading.Interlocked.Exchange(Me.isPlaying, 0L)
                    ElseIf stpw.ElapsedMilliseconds + offSlp >= btMS Then
                        'in the ballpark
                        Do While stpw.ElapsedMilliseconds < btMS
                            'wait in a tight loop for the time to pass
                        Loop
                        stpw.Reset() 'reset and start the stopwatch before playing the sound
                        stpw.Start()
                        If Threading.Interlocked.Read(Me.isPlaying) = 0L Then newSound.Invoke()
                    Else 'running, but not time to play sound
                        'changed next line on 10/7/17 - does it help with crashing - what does it affect? 
                        Threading.Thread.Sleep(CInt(offSlp))
                    End If
                Loop While Not Me.disposed
    
            End Sub
    
            Private isPlaying As Long
            Private Sub MakeSound()
                ' If Form1.lblCounter.Text = "1" Then
                RaiseEvent MetroTick(Me, New EventArgs)
                Threading.Interlocked.Increment(Me.isPlaying)
    
                'My.Computer.Audio.Play("C:\Users\vprjma\Documents\Dropbox\Dev Stuff\Metronome standalone\Metronome standalone\bin\Debug\defaultsm.wav", AudioPlayMode.Background)
                My.Computer.Audio.Play(My.Resources.MetronomeWave, AudioPlayMode.Background)
    
    
                Threading.Interlocked.Decrement(Me.isPlaying)
                '   End If
            End Sub
    
    
    #Region "Dispose"
            Private disposed As Boolean
    
            Protected Overridable Sub Dispose(ByVal disposing As Boolean)
                If Not Me.disposed Then
                    If disposing Then
                        ' TODO: free managed resources when explicitly called 
                    End If
                    ' TODO: free shared unmanaged resources 
                End If
                Me.disposed = True
            End Sub
    
            Public Sub Dispose() Implements IDisposable.Dispose
                Dispose(True)
                GC.SuppressFinalize(Me)
            End Sub
    
            Protected Overrides Sub Finalize()
                Call Me.Dispose(False)
                Call MyBase.Finalize()
            End Sub
    #End Region
        End Class
    
        Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
            ' btnStart.Text = "Stop"
            lblCounter.Text = 0
            If btnStart.Text = "Stop" Then
    
                myMetro.StopMetronome()
                btnStart.Text = "Start"
    
            ElseIf btnStart.Text = "Start" Then
                btnStart.Text = ("Stop")
                btnTempoDummyLight.BackColor = Color.White
                If txtTempo.Text = "" Then ' Or txtTempo.Text = " " Or txtTempo.Text = 0 Or txtTempo.Text = "" Then
                    GoTo ender
                Else
    
                    myMetro.BPM = txtTempo.Text
                    'myMetro.BPM = 120
                    myMetro.StartMetronome()
                End If
            End If
    ender:
            'btnStart.Text = "Start"
        End Sub
    
        Private Sub txtTempo_TextChanged(sender As Object, e As EventArgs) Handles txtTempo.TextChanged
            If btnStart.Text = "Stop" Then ' means the metro is running
                btnStart.PerformClick()
            End If
    
    
        End Sub
    
        Private Sub HScrollBar2_Scroll(sender As Object, e As ScrollEventArgs) Handles HScrollBar2.Scroll
            txtTempo.Text = HScrollBar2.Value
        End Sub
    
        Private Sub DomainUpDown1_SelectedItemChanged(sender As Object, e As EventArgs) Handles DomainUpDown1.SelectedItemChanged
            If btnStart.Text = "Stop" Then
                btnStart.PerformClick()
            End If
    
            TimeSignature = DomainUpDown1.SelectedItem
            '  MsgBox(TimeSignature)
    
        End Sub
    
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            MsgBox(DomainUpDown1.SelectedItem)
    
        End Sub
        '________________________ END METRONOME
    
    End Class
    

    Saturday, October 14, 2017 5:59 PM

All replies

  • Hi J.Marq,

    According to your description, what problem did you encounter from your code? And what is error message?

    Best Regards,

    Cherry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, October 16, 2017 8:40 AM
    Moderator