Programming Tool Box/SIMS_2.iso/tool/sound/vb_mid/vb_seq.bas

BASIC Source File | 1995-02-05 | 29KB | 955 lines

Option Explicit

'Type of recorded Midi Message
Type udtMidiMsg
    TimeStamp As Long   'Associated time in milliseconds
    MidiData As Long    'Usually: (Status + Channel) + (&H100& * Data1) + (&H10000 * Data2)
End Type

'RecBuffer parameters
Global aRecBuffer() As udtMidiMsg        'dynamic array of recorded messages
Global nRecCounter As Long               'N. of recorded messages
Global nRecErrors As Long                'N. of lost Midi In Messages

'Timing variables
Global lInitTime As Long        'timeGetTime() when Play or Rec starts (in Internal Sync)
Global lOffsetTime As Long      'Display Time when Play or Rec starts (in Internal Sync)

'Flags to track Play and Rec activity
Global bStop As Integer     'if True indicates Stop Mode
Global bPlay As Integer     'if True indicates Play Mode
Global bRec As Integer      'if True indicates Rec Mode

'For Clock displaying purposes  (incremented by one frame every frame)
Global nDisplayHours As Integer
Global nDisplayMinutes As Integer
Global nDisplaySeconds As Integer
Global nDisplayFrames As Integer

'For MTC Out purposes   (incremented by two frames every two frames)
Global nHoursCounter   As Integer
Global nMinutesCounter As Integer
Global nSecondsCounter As Integer
Global nFramesCounter  As Integer

'Name of the last saved or opened file
Global sFilename As String

'Visualize flags
Global bVisualClock As Integer 'Visualize clock display
Global bVisualData As Integer  'Visualize Midi Data Flow
Global bVisualMtc As Integer   'Visualize MTC flow

'To track Midi flow visualisation
Global lMtcInTime As Long       'Time when MtcIn led was switched on
Global lMtcOutTime As Long      'Time when MtcOut led was switched on
Global lDataInTime As Long      'Time when DataIn led was switched on
Global lDataOutTime As Long     'Time when DataOut led was switched on

'Sequencer parameters
Global nSeqChannel As Integer
Global aSeqProgram(15) As Integer

'Indicates Mouse state in Rewind and Forward MouseDown events
Global bMouseDown As Integer

'Led colors
Global Const LED_OFF = &H80&
Global Const LED_ON = &H80FF&

'GENERAL CONSTANTS

'MousePointer
Global Const DEFAULT = 0
Global Const HOURGLASS = 11

'Keycodes
Global Const KEY_ESCAPE = &H1B
Global Const KEY_NUMPAD0 = &H60
Global Const KEY_RETURN = &HD
Global Const KEY_MULTIPLY = &H6A
Global Const KEY_SPACE = &H20
Global Const KEY_F12 = &H7B

'Special keys
Global Const SHIFT_MASK = 1
Global Const CTRL_MASK = 2
Global Const ALT_MASK = 4

' MsgBox parameters
Global Const MB_OK = 0                 ' OK button only
Global Const MB_YESNO = 4              ' Yes and No buttons
Global Const MB_ICONQUESTION = 32      ' Warning query
Global Const MB_ICONEXCLAMATION = 48   ' Warning message

' MsgBox return values
Global Const IDOK = 1                  ' OK button pressed
Global Const IDYES = 6                 ' Yes button pressed
Global Const IDNO = 7                  ' No button pressed

'Colors
Global Const WHITE = &HFFFFFF
Global Const DARKBLUE = &H800000

' DragOver
Global Const ENTER = 0
Global Const LEAVE = 1

Sub Display_Erase ()
    If frmVBSeq.lblHours <> "--" Then frmVBSeq.lblHours = "--"
    If frmVBSeq.lblMinutes <> "--" Then frmVBSeq.lblMinutes = "--"
    If frmVBSeq.lblSeconds <> "--" Then frmVBSeq.lblSeconds = "--"
    If frmVBSeq.lblFrames <> "--" Then frmVBSeq.lblFrames = "--"
