home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / tool / sound / vb_mid / midihook.frm < prev    next >
Text File  |  1995-02-05  |  16KB  |  332 lines
  1. VERSION 2.00
  2. Begin Form frmMidiHook 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Midi Hook"
  6.    ClientHeight    =   615
  7.    ClientLeft      =   645
  8.    ClientTop       =   7725
  9.    ClientWidth     =   2010
  10.    ControlBox      =   0   'False
  11.    Height          =   1020
  12.    Left            =   585
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   615
  17.    ScaleWidth      =   2010
  18.    Top             =   7380
  19.    Width           =   2130
  20.    Begin MsgHook MidiHook 
  21.       Left            =   690
  22.       Top             =   120
  23.    End
  24. End
  25. Option Explicit
  26.  
  27. Dim iLoNibble As Integer
  28. Dim iHiNibble As Integer
  29.  
  30. Dim iMtcHours As Integer
  31. Dim iMtcMinutes As Integer
  32. Dim iMtcSeconds As Integer
  33. Dim iMtcFrames  As Integer
  34.  
  35. Sub MidiHook_Message (iMsg As Integer, iRet1 As Integer, lMidiMessage As Long, iRet2 As Integer, lRet3 As Long)
  36.  Dim iMidiStatus As Integer
  37.     Dim iMidiData1 As Integer
  38.     Dim iMidiData2 As Integer
  39.     Dim iMtcData As Integer
  40.     Dim lTotalFrames As Long
  41.  
  42.     'The code inside this Procedure must be selfcontained
  43.     'without calling any other Procedure or DoEvents or Refresh...
  44.     '
  45.     'The whole Procedure execution should not take longer than 8ms.
  46.     '
  47.     'This version seems very long but the program
  48.     'actually only executes a few lines of it
  49.     'based on the Ifs.. and Select Cases... decissions
  50.  
  51.     If iMsg <> MIM_DATA Then Exit Sub    'just for safety
  52.     
  53.     'Unpack lMidiMessage
  54.     iMidiStatus = lMidiMessage And &HFF&            'First byte
  55.     iMidiData1 = (lMidiMessage And &HFF00&) / 256   'Second byte
  56.     iMidiData2 = (lMidiMessage And &HFF0000) / 65536'Third byte
  57.  
  58.     'Filter RealTime Midi Messages except MTC
  59.     If iMidiStatus >= &HF0 And iMidiStatus <> MTC_QFRAME Then Exit Sub
  60.     
  61.     'Filter here any other Status if necessary.
  62.     '(i.e. PITCH_BEND, CHANNEL_PRESSURE, POLY_KEY_PRESS, etc.)
  63.  
  64.     If iMidiStatus = MTC_QFRAME Then    'Hooked message is a MTC quarter frame message
  65.  
  66.  
  67.        'You may show here a screen representation of MTC In.
  68.  
  69.        '********************************************
  70.        'SPECIFIC TO THIS APPLICATION
  71.         If bVisualMtc = True Then
  72.             If frmVBSeq.picMtcIn.BackColor = LED_OFF Then  'If MTC In led is off
  73.                 frmVBSeq.picMtcIn.BackColor = LED_ON       'Switch MTC In led on
  74.             End If
  75.             lMtcInTime = timeGetTime()   'Save current system time for switch off calculations
  76.         End If
  77.        '********************************************
  78.  
  79.  
  80.         If bMTCThru = True Then         'Global Flag
  81.             If hMidiOut <> NO_HANDLE Then    'If iOutDevice Opened...
  82.                 vntRet = midiOutShortMsg(hMidiOut, lMidiMessage)   'send it out
  83.  
  84.  
  85.                'You may show here a screen representation of MTC Out.
  86.  
  87.                '**********************************************
  88.                'SPECIFIC TO THIS APPLICATION
  89.                 If bVisualMtc = True Then
  90.                     If frmVBSeq.picMtcOut.BackColor = LED_OFF Then  'If MTC Out led is off
  91.                         frmVBSeq.picMtcOut.BackColor = LED_ON       'Switch MTC Out led on
  92.                     End If
  93.                     lMtcOutTime = timeGetTime()  'Save current system time for switch off calculations
  94.                 End If
  95.                '**********************************************
  96.  
  97.             End If
  98.         End If
  99.  
  100.         'We're only interested in decoding MTC while we are in external sync
  101.         If nSyncMode = SYNC_EXTERNAL Then
  102.             'MTC Data=Second Byte of lMidiMessage
  103.             iMtcData = iMidiData1
  104.  
  105.             'Quarter Frame Message Identifier=hiNibble of iMtcData
  106.             Select Case (iMtcData And &HF0)
  107.  
  108.                 Case &H0:       'Quarter Frame Message indicating Frames loNibble
  109.                     If nQfIdExpected <> &H0 Then   'Discontinous MTC
  110.                         bInSync = False            'Out of sync
  111.                         nQfIdExpected = &H0        'start over
  112.                     Else
  113.                         'Frames loNibble=loNibble of iMtcData
  114.                         iLoNibble = (iMtcData And &HF)
  115.                         'If we're in sync, increase Time Counter (milliseconds per quarter frame)
  116.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  117.                         nQfIdExpected = &H10    'Expected next Quarter Frame Message
  118.                     End If
  119.     
  120.                 Case &H10:        'Quarter Frame Message indicating Frames hiNibble
  121.                     If nQfIdExpected <> &H10 Then   'Discontinous MTC
  122.                         bInSync = False             'Out of sync
  123.                         nQfIdExpected = &H0         'start over
  124.                     Else
  125.                         'Frames hiNibble=Bit 0 of iMtcData
  126.                         iHiNibble = (iMtcData And &H1)
  127.                         iMtcFrames = (iHiNibble * 16) + iLoNibble   'Pack Frame Number
  128.                         'If we're in sync, increase Time Counter
  129.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  130.                         nQfIdExpected = &H20     'Expected next Quarter Frame Message
  131.                     End If
  132.     
  133.                 Case &H20:          'Quarter Frame Message indicating seconds loNibble
  134.                     If nQfIdExpected <> &H20 Then   'Discontinous MTC -> resync
  135.                         bInSync = False             'Out of sync
  136.                         nQfIdExpected = &H0         'start over
  137.                     Else
  138.                         'Seconds LoNibble=LoNibble of iMtcData
  139.                         iLoNibble = (iMtcData And &HF)
  140.                         'If we're in sync, increase Time Counter
  141.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  142.                         nQfIdExpected = &H30    'Expected next Quarter Frame Message
  143.                     End If
  144.     
  145.                 Case &H30:          'Quarter Frame Message indicating seconds hiNibble
  146.                     If nQfIdExpected <> &H30 Then     'Discontinous MTC -> resync
  147.                         bInSync = False               'Out of sync
  148.                         nQfIdExpected = &H0           'start over
  149.                     Else
  150.                         'Seconds HiNibble=bits 0 & 1 of iMtcData
  151.                         iHiNibble = (iMtcData And &H3)
  152.                         iMtcSeconds = (iHiNibble * 16) + iLoNibble  'pack Seconds Number
  153.                         'If we're in sync...
  154.                         If bInSync = True Then
  155.                             'increase Time Counter
  156.                             lMtcTime = lMtcTime + fMsPerQF
  157.                             '4th quarter frame->Increase Frame Counter
  158.                             nMtcTotalFrames = nMtcTotalFrames + 1
  159.                         End If
  160.                         nQfIdExpected = &H40    'Expected next Quarter Frame Message
  161.                     End If
  162.     
  163.                 Case &H40:           'Quarter Frame Message indicating Minutes iLoNibble
  164.                     If nQfIdExpected <> &H40 Then      'Discontinous MTC -> resync
  165.                         bInSync = False                'Out of sync
  166.                         nQfIdExpected = &H0            'start over
  167.                     Else
  168.                         'Minutes LoNibble=LoNibble of iMtcData
  169.                         iLoNibble = (iMtcData And &HF)
  170.                         'If we're in sync, increase Time Counter
  171.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  172.                         nQfIdExpected = &H50    'Expected next Quarter Frame Message
  173.                     End If
  174.     
  175.                 Case &H50:           'Quarter Frame Message indicating Minutes hiNibble
  176.                     If nQfIdExpected <> &H50 Then        'Discontinous MTC -> resync
  177.                         bInSync = False                  'Out of sync
  178.                         nQfIdExpected = &H0              'start over
  179.                     Else
  180.                         'Minutes HiNibble=Bits 0 & 1 of iMtcData
  181.                         iHiNibble = (iMtcData And &H3)
  182.                         iMtcMinutes = (iHiNibble * 16) + iLoNibble  'pack Minutes Number
  183.                         'If we're in sync, increase Time Counter
  184.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  185.                         nQfIdExpected = &H60             'Expected next Quarter Frame Message
  186.                     End If
  187.     
  188.                 Case &H60:            'Quarter Frame Message indicating Hours loNibble
  189.                     If nQfIdExpected <> &H60 Then       'Discontinous MTC -> resync
  190.                         bInSync = False                 'Out of sync
  191.                         nQfIdExpected = &H0             'start over
  192.                     Else
  193.                         iLoNibble = (iMtcData And &HF)  'Hours iLoNibble
  194.                         'If we're in sync, increase Time Counter
  195.                         If bInSync = True Then lMtcTime = lMtcTime + fMsPerQF
  196.                         nQfIdExpected = &H70            'Expected next Quarter Frame Message
  197.                     End If
  198.     
  199.                 Case &H70:           'Quarter Frame Message indicating Hours hiNibble
  200.                     If nQfIdExpected <> &H70 Then       'Discontinous MTC -> resync
  201.                         bInSync = False                 'Out of sync
  202.                         nQfIdExpected = &H0             'start over
  203.                     Else
  204.                         'Hours HiNibble=Bit 0 of iMtcData
  205.                         iHiNibble = (iMtcData And &H1)
  206.                         iMtcHours = (iHiNibble * 16) + iLoNibble  'pack Hours Number
  207.  
  208.                         'Set bDebug = True to test arriving MTC in Debug Window
  209.                         'Only works in Visual Basic environement
  210.                         If bDebug = True Then
  211.                             Debug.Print iMtcHours; ":"; iMtcMinutes; ":";
  212.                             Debug.Print iMtcSeconds; ":"; iMtcFrames
  213.                         End If
  214.  
  215.                         'nMtcMode is packed in Bits 1 & 2 of iMtcData
  216.                         'Test if received MTC is in the expected frame mode
  217.                         If (iMtcData And &H6) / 2 <> nMtcMode Then
  218.                             bMtcModeError = True   'poll this flag if necessary
  219.                             bInSync = False        'Out of sync
  220.                             nQfIdExpected = &H0    'start over
  221.                             Exit Sub
  222.                         End If
  223.  
  224.                         'We are two frames late because we've spent 8 Quarter Frames (2 Frames)
  225.                         'to read and pack a complete MTC message, thus...
  226.                         iMtcFrames = iMtcFrames + 2
  227.  
  228.                         If bInSync = True Then
  229.                             'Is new MTC message continuous with the previous one?
  230.                             lTotalFrames = nFramesPerSecond * (iMtcHours * 3600& + iMtcMinutes * 60& + iMtcSeconds) + iMtcFrames
  231.                             If lTotalFrames - nMtcTotalFrames <> 1 Then
  232.                                 'Wrap from 23:59:59:24 to 00:00:00:00 not implemented!
  233.                                 'Dropped frames in 30 f/s drop frame mode also not implemented
  234.                                 bInSync = False   'Discontinous MTC -> Out of sync
  235.                                 nQfIdExpected = &H0 'start over
  236.                             Else
  237.                                 'Actualize Time Counter
  238.                                 lMtcTime = CLng(CSng(lTotalFrames) * fMsPerFrame)
  239.                                 '8th Quarter Frame Message->Increase Frame Counter
  240.                                 nMtcTotalFrames = nMtcTotalFrames + 1
  241.                             End If
  242.                         Else
  243.                             'We were out of sync but...
  244.                             'a new complete valid MTC message has been received !!
  245.                             nNewMTC = nNewMTC + 1   'Increase New MTC counter
  246.                             'Calculate new Frame Counter (long integer operation).
  247.                             nMtcTotalFrames = (iMtcHours * 3600& + iMtcMinutes * 60& + iMtcSeconds) * nFramesPerSecond + iMtcFrames
  248.                             'Calculate new milliseconds Time Counter (float operation).
  249.                             lMtcTime = CLng(CSng(nMtcTotalFrames) * fMsPerFrame)
  250.                             'Now we are in sync
  251.                             bInSync = True
  252.                         End If
  253.                         nQfIdExpected = &H0    'ID of expected next Quarter Frame Message
  254.                     End If
  255.             End Select
  256.         End If
  257.  
  258.     Else   'Received Midi Message is Midi Data  (not MTC)
  259.  
  260.        'You may show here a screen representation of MidiData In.
  261.  
  262.        '*********************************************
  263.        'SPECIFIC TO THIS APPLICATION
  264.         If bVisualData = True Then
  265.             If frmVBSeq.picDataIn.BackColor = LED_OFF Then
  266.                 frmVBSeq.picDataIn.BackColor = LED_ON
  267.             End If
  268.             lDataInTime = timeGetTime()
  269.         End If
  270.        '*********************************************
  271.  
  272.         If bMidiThru = True Then            'Global Flag
  273.             If hMidiOut <> NO_HANDLE Then
  274.                 vntRet = midiOutShortMsg(hMidiOut, lMidiMessage)   'send it out
  275.  
  276.                'You may show here a screen representation of Midi Data Out.
  277.  
  278.                '*********************************************
  279.                'SPECIFIC TO THIS APPLICATION
  280.                 If bVisualData = True Then
  281.                     If frmVBSeq.picDataOut.BackColor = LED_OFF Then
  282.                         frmVBSeq.picDataOut.BackColor = LED_ON
  283.                     End If
  284.                     lDataOutTime = timeGetTime()
  285.                 End If
  286.                '**********************************************
  287.  
  288.             End If
  289.         End If
  290.  
  291.  
  292.         'Here you may save the Midi Data just received (or do whatever with it...)
  293.  
  294.        '***********************************************************************************
  295.         'SPECIFIC TO THIS APPLICATION
  296.  
  297.         'Save Midi Data only if we are in recording mode
  298.         If bRec = True Then
  299.             'Increase RecBuffer Size 1K if needed
  300.             If (nRecCounter Mod 1024) = 0 Then
  301.                 ReDim Preserve aRecBuffer(nRecCounter + 1024)
  302.             End If
  303.  
  304.             If nSyncMode = SYNC_INTERNAL Then
  305.                 'Save packed Midi Message
  306.                 aRecBuffer(nRecCounter).MidiData = lMidiMessage
  307.                 'Time = Initial Offset + milliseconds ellapsed since Start Recording
  308.                 aRecBuffer(nRecCounter).TimeStamp = lOffsetTime + (timeGetTime() - lInitTime)
  309.                 'increase recorded messages counter
  310.                 nRecCounter = nRecCounter + 1
  311.             Else    'external sync
  312.                 'save only if we're in sync with MTC
  313.                 If bInSync = True Then
  314.                     aRecBuffer(nRecCounter).MidiData = lMidiMessage
  315.                     'Time=current MTC time in milliseconds
  316.                     aRecBuffer(nRecCounter).TimeStamp = lMtcTime
  317.                     nRecCounter = nRecCounter + 1
  318.                 Else
  319.                     'An incoming Midi Data message is lost
  320.                     'because it was received while we were out of sync
  321.                     nRecErrors = nRecErrors + 1
  322.                     'You may inform the user, but not in this procedure!!!!
  323.                 End If
  324.             End If
  325.         End If
  326.        '**************************************************************************************
  327.     
  328.     End If
  329.  
  330. End Sub
  331.  
  332.