Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmidi / midihook.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-02-04 | 15.6 KB | 284 lines

VERSION 2.00 Begin Form frmMidiHook BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "Midi Hook" ClientHeight = 615 ClientLeft = 645 ClientTop = 7725 ClientWidth = 2010 ControlBox = 0 'False Height = 1020 Left = 585 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 615 ScaleWidth = 2010 Top = 7380 Width = 2130 Begin MsgHook MidiHook Left = 690 Top = 120 End Option Explicit Dim iLoNibble As Integer Dim iHiNibble As Integer Dim iMtcHours As Integer Dim iMtcMinutes As Integer Dim iMtcSeconds As Integer Dim iMtcFrames As Integer Sub MidiHook_Message (iMsg As Integer, iRet1 As Integer, lMidiMessage As Long, iRet2 As Integer, lRet3 As Long) Dim iMidiStatus As Integer Dim iMidiData1 As Integer Dim iMidiData2 As Integer Dim iMtcData As Integer Dim lTotalFrames As Long 'The code inside this Procedure must be selfcontained 'without calling any other Procedure or DoEvents or Refresh... ' 'The whole Procedure execution should not take longer than 8ms. ' 'This version seems very long but the program 'actually only executes a few lines of it 'based on the Ifs.. and Select Cases... decissions If iMsg <> MIM_DATA Then Exit Sub 'just for safety 'Unpack lMidiMessage iMidiStatus = lMidiMessage And &HFF& 'First byte iMidiData1 = (lMidiMessage And &HFF00&) / 256 'Second byte iMidiData2 = (lMidiMessage And &HFF0000) / 65536'Third byte 'Filter RealTime Midi Messages except MTC If iMidiStatus >= &HF0 And iMidiStatus <> MTC_QFRAME Then Exit Sub 'Filter here any other Status if necessary. '(i.e. PITCH_BEND, CHANNEL_PRESSURE, POLY_KEY_PRESS, etc.) If iMidiStatus = MTC_QFRAME Then 'Hooked message is a MTC quarter frame message 'You may show here a screen representation of MTC In. '******************************************** 'SPECIFIC TO THIS APPLICATION If bVisualMtc = True Then If frmVBSeq.picMtcIn.BackColor = LED_OFF Then 'If MTC In led is off frmVBSeq.picMtcIn.BackColor = LED_ON 'Switch MTC In led on End If lMtcInTime = timeGetTime() 'Save current system time for switch off calculations End If '******************************************** If bMTCThru = True Then 'Global Flag If hMidiOut <> NO_HANDLE Then 'If iOutDevice Opened... vntRet = midiOutShortMsg(hMidiOut, lMidiMessage) 'send it out 'You may show here a screen representation of MTC Out. '********************************************** 'SPECIFIC TO THIS APPLICATION If bVisualMtc = True Then If frmVBSeq.picMtcOut.BackColor = LED_OFF Then 'If MTC Out led is off frmVBSeq.picMtcOut.BackColor = LED_ON 'Switch MTC Out led on End If lMtcOutTime = timeGetTime() 'Save current system time for switch off calculations End If '********************************************** End If End If 'We're only interested in decoding MTC while we are in external sync If nSyncMode = SYNC_EXTERNAL Then 'MTC Data=Second Byte of lMidiMessage iMtcData = iMidiData1 'Quarter Frame Message Identifier=hiNibble of iMtcData Select Case (iMtcData And &HF0) Case &H0: 'Quarter Frame Message indicating Frames loNibble If nQfIdExpected <> &H0 Then 'Discontinous MTC bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Frames loNibble=loNibble of iMtcData iLoNibble = (iMtcData And &HF) 'If we're in sync, increase Time Counter (milliseconds per quarter frame) If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H10 'Expected next Quarter Frame Message End If Case &H10: 'Quarter Frame Message indicating Frames hiNibble If nQfIdExpected <> &H10 Then 'Discontinous MTC bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Frames hiNibble=Bit 0 of iMtcData iHiNibble = (iMtcData And &H1) iMtcFrames = (iHiNibble * 16) + iLoNibble 'Pack Frame Number 'If we're in sync, increase Time Counter If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H20 'Expected next Quarter Frame Message End If Case &H20: 'Quarter Frame Message indicating seconds loNibble If nQfIdExpected <> &H20 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Seconds LoNibble=LoNibble of iMtcData iLoNibble = (iMtcData And &HF) 'If we're in sync, increase Time Counter If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H30 'Expected next Quarter Frame Message End If Case &H30: 'Quarter Frame Message indicating seconds hiNibble If nQfIdExpected <> &H30 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Seconds HiNibble=bits 0 & 1 of iMtcData iHiNibble = (iMtcData And &H3) iMtcSeconds = (iHiNibble * 16) + iLoNibble 'pack Seconds Number 'If we're in sync... If bInSync = True Then 'increase Time Counter lMtcTime = lMtcTime + fMsPerQF '4th quarter frame->Increase Frame Counter nMtcTotalFrames = nMtcTotalFrames + 1 End If nQfIdExpected = &H40 'Expected next Quarter Frame Message End If Case &H40: 'Quarter Frame Message indicating Minutes iLoNibble If nQfIdExpected <> &H40 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Minutes LoNibble=LoNibble of iMtcData iLoNibble = (iMtcData And &HF) 'If we're in sync, increase Time Counter If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H50 'Expected next Quarter Frame Message End If Case &H50: 'Quarter Frame Message indicating Minutes hiNibble If nQfIdExpected <> &H50 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Minutes HiNibble=Bits 0 & 1 of iMtcData iHiNibble = (iMtcData And &H3) iMtcMinutes = (iHiNibble * 16) + iLoNibble 'pack Minutes Number 'If we're in sync, increase Time Counter If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H60 'Expected next Quarter Frame Message End If Case &H60: 'Quarter Frame Message indicating Hours loNibble If nQfIdExpected <> &H60 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else iLoNibble = (iMtcData And &HF) 'Hours iLoNibble 'If we're in sync, increase Time Counter If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF nQfIdExpected = &H70 'Expected next Quarter Frame Message End If Case &H70: 'Quarter Frame Message indicating Hours hiNibble If nQfIdExpected <> &H70 Then 'Discontinous MTC -> resync bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Else 'Hours HiNibble=Bit 0 of iMtcData iHiNibble = (iMtcData And &H1) iMtcHours = (iHiNibble * 16) + iLoNibble 'pack Hours Number 'Set bDebug = True to test arriving MTC in Debug Window 'Only works in Visual Basic environement If bDebug = True Then Debug.Print iMtcHours; ":"; iMtcMinutes; ":"; Debug.Print iMtcSeconds; ":"; iMtcFrames End If 'nMtcMode is packed in Bits 1 & 2 of iMtcData 'Test if received MTC is in the expected frame mode If (iMtcData And &H6) / 2 <> nMtcMode Then bMtcModeError = True 'poll this flag if necessary bInSync = False 'Out of sync nQfIdExpected = &H0 'start over Exit Sub End If 'We are two frames late because we've spent 8 Quarter Frames (2 Frames) 'to read and pack a complete MTC message, thus... iMtcFrames = iMtcFrames + 2 If bInSync = True Then 'Is new MTC message continuous with the previous one? lTotalFrames = nFramesPerSecond * (iMtcHours * 3600& + iMtcMinutes * 60& + iMtcSeconds) + iMtcFrames If lTotalFrames - nMtcTotalFrames <> 1 Then 'Wrap from 23:59:59:24 to 00:00:00:00 not implemented! 'Dropped frames in 30 f/s drop frame mode also not implemented bInSync = False 'Discontinous MTC -> Out of sync nQfIdExpected = &H0 'start over Else 'Actualize Time Counter lMtcTime = CLng(CSng(lTotalFrames) * fMsPerFrame) '8th Quarter Frame Message->Increase Frame Counter nMtcTotalFrames = nMtcTotalFrames + 1 End If Else 'We were out of sync but... 'a new complete valid MTC message has been received !! nNewMTC = nNewMTC + 1 'Increase New MTC counter 'Calculate new Frame Counter (long integer operation). nMtcTotalFrames = (iMtcHours * 3600& + iMtcMinutes * 60& + iMtcSeconds) * nFramesPerSecond + iMtcFrames 'Calculate new milliseconds Time Counter (float operation). lMtcTime = CLng(CSng(nMtcTotalFrames) * fMsPerFrame) 'Now we are in sync bInSync = True End If nQfIdExpected = &H0 'ID of expected next Quarter Frame Message End If End Select End If Else 'Received Midi Message is Midi Data (not MTC) 'You may show here a screen representation of MidiData In. '********************************************* 'SPECIFIC TO THIS APPLICATION If bVisualData = True Then If frmVBSeq.picDataIn.BackColor = LED_OFF Then frmVBSeq.picDataIn.BackColor = LED_ON End If lDataInTime = timeGetTime() End If '********************************************* If bMidiThru = True Then 'Global Flag If hMidiOut <> NO_HANDLE Then vntRet = midiOutShortMsg(hMidiOut, lMidiMessage) 'send it out 'You may show here a screen representation of Midi Data Out. '********************************************* 'SPECIFIC TO THIS APPLICATION If bVisualData = True Then If frmVBSeq.picDataOut.BackColor = LED_OFF Then frmVBSeq.picDataOut.BackColor = LED_ON End If lDataOutTime = timeGetTime() End If '********************************************** End If End If 'Here you may save the Midi Data just received (or do whatever with it...) '*********************************************************************************** 'SPECIFIC TO THIS APPLICATION 'Save Midi Data only if we are in recording mode If bRec = True Then 'Increase RecBuffer Size 1K if needed If (nRecCounter Mod 1024) = 0 Then ReDim Preserve aRecBuffer(nRecCounter + 1024) End If If nSyncMode = SYNC_INTERNAL Then 'Save packed Midi Message aRecBuffer(nRecCounter).MidiData = lMidiMessage 'Time = Initial Offset + milliseconds ellapsed since Start Recording aRecBuffer(nRecCounter).TimeStamp = lOffsetTime + (timeGetTime() - lInitTime) 'increase recorded messages counter nRecCounter = nRecCounter + 1 Else 'external sync 'save only if we're in sync with MTC If bInSync = True Then aRecBuffer(nRecCounter).MidiData = lMidiMessage 'Time=current MTC time in milliseconds aRecBuffer(nRecCounter).TimeStamp = lMtcTime nRecCounter = nRecCounter + 1 Else 'An incoming Midi Data message is lost 'because it was received while we were out of sync nRecErrors = nRecErrors + 1 'You may inform the user, but not in this procedure!!!! End If End If End If '************************************************************************************** End If End Sub