End Sub

Sub Display_Show ()
    Dim sDisplay As String

    sDisplay = Format$(nDisplayHours, "00")
    If frmVBSeq.lblHours <> sDisplay Then frmVBSeq.lblHours = sDisplay

    sDisplay = Format$(nDisplayMinutes, "00")
    If frmVBSeq.lblMinutes <> sDisplay Then frmVBSeq.lblMinutes = sDisplay

    sDisplay = Format$(nDisplaySeconds, "00")
    If frmVBSeq.lblSeconds <> sDisplay Then frmVBSeq.lblSeconds = sDisplay

    sDisplay = Format$(nDisplayFrames, "00")
    If frmVBSeq.lblFrames <> sDisplay Then frmVBSeq.lblFrames = sDisplay
End Sub

Sub Dlg_Alert (sMsg As String)
     Beep
     MsgBox sMsg, MB_OK + MB_ICONEXCLAMATION, "ALERT"
End Sub

Function Dlg_YesNo (sMsg1 As String) As Integer
    Dim sMsg2 As String

    sMsg2 = "Make your decission"
    Beep
    If MsgBox(sMsg1, MB_YESNO + MB_ICONQUESTION, sMsg2) = IDYES Then
        Dlg_YesNo = True
    Else
       Dlg_YesNo = False
    End If
End Function

'Returns True if File must be deleted / False if File must not
Function File_Delete% (sPath As String)
    Dim i As Integer
    Dim sName As String
    Dim FNum As Integer

    If Len(sPath) <= 1 Or Mid$(sPath, Len(sPath), 1) = "\" Then
    Call Dlg_Alert(sFilename & Chr(10) & "Bad file name!")
    frmVBSeq.dlgFileDialog.Filename = "*.SNG"
    sFilename = "?"
    File_Delete = False
    Exit Function
    End If

    For i = Len(sPath) To 1 Step -1
    If Mid$(sPath, i, 1) = "\" Then
        sName = Mid$(sPath, i + 1, Len(sPath) - i)
        Exit For
    End If
    Next i

    FNum = FreeFile

    On Error Resume Next

    Open sPath For Input As FNum

    'No error -> File already exists
    If Err = 0 Then
    If Dlg_YesNo(sName & " already exists!" & Chr(10) & "Replace it...?") = True Then
        'overwrite it
        File_Delete = True
    Else
        'abort save
        File_Delete = False
    End If

    'File not found
    ElseIf Err = 53 Then
    'doesn't need to be deleted
    'keep on saving
    File_Delete = True

    'Bad File Name
    ElseIf Err = 64 Or Err = 52 Then
    Call Dlg_Alert(sName & Chr(10) & "Bad file name!")
    frmVBSeq.dlgFileDialog.Filename = "*.SNG"
    sFilename = "?"
    'abort save
    File_Delete = False

    'Unexpected error
    Else
    Call Dlg_Alert("Error #" & Err & Chr(10) & Error$)
    frmVBSeq.dlgFileDialog.Filename = "*.SNG"
    sFilename = "?"
    'abort save
    File_Delete = False
    End If

    Close FNum
End Function

Sub File_Open ()
    Dim FNum   As Integer
    Dim nLen    As Integer
    Dim i       As Integer

    'If buffer not empty confirm loss of data
    If nRecCounter > 0 Then
    If Dlg_YesNo("Erase recorded MIDI messages?") = False Then Exit Sub
    End If

    On Error GoTo Open_Error_Handler

    'Activate cancel error
    frmVBSeq.dlgFileDialog.CancelError = True

    'Set File Dialog parameters
    frmVBSeq.dlgFileDialog.Filter = "Custom MIDI song (*.SNG)|*.SNG|Standard MIDI file (*.MID)|*.MID|All (*.*)|*.*"
    frmVBSeq.dlgFileDialog.FilterIndex = 1
    frmVBSeq.dlgFileDialog.DialogTitle = "Open File"
    frmVBSeq.dlgFileDialog.Action = 1    '1 = Open file dialog

    frmVBSeq.Refresh

    'Get path and file name to be opened
    sFilename = frmVBSeq.dlgFileDialog.Filename

    nLen = Len(sFilename)
    For i = nLen To 1 Step -1
    If Mid$(sFilename, i, 1) = "\" Then Exit For
    Next i

    sFilename = Right$(sFilename, nLen - i)

    Screen.MousePointer = HOURGLASS

    If Right$(sFilename, 4) = ".SNG" Then
    FNum = FreeFile
    Open frmVBSeq.dlgFileDialog.Filename For Input As FNum
    Input #FNum, nRecCounter

    If nRecCounter > 0 Then
        ReDim aRecBuffer(nRecCounter + 1024 - (nRecCounter Mod 1024))
        For i = 0 To nRecCounter - 1
        Input #FNum, aRecBuffer(i).TimeStamp
        Input #FNum, aRecBuffer(i).MidiData
        Next i
    End If
    'Display recorded messages counter
    frmVBSeq.lblRecMesNum = CStr(nRecCounter)

    Close #FNum
    ElseIf Right$(sFilename, 4) = ".MID" Then
    Call Dlg_Alert("Not implemented!")
    Else
    Call Dlg_Alert("Wrong file format!")
    End If

Open_Exit:
    Screen.MousePointer = DEFAULT
    Exit Sub

Open_Error_Handler:
    If Err = 32755 Then   'Cancel
    Resume Open_Exit
    Else
    Call Dlg_Alert("Error #" & Err & Chr(10) & Error$)
    Close #FNum
    Resume Open_Exit
    End If

End Sub

Sub File_Save ()
    Dim sFname As String
    Dim FNum As Integer
    Dim i As Integer
    Dim nStartName As Integer
    Dim nLen As Integer

    'Exit if buffer empty
    If nRecCounter = 0 Then
    Call Dlg_Alert("Nothing to save!")
    Exit Sub
    End If

    On Error GoTo Save_Error_Handler

    'Activate cancel error
    frmVBSeq.dlgFileDialog.CancelError = True

    'Set File Dialog parameters
    frmVBSeq.dlgFileDialog.Filter = "Custom MIDI song (*.SNG)|*.SNG|Standard MIDI file (*.MID)|*.MID|All (*.*)|*.*"
    frmVBSeq.dlgFileDialog.FilterIndex = 1
    frmVBSeq.dlgFileDialog.DialogTitle = "Save File"
    frmVBSeq.dlgFileDialog.Action = 2   '2 = Savefile Dialog

    frmVBSeq.Refresh

    'Get path and file name to be saved
    sFname = frmVBSeq.dlgFileDialog.Filename

    'Check Filename suffix (must be .SNG)
    If Right$(sFname, 4) <> ".SNG" Then   'And Right$(sFname, 4) <> ".MID"
    nLen = Len(sFname)
    For i = nLen To 1 Step -1
        If Mid$(sFname, i, 1) = "\" Then Exit For
    Next i
    nStartName = i
    If nStartName = 0 Then nStartName = 1   'for safety

    For i = nLen To nStartName Step -1
        If Mid$(sFname, i, 1) = "." Then   'Is there a wrong suffix?
        sFname = Left$(sFname, i - 1)  'Remove suffix
        Exit For
        End If
    Next i

    'add suffix
    sFname = sFname & ".SNG"
    End If

    'Check if file exists and user wants to replace it
    If File_Delete(sFname) = False Then Exit Sub

    nLen = Len(sFname)
    For i = nLen To 1 Step -1
    If Mid$(sFname, i, 1) = "\" Then Exit For
    Next i

    sFilename = Right$(sFname, nLen - i)

    FNum = FreeFile
    Open sFname For Output As FNum

    Screen.MousePointer = HOURGLASS

    Write #FNum, nRecCounter
    If nRecCounter > 0 Then
    For i = 0 To nRecCounter - 1
        Write #FNum, aRecBuffer(i).TimeStamp, aRecBuffer(i).MidiData
    Next i
    End If

Save_Exit1:
    Close #FNum

Save_Exit2:
    Screen.MousePointer = DEFAULT
    Exit Sub

Save_Error_Handler:
    If Err = 64 Or Err = 20477 Then
    Call Dlg_Alert(sFname & Chr(10) & "Bad file name!")
    frmVBSeq.dlgFileDialog.Filename = "*.SNG"
    sFilename = "?"
    Resume Save_Exit2
    ElseIf Err = 32755 Then   'Cancel
    Resume Save_Exit2
    Else
    Call Dlg_Alert("Error #" & Err & Chr(10) & Error$)
    Resume Save_Exit1
    End If

End Sub

Function Get_Next& (lTime As Long)
    Dim lCount As Long

    Get_Next = -1&

    If nRecCounter = 0& Then Exit Function

    For lCount = 0& To nRecCounter - 1&
    If aRecBuffer(lCount).TimeStamp >= lTime Then
        Get_Next = lCount
        Exit For
    End If
    vntRet = DoEvents()
    Next lCount
End Function

Function KeytoNum (KeyCode As Integer) As Integer
    Select Case KeyCode
    Case Asc("0") To Asc("9")
        KeytoNum = KeyCode - Asc("0")
    Case KEY_NUMPAD0 To KEY_NUMPAD0 + 9
        KeytoNum = KeyCode - KEY_NUMPAD0
    Case Else
        KeytoNum = -1
    End Select
End Function

Function Label_Decrement% (lblLabel As Label, nMin As Integer, nOffset As Integer)
    Dim nValue As Integer, bFirst As Integer

    bMouseDown = True
    bFirst = True
    Do While bMouseDown = True
    nValue = Val(lblLabel.Caption)

    If nValue > nMin Then
        nValue = nValue - nOffset
        If nValue < nMin Then nValue = nMin
        lblLabel.Caption = CStr(nValue)
        lblLabel.Refresh
    End If

    If bFirst = True Then       'For key repeat purposes
        Wait_DoEvents (200)
        bFirst = False
    Else
        Wait_DoEvents (10)
    End If

    Loop
    Label_Decrement = nValue
End Function

Function Label_Increment% (lblLabel As Label, nMax As Integer, nOffset As Integer)
    Dim nValue As Integer, bFirst As Integer

    bMouseDown = True
    bFirst = True
    Do While bMouseDown = True
    nValue = Val(lblLabel)

    If nValue < nMax Then
        nValue = nValue + nOffset
        If nValue > nMax Then nValue = nMax
        lblLabel.Caption = CStr(nValue)
        lblLabel.Refresh
    End If

    If bFirst = True Then       'For key repeat purposes
        Wait_DoEvents (200)
        bFirst = False
    Else
        Wait_DoEvents (10)
    End If

    Loop
    Label_Increment = nValue
End Function

Sub Play_External ()
    Dim lPlayPointer    As Long
    Dim lNextTime       As Long
    Dim lNextData       As Long
    Dim nOldMtcFrames   As Long
    Dim bPlayError      As Integer

    'If already playing or recording -> do nothing
    If bStop = False Then Exit Sub

    'Change tracking buttons appearance to Play position.
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayDn.Picture
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set corresponding flags
    bRec = False
    bStop = False
    bPlay = True

    'reset play error flag
    bPlayError = False

    'Reset play variables to ready to start play values
    nNewMtc = 0            'new MTC not yet received
    nQfIdExpected = &H0    'first quarter frame message to be taked in account
    lPlayPointer = -1      'nothing to play yet

    'Set Mtc variables to out of sync values
    bInSync = False
    nMtcTotalframes = -1
    lMtcTime = -1
    nOldMtcFrames = -1

    Do While bStop = False
    If bInSync = False Then
        'Erase clock to indicate that we're out of sync
        Display_Erase
        nMtcTotalframes = -1
        lMtcTime = -1
        nOldMtcFrames = -1
    Else
        'Check if MTC has changed
        If nNewMtc > 0 Then
        'a new MTC could arrive while we're trying to resync
        'so make sure that we're in sync before exiting loop
        Do
            'resync as many times as necessary
            lPlayPointer = Get_Next(lMtcTime + 250)    '500 ms. preroll
            nNewMtc = nNewMtc - 1
            vntRet = DoEvents()    'to allow new MTC messages to be hooked
        Loop While nNewMtc > 0     'exit loop when we're in sync

        'Get_Next() function returns -1 if there's nothing to play, thus...
        If lPlayPointer >= 0 Then
            'parameters of next message to be played
            lNextTime = aRecBuffer(lPlayPointer).TimeStamp
            lNextData = aRecBuffer(lPlayPointer).MidiData
        End If
        End If

        'Play everything that should be played
        Do While lPlayPointer >= 0 And lMtcTime >= lNextTime
        If MidiOut_Msg(lNextData) = False Then
            'if a MIDI OUT error occurred -> stop playing
            bPlayError = True
            Exit Do
        End If

        'to allow new MTC messages to be hooked
        vntRet = DoEvents()

        'Increase array pointer
        lPlayPointer = lPlayPointer + 1
        If lPlayPointer >= nRecCounter Then
            'nothing else to be played
            lPlayPointer = -1
        Else
            'parameters of next message to be played
            lNextTime = aRecBuffer(lPlayPointer).TimeStamp
            lNextData = aRecBuffer(lPlayPointer).MidiData
        End If
        Loop

        'Can't continue
        If bPlayError = True Then Exit Do

        'Set new clock values if necessary
        If bVisualClock = True Then
        If nMtcTotalframes <> nOldMtcFrames Then
            'convert frame counter to clock values
            Call Mtc_Frames_to_HMSF(nMtcTotalframes, nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            'show new values
            Call Display_Show
            nOldMtcFrames = nMtcTotalframes
        End If
        End If
    End If

    'to allow Stop button to be pressed and new MTC messages to be hooked
    vntRet = DoEvents()
    Loop

    'In case visualize Clock was disabled set it to last received MTC time
    If nMtcTotalframes = -1 Then nMtcTotalframes = 0
    Call Mtc_Frames_to_HMSF(nMtcTotalframes, nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show

    'Change tracking buttons appearance back to Stop position
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set flags accordingly
    bStop = True
    bPlay = False
    bRec = False

End Sub

Sub Play_Internal ()
    Dim lSystemTime     As Long
    Dim lPlayingTime    As Long
    Dim fEllapsedTime   As Single
    Dim fLastQfTime     As Single
    Dim lPlayPointer    As Long
    Dim lNextTime       As Long
    Dim lNextData       As Long
    Dim nQfCounter      As Integer
    Dim lQfTotalCounter As Long
    Dim bPlayError      As Integer

    'If already playing or recording -> do nothing
    If bStop = False Then Exit Sub

    'Change tracking buttons appearance to Play position.
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayDn.Picture
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set corresponding flags
    bRec = False
    bStop = False
    bPlay = True

    'Check if Display Clock values are correct and show them.
    nDisplayHours = Val(frmVBSeq.lblHours)
    nDisplayMinutes = Val(frmVBSeq.lblMinutes)
    nDisplaySeconds = Val(frmVBSeq.lblSeconds)
    nDisplayFrames = Val(frmVBSeq.lblFrames)
    Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show

    'Assign Smpte internal counters to match Clock values.
    nHoursCounter = nDisplayHours
    nMinutesCounter = nDisplayMinutes
    nSecondsCounter = nDisplaySeconds
    nFramesCounter = nDisplayFrames

    'Initial Offset = Clock values at Start playing (in milliseconds)
    lOffsetTime = Mtc_HMSF_To_Ms(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)

    'Get next array index to be played
    lPlayPointer = Get_Next(lOffsetTime)   'if there's nothing to play returns -1
    If lPlayPointer >= 0 Then
    lNextTime = aRecBuffer(lPlayPointer).TimeStamp
    lNextData = aRecBuffer(lPlayPointer).MidiData
    End If

    'Reset Quarter frame counters
    nQfCounter = 0
    lQfTotalCounter = 0

    'Reset Play error flag
    bPlayError = False

    'Set timing variables
    lInitTime = timeGetTime()    'Actual high resolution system time in ms.
    fLastQfTime = lInitTime      'To calculate time ellapsed since last quarter frame

    Do While bStop = False
    'actual system time
    lSystemTime = timeGetTime()
    'actual playing time
    lPlayingTime = lOffsetTime + (lSystemTime - lInitTime)

    'Play everything that should be played
    Do While lPlayPointer >= 0 And lPlayingTime >= lNextTime
        If MidiOut_Msg(lNextData) = False Then
        'if a MIDI OUT error occurred -> stop playing
        bPlayError = True
        Exit Do
        End If

        'Increase array pointer
        lPlayPointer = lPlayPointer + 1
        If lPlayPointer >= nRecCounter Then
        'nothing else to be played
        lPlayPointer = -1
        Else
        'parameters of next message to be played
        lNextTime = aRecBuffer(lPlayPointer).TimeStamp
        lNextData = aRecBuffer(lPlayPointer).MidiData
        End If
    Loop

    'Can't continue
    If bPlayError = True Then Exit Do

    'A new quarter frame interval ellapsed?
    fEllapsedTime = CSng(lSystemTime) - fLastQfTime

    If fEllapsedTime >= fMsPerQF Then
        'Yes, send next MTC quarter frame message out (if requested)
        If bMtcOut = True Then
        If MidiOut_Mtc(nQfCounter, nHoursCounter, nMinutesCounter, nSecondsCounter, nFramesCounter) = False Then
            'if a MIDI OUT error occurred -> stop playing
            Exit Do
        End If
        End If

        'To start counting next quarter frame interval
        lQfTotalCounter = lQfTotalCounter + 1

        'Operation must be float to avoid rounding errors
        fLastQfTime = CSng(lInitTime) + fMsPerQF * CSng(lQfTotalCounter)

        'increase MTC out quarter frame counter
        nQfCounter = nQfCounter + 1
        If nQfCounter = 4 Then
        'One whole frame interval has ellapsed (4 quarter frames)
        'Thus increase Display Frame Counter (Clock) if necessary
        If bVisualClock = True Then
            nDisplayFrames = nDisplayFrames + 1
            'Check if parameters are correct and display new clock values
            Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            Call Display_Show
        End If
        ElseIf nQfCounter = 8 Then
        If bVisualClock = True Then
            'Another whole frame interval has elapsed (4 quarter frames more)
            'Actualize clock values as before
            nDisplayFrames = nDisplayFrames + 1
            Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            Call Display_Show
        End If

        'One complete MTC message takes 2 frames to be sent.
        'As MTC hours, minutes, seconds or frames can not be changed in the middle
        'of sending the MTC message, we must increase SMPTE Frame Counter
        'only every 2 Frames (after a whole MTC message is completed)
        nFramesCounter = nFramesCounter + 2
        'Check if parameters are correct
        Call Mtc_Adjust(nHoursCounter, nMinutesCounter, nSecondsCounter, nFramesCounter)
        'wrap around MTC out quarter frame counter
        nQfCounter = 0
        End If
    End If

    DoEvents   'allows bStop to be changed by pressing Stop button or Space key
    Loop

    'If visualize Clock was disabled set it to last MTC time
    If bVisualClock = False Then
    'Assign Clock values to match MTC internal counters.
    nDisplayHours = nHoursCounter
    nDisplayMinutes = nMinutesCounter
    nDisplaySeconds = nSecondsCounter
    nDisplayFrames = nFramesCounter

    'Check if Display Clock values are correct and show them.
    Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show
    End If


    'Change tracking buttons appearance back to Stop position
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set flags accordingly
    bStop = True
    bPlay = False
    bRec = False

End Sub

Sub Rec_External ()
    Dim nOldMtcFrames   As Long


    'Change tracking buttons appearance to Play position.
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayDn.Picture
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopUp.Picture

    'Set corresponding flags
    bRec = True
    bStop = False
    bPlay = False

    'Reset Recorded messages caption
    frmVBSeq.lblRecMesNum = "0"

    'Prepare Rec buffer array
    nRecCounter = 0
    Erase aRecBuffer

    'Reset rec variables to ready to start rec values
    nNewMtc = 0          'new MTC not yet received
    nQfIdExpected = &H0  'first quarter frame message identifier expected

    'Set Mtc variables to out of sync values
    bInSync = False
    nMtcTotalframes = -1
    lMtcTime = -1
    nOldMtcFrames = -1

    Do While bStop = False
    If bInSync = False Then
        'Erase clock to indicate that we're out of sync
        Display_Erase
        nMtcTotalframes = -1
        lMtcTime = -1
        nOldMtcFrames = -1
    Else
        If bVisualClock = True Then
        'Set new clock values if necessary
        If nMtcTotalframes <> nOldMtcFrames Then
            'convert frame counter to clock values
            Call Mtc_Frames_to_HMSF(nMtcTotalframes, nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            'show new values
            Call Display_Show
            nOldMtcFrames = nMtcTotalframes
        End If
        End If
    End If

    'to allow Stop button to be pressed and new MTC messages to be hooked
    vntRet = DoEvents()
    Loop

    'If Visualize Clock was disabled set it to last received MTC time
    If nMtcTotalframes = -1 Then nMtcTotalframes = 0
    Call Mtc_Frames_to_HMSF(nMtcTotalframes, nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show

    'Change tracking buttons appearance back to Stop position
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set flags accordingly
    bStop = True
    bPlay = False
    bRec = False

    'Display recorded messages counter
    frmVBSeq.lblRecMesNum = CStr(nRecCounter)

End Sub

Sub Rec_Internal ()
    Dim fEllapsedTime   As Long
    Dim fLastQfTime     As Long
    Dim nQfCounter      As Integer
    Dim lQfTotalCounter As Long
    Dim nHoursCounter   As Integer
    Dim nMinutesCounter As Integer
    Dim nSecondsCounter As Integer
    Dim nFramesCounter  As Integer


    'Change tracking buttons appearance to Rec position.
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayDn.Picture
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopUp.Picture

    'Set corresponding flags
    bRec = True
    bStop = False
    bPlay = False

    'Check if Display Clock values are correct and show them.
    nDisplayHours = Val(frmVBSeq.lblHours)
    nDisplayMinutes = Val(frmVBSeq.lblMinutes)
    nDisplaySeconds = Val(frmVBSeq.lblSeconds)
    Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show

    'Assign Smpte internal counters to match Clock values
    nHoursCounter = nDisplayHours
    nMinutesCounter = nDisplayMinutes
    nSecondsCounter = nDisplaySeconds
    nFramesCounter = nDisplayFrames

    'Reset Recorded messages caption
    frmVBSeq.lblRecMesNum = "0"

    'Prepare Rec buffer array
    nRecCounter = 0
    Erase aRecBuffer

    'Reset Quarter frame counters
    lQfTotalCounter = 0
    nQfCounter = 0

    'Set timing variables used by MidiHook to timestamp incoming Midi Data
    'Initial Offset = Display Clock values at Start playing (in milliseconds)
    lOffsetTime = Mtc_HMSF_To_Ms(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    'Actual system time in milliseconds
    lInitTime = timeGetTime()

    'system time at last quarter frame message
    fLastQfTime = lInitTime

    Do While bStop = False
    'time ellapsed since last quarter frame message
    fEllapsedTime = CSng(timeGetTime()) - fLastQfTime

    If fEllapsedTime >= fMsPerQF Then
        'A quarter frame time has elapsed
        'Send next MTC quarter frame message out
        If bMtcOut = True Then
        If MidiOut_Mtc(nQfCounter, nHoursCounter, nMinutesCounter, nSecondsCounter, nFramesCounter) = False Then
            'if a MIDI OUT error occurred -> stop playing
            Exit Do
        End If
        End If

        'To start counting next quarter frame interval
        lQfTotalCounter = lQfTotalCounter + 1

        'Operation must be float to avoid rounding errors
        fLastQfTime = CSng(lInitTime) + fMsPerQF * CSng(lQfTotalCounter)

        'increase MTC out quarter frame counter
        nQfCounter = nQfCounter + 1        'increase local quarter frame counter
        If nQfCounter = 4 Then
        If bVisualClock = True Then
            'One frame has elapsed (4 quarter frames)
            'Thus increase Display Frame Counter (Clock)
            nDisplayFrames = nDisplayFrames + 1
            Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            Call Display_Show
            vntRet = DoEvents()   'to allow Midi In Data to be hooked
        End If

        ElseIf nQfCounter = 8 Then
        If bVisualClock = True Then
            'Another frame has elapsed
            'Increase Display Frame Counter
            nDisplayFrames = nDisplayFrames + 1
            Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
            Call Display_Show
            vntRet = DoEvents()   'to allow Midi In Data to be hooked
        End If

        'One complete MTC message takes 2 frames to be sent.
        'As MTC hours, minutes, seconds or frames can not be changed in the middle
        'of sending the MTC message, we must increase SMPTE Frame Counter
        'only every 2 Frames (after a whole MTC message is completed)
        nFramesCounter = nFramesCounter + 2
        Call Mtc_Adjust(nHoursCounter, nMinutesCounter, nSecondsCounter, nFramesCounter)
        'wrap around MTC out quarter frame counter
        nQfCounter = 0
        End If
    End If

    vntRet = DoEvents()   'to allow Midi In Data to be hooked and trap Stop button click
    Loop

    'If Visualize Clock was disabled set it to last SMPTE time
    If bVisualClock = False Then
    'Assign Clock values to match Smpte internal counters.
    nDisplayHours = nHoursCounter
    nDisplayMinutes = nMinutesCounter
    nDisplaySeconds = nSecondsCounter
    nDisplayFrames = nFramesCounter + 1

    'Check if Display Clock values are correct and show them.
    Call Mtc_Adjust(nDisplayHours, nDisplayMinutes, nDisplaySeconds, nDisplayFrames)
    Call Display_Show
    End If

    'Change tracking buttons appearance back to Stop position
    frmVBSeq.cmdStop.Picture = frmVBSeq.cmdStopDn.Picture
    frmVBSeq.cmdPlay.Picture = frmVBSeq.cmdPlayUp.Picture
    frmVBSeq.cmdRec.Picture = frmVBSeq.cmdRecUp.Picture

    'Set flags accordingly
    bStop = True
    bPlay = False
    bRec = False

    'Display recorded messages counter
    frmVBSeq.lblRecMesNum = CStr(nRecCounter)

End Sub

Sub Wait_DoEvents (lDelay As Long)
    Dim lSystemTime As Long

    lSystemTime = timeGetTime()
    Do
    DoEvents
    Loop Until timeGetTime() - lSystemTime >= lDelay
End Sub