home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / tool / sound / vb_mid / vb_midi.bas < prev    next >
BASIC Source File  |  1995-02-05  |  27KB  |  746 lines
  1. Option Explicit
  2.  
  3. 'Midi Device Handles
  4. Global hMidiIn As Integer
  5. Global hMidiOut As Integer
  6. Global Const NO_HANDLE = -1  'Device not enabled
  7.  
  8. 'Number of Midi Devices
  9. Global nInDevices As Integer  'Number of total available Midi In Devices
  10. Global nOutDevices As Integer 'Number of total available Midi Out Devices
  11.  
  12. 'MTC sync variables
  13. Global nQfIdExpected As Integer 'Must be set to &H0 to start reading MTC
  14. Global bInSync As Integer       'Indicates MTC is beeing correctly received
  15. Global nNewMtc As Integer       'Number of new different MTC messages arrived (to resync)
  16.  
  17. 'MTC timing variables
  18. Global nFramesPerSecond As Integer  '24,25,30
  19. Global nMtcMode As Integer     '0=24, 1=25, 2=30 drop frame, 3=30 no drop
  20. Global fMsPerQF As Single      'Ms. per Quarter Frame (250/nFramesPerSecond)
  21. Global fMsPerFrame As Single   'Ms. per Frame (1000/nFramesPerSecond)
  22. Global nMtcTotalFrames As Long 'Current MTC Time in Frames.
  23. Global lMtcTime As Long        'Current MTC Time in Milliseconds
  24.  
  25. 'Global flags (set in Options Menu or similar)
  26. Global bMidiThru As Integer    'Send all Midi In messages to Midi Out
  27. Global bMTCThru As Integer     'Send all MTC In messages to Midi Out
  28. Global bMTCOut As Integer      'While Play or Rec in internal mode, send MTC to Midi Out
  29. Global bMtcModeError As Integer'Indicates that received MTC frame mode is not correct
  30. Global bDebug As Integer       'If true, print received MTC in debug window
  31.  
  32. 'Sync mode variable and constants
  33. Global nSyncMode As Integer    'Internal=System Time / External=MTC
  34. Global Const SYNC_INTERNAL = 0
  35. Global Const SYNC_EXTERNAL = 1
  36.   
  37. 'return value from API Functions
  38. Global vntRet As Variant
  39.  
  40.  
  41. 'Standard Midi Files variables
  42. 'Parameters saved in first track of Standard Midi Files
  43. Global fTicksPerBeat As Single   'ticks per beat
  44. Global fTempo As Single          'microseconds per beat
  45. 'Timing calculation variables
  46. Global fMsPerTick As Single   'milliseconds per tick
  47. Global fTicksPerMs As Single  'ticks per millisecond
  48.  
  49. 'To calculate real time in Standard Midi Files
  50. '   fMsPerTick = (fTempo / 1000) / fTicksPerBeat
  51. '   fTicksPerMs = (fTicksPerBeat / fTempo) * 1000
  52.  
  53.  
  54.  
  55. 'MIDI CONSTANTS
  56.  
  57. 'Channel messages Status (Midi channel [0...15] must be added)
  58. Global Const NOTE_OFF = &H80
  59. Global Const NOTE_ON = &H90
  60. Global Const POLY_KEY_PRESS = &HA0
  61. Global Const CONTROLLER_CHANGE = &HB0
  62. Global Const PROGRAM_CHANGE = &HC0
  63. Global Const CHANNEL_PRESSURE = &HD0
  64. Global Const PITCH_BEND = &HE0
  65.  
  66.  
  67. 'Controller Number (Byte following CONTROLLER_CHANGE Status)
  68. Global Const MOD_WHEEL = 1
  69. Global Const BREATH_CONTROLLER = 2
  70. Global Const FOOT_CONTROLLER = 4
  71. Global Const PORTAMENTO_TIME = 5
  72. Global Const MAIN_VOLUME = 7
  73. Global Const BALANCE = 8
  74. Global Const PAN = 10
  75. Global Const EXPRESS_CONTROLLER = 11
  76. Global Const DAMPER_PEDAL = 64
  77. Global Const PORTAMENTO = 65
  78. Global Const SOSTENUTO = 66
  79. Global Const SOFT_PEDAL = 67
  80. Global Const HOLD_2 = 69
  81. Global Const EXTERNAL_FX_DEPTH = 91
  82. Global Const TREMELO_DEPTH = 92
  83. Global Const CHORUS_DEPTH = 93
  84. Global Const DETUNE_DEPTH = 94
  85. Global Const PHASER_DEPTH = 95
  86. Global Const DATA_INCREMENT = 96
  87. Global Const DATA_DECREMENT = 97
  88.  
  89.  
  90. 'Channel independent Status  (MIDI channel is irrelevant)
  91. Global Const SYSEX = &HF0          'System exclusive block Status
  92. Global Const MTC_QFRAME = &HF1     'MTC Quarter Frame Message Status
  93. Global Const EOX = &HF7            'End of System exclusive block
  94. Global Const MIDI_CLOCK = &HF8     'Midi sync clock
  95. Global Const MIDI_START = &HFA     'Start playing
  96. Global Const MIDI_CONTINUE = &HFB  'Continue playng after stop
  97. Global Const MIDI_STOP = &HFC      'Stop playing
  98. Global Const ACTIVE_SENSE = &HFE   'Some devices send this byte to indicate they're on
  99.  
  100.  
  101. 'SYSTEM Errors
  102. Global Const MMSYSERR_BASE = 0                           ' first error number
  103. Global Const MMSYSERR_NOERROR = (MMSYSERR_BASE + 0)      ' no error
  104. Global Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)        ' unspecified error
  105. Global Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)  ' bad device ID
  106. Global Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)   ' device not enabled
  107. Global Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)    ' device already allocated
  108. Global Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)  ' invalid device handle
  109. Global Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)     ' no driver
  110. Global Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)        ' out of memory
  111. Global Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8) ' function not supported
  112. Global Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)    ' bad error num (out of range)
  113. Global Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)   ' invalid flag
  114. Global Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)  ' invalid parameter
  115. Global Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 11)   ' last error number
  116.  
  117.  
  118. 'MIDI Errors
  119. Global Const MIDIERR_BASE = 64                           ' first error number
  120. Global Const MIDIERR_UNPREPARED = (MIDIERR_BASE + 0)     ' header unprepared
  121. Global Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1)   ' still playing
  122. Global Const MIDIERR_NOMAP = (MIDIERR_BASE + 2)          ' no MIDI mapper
  123. Global Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3)       ' hardware busy
  124. Global Const MIDIERR_NODEVICE = (MIDIERR_BASE + 4)       ' device not present
  125. Global Const MIDIERR_INVALIDSETUP = (MIDIERR_BASE + 5)   ' invalid setup
  126. Global Const MIDIERR_LASTERROR = (MIDIERR_BASE + 5)      ' last error number
  127.  
  128.  
  129. 'Possible hooked MIDI Messages
  130.  
  131. 'MIDI Input Messages
  132. Global Const MIM_OPEN = &H3C1
  133. Global Const MIM_CLOSE = &H3C2
  134. Global Const MIM_DATA = &H3C3    'that's what we're interested in!
  135. Global Const MIM_LONGDATA = &H3C4
  136. Global Const MIM_ERROR = &H3C5
  137. Global Const MIM_LONGERROR = &H3C6
  138.  
  139. 'MIDI Output Messages
  140. Global Const MOM_OPEN = &H3C7
  141. Global Const MOM_CLOSE = &H3C8
  142. Global Const MOM_DONE = &H3C9
  143.  
  144.  
  145. 'SEVERAL MIDI FLAGS, IDS, CONSTANTS, ETC...
  146.  
  147. 'MIDI Mapper device ID
  148. Global Const MIDIMAPPER = (-1)
  149. Global Const MIDI_MAPPER = (-1)
  150.  
  151.  
  152. 'flags for wFlags in midiOutCachePatches(), midiOutCacheDrumPatches()
  153. Global Const MIDI_CACHE_ALL = 1
  154. Global Const MIDI_CACHE_BESTFIT = 2
  155. Global Const MIDI_CACHE_QUERY = 3
  156. Global Const MIDI_UNCACHE = 4
  157.  
  158.  
  159. 'flags used in midiInOpen() and midiOutOpen() to specify dwCallback type.
  160. Global Const CALLBACK_TYPEMASK = &H70000         ' mask type
  161. Global Const CALLBACK_NULL = &H0&                ' no callback
  162. Global Const CALLBACK_WINDOW = &H10000           ' dwCallback is HWND (window)
  163. Global Const CALLBACK_TASK = &H20000             ' dwCallback is HTASK (task)
  164. Global Const CALLBACK_FUNCTION = &H30000         ' dwCallback is FARPROC (function)
  165.  
  166.  
  167. 'IDs used in MIDIOUTCAPS, MIDIINCAPS
  168.  
  169. 'Manufacturer IDs (wMid)
  170. Global Const MM_MICROSOFT = 1                 ' Microsoft Corp.
  171.  
  172. 'Product IDs  (wPid)
  173. Global Const MM_MIDI_MAPPER = 1               ' MIDI Mapper
  174. Global Const MM_WAVE_MAPPER = 2               ' Wave Mapper
  175. Global Const MM_SNDBLST_MIDIOUT = 3           ' Sound Blaster MIDI output port
  176. Global Const MM_SNDBLST_MIDIIN = 4            ' Sound Blaster MIDI input port
  177. Global Const MM_SNDBLST_SYNTH = 5             ' Sound Blaster internal synthesizer
  178. Global Const MM_SNDBLST_WAVEOUT = 6           ' Sound Blaster waveform output
  179. Global Const MM_SNDBLST_WAVEIN = 7            ' Sound Blaster waveform input
  180. Global Const MM_ADLIB = 9                     ' Ad Lib-compatible synthesizer
  181. Global Const MM_MPU401_MIDIOUT = 10           ' MPU401-compatible MIDI output port
  182. Global Const MM_MPU401_MIDIIN = 11            ' MPU401-compatible MIDI input port
  183. Global Const MM_PC_JOYSTICK = 12              ' Joystick adapter
  184.  
  185. 'flags for wTechnology in MIDIOUTCAPS
  186. Global Const MOD_MIDIPORT = 1    ' Hardware Midi Port
  187. Global Const MOD_SYNTH = 2       ' Generic internal synthesizer
  188. Global Const MOD_SQSYNTH = 3     ' Square wawe internal synthesizer
  189. Global Const MOD_FMSYNTH = 4     ' FM internal synthesizer
  190. Global Const MOD_MAPPER = 5      ' Midi Mapper
  191.  
  192. 'flags for dwSupport in MIDIOUTCAPS
  193. Global Const MIDICAPS_VOLUME = &H1             ' supports volume control
  194. Global Const MIDICAPS_LRVOLUME = &H2           ' supports independent left/right control
  195. Global Const MIDICAPS_CACHE = &H4              ' supports patch cache
  196.  
  197.  
  198. 'Midi Output Device capacity structure
  199. Type MidiOutCaps
  200.     wMid As Integer                ' Manufacturer ID
  201.     wPid As Integer                ' Product ID
  202.     vDriverVersion As Integer      ' Driver version
  203.     szPname As String * 32         ' Product name (NULL terminated string)
  204.     wTechnology As Integer         ' Device type
  205.     wVoices As Integer             ' n. of voices (internal synth only)
  206.     wNotes As Integer              ' max n. of notes (internal synth only)
  207.     wChannelMask As Integer        ' n. of Midi channels (internal synth only)
  208.     dwSupport As Long              ' Supported extra controllers (volume, etc)
  209. End Type
  210.  
  211.  
  212. 'Midi Input Device capacity structure
  213. Type MidiInCaps
  214.     wMid As Integer                ' Manufacturer ID
  215.     wPid As Integer                ' Product ID
  216.     vDriverVersion As Integer      ' Driver version
  217.     szPname As String * 32         ' Product name (NULL terminated string)
  218. End Type
  219.  
  220.  
  221. 'flags for dwFlags in MIDIHDR
  222. Global Const MHDR_DONE = &H1                   ' bit indicates task done
  223. Global Const MHDR_PREPARED = &H2               ' bit indicates header prepared
  224. Global Const MHDR_INQUEUE = &H4                ' bit reserved for driver use
  225.  
  226.  
  227. 'MIDI Data Block Header (SYSEX)
  228. Type MIDIHDR
  229.     lpData As Long                    ' pointer to a block of data
  230.     dwBufferLength As Long            ' Buffer Length
  231.     dwBytesRecorded As Long           ' n. of recorded Bytes (only for Input)
  232.     dwUser As Long                    ' reserved for user
  233.     dwFlags As Long                   ' flags (see previous definitions)
  234.     lpNext As Long                    ' reserved for driver
  235.     reserved As Long                  ' reserved for driver
  236. End Type
  237.  
  238.  
  239. 'DECLARE API MIDI FUNCTIONS
  240.  
  241. 'MIDI IN Functions
  242. Declare Function midiInGetNumDevs% Lib "MMSYSTEM.DLL" ()
  243. Declare Function midiInGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiInCaps, ByVal uSize%)
  244. Declare Function midiInGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  245. Declare Function midiInOpen% Lib "MMSYSTEM.DLL" (lphMidiIn As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  246. Declare Function midiInClose% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  247. Declare Function midiInPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  248. Declare Function midiInUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  249. Declare Function midiInAddBuffer% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  250. Declare Function midiInStart% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  251. Declare Function midiInStop% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  252. Declare Function midiInReset% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  253. Declare Function midiInGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpuDeviceID%)
  254. Declare Function midiInMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  255.  
  256. 'MIDI OUT Functions
  257. Declare Function midiOutGetNumDevs% Lib "MMSYSTEM.DLL" ()
  258. Declare Function midiOutGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiOutCaps, ByVal uSize%)
  259. Declare Function midiOutGetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpdwVolume&)
  260. Declare Function midiOutSetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, ByVal dwVolume&)
  261. Declare Function midiOutGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  262. Declare Function midiOutOpen% Lib "MMSYSTEM.DLL" (lphMidiOut As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  263. Declare Function midiOutClose% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  264. Declare Function midiOutPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  265. Declare Function midiOutUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  266. Declare Function midiOutShortMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal dwMsg&)
  267. Declare Function midiOutLongMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  268. Declare Function midiOutReset% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  269. Declare Function midiOutCachePatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uBank%, lpwPatchArray%, ByVal uFlags%)
  270. Declare Function midiOutCacheDrumPatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uPatch%, lpwKeyArray%, ByVal uFlags%)
  271. Declare Function midiOutGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpuDeviceID%)
  272. Declare Function midiOutMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  273.  
  274.  
  275. 'DECLARE MISCELLANEOUS API FUNCTIONS
  276.  
  277. 'High Resolution System Time (milliseconds)
  278. Declare Function timeGetTime& Lib "MMSYSTEM.DLL" ()
  279.  
  280. 'Read/Write private INI Files
  281. Declare Function GetPrivateProfileString% Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Def$, ByVal Ret$, ByVal Size%, ByVal Fname$)
  282. Declare Function WritePrivateProfileString% Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Set1$, ByVal Fname$)
  283.  
  284. 'Returns Ini file value (string)
  285. Function Ini_Read$ (ByVal sIniName As String, ByVal sSection As String, ByVal sParamName As String)
  286.     Dim sRetString As String
  287.     Dim sDefString As String
  288.     Dim i  As Integer
  289.  
  290.     sRetString = String$(255, Chr(0))  'clear buffers
  291.     sDefString = String$(255, Chr(0))
  292.  
  293.     vntRet = GetPrivateProfileString(sSection, sParamName, sDefString, sRetString, Len(sRetString), sIniName)
  294.     
  295.     For i = 1 To 255
  296.     If Mid$(sRetString, i, 1) = Chr(0) Then  'API strings are zero ended
  297.         If i = 1 Then
  298.         sRetString = ""
  299.         Else
  300.         sRetString = Left$(sRetString, i - 1)
  301.         End If
  302.         Exit For
  303.     End If
  304.     Next i
  305.  
  306.     Ini_Read = sRetString
  307. End Function
  308.  
  309. Sub Ini_Write (ByVal sIniName As String, ByVal sSection As String, ByVal sParamName As String, ByVal sParamValue As String)
  310.     vntRet = WritePrivateProfileString(sSection, sParamName, sParamValue, sIniName)
  311. End Sub
  312.  
  313. Sub Midi_ErrorAlert (ByVal iMidiError As Integer)
  314.     Dim sMsg As String
  315.  
  316.     Select Case iMidiError
  317.     Case MMSYSERR_BADDEVICEID
  318.         sMsg = "Bad Device ID! "
  319.     Case MMSYSERR_NOTENABLED
  320.         sMsg = "Device not enabled!"
  321.     Case MMSYSERR_ALLOCATED
  322.         sMsg = "Device already allocated!"
  323.     Case MMSYSERR_INVALHANDLE
  324.         sMsg = "Invalid Device Handle!"
  325.     Case MMSYSERR_NODRIVER
  326.         sMsg = "Driver not found!"
  327.     Case MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)
  328.         sMsg = "Out of memory!"
  329.     Case MIDIERR_STILLPLAYING
  330.         sMsg = "Device still playing!"
  331.     Case MIDIERR_NOMAP
  332.         sMsg = "MIDI Mapper device not found!"
  333.     Case MIDIERR_NOTREADY
  334.         sMsg = "Hardware not ready! "
  335.     Case MIDIERR_NODEVICE
  336.         sMsg = "Device not present!"
  337.     Case Else
  338.         sMsg = "Unexpected error!"
  339.     End Select
  340.      
  341.     MsgBox sMsg, 48, "MIDI ERROR"
  342.     
  343. End Sub
  344.  
  345. Sub Midi_Panic ()
  346.     'not very standard but it works with all the computers I've tested
  347.     'Those are the usual device handles used by Windows to open and close MIDI ports
  348.     'Call it only if an application stops without closing the MIDI devices.
  349.     'Otherwise you'll have to reboot your system.
  350.     vntRet = midiInClose(966)
  351.     vntRet = midiInClose(986)
  352.     vntRet = midiInClose(1006)
  353.     vntRet = midiInClose(1026)
  354.  
  355.     vntRet = midiOutClose(966)
  356.     vntRet = midiOutClose(986)
  357.     vntRet = midiOutClose(1006)
  358.     vntRet = midiOutClose(1026)
  359.  
  360.     hMidiIn = NO_HANDLE
  361.     hMidiOut = NO_HANDLE
  362. End Sub
  363.  
  364. Sub Midi_Populate_Lists (lstInList As Control, lstOutList As Control)
  365.     Dim i As Integer
  366.     Dim InCaps As MidiInCaps, OutCaps As MidiOutCaps
  367.  
  368.     nInDevices = midiInGetNumDevs()
  369.  
  370.     lstInList.List(0) = "Device not enabled"
  371.  
  372.     For i = 0 To nInDevices - 1
  373.     vntRet = midiInGetDevCaps(i, InCaps, Len(InCaps))
  374.     If vntRet <> 0 Then
  375.         Call Midi_ErrorAlert(vntRet)
  376.         Exit For
  377.     End If
  378.     lstInList.List(i + 1) = InCaps.szPname
  379.     Next i
  380.  
  381.     nOutDevices = midiOutGetNumDevs()
  382.  
  383.     lstOutList.List(0) = "Device not enabled"
  384.  
  385.     For i = -1 To nOutDevices - 1            'Midi Mapper = -1
  386.     vntRet = midiOutGetDevCaps(i, OutCaps, Len(OutCaps))
  387.     If vntRet <> 0 Then
  388.         Call Midi_ErrorAlert(vntRet)
  389.         Exit For
  390.     End If
  391.     lstOutList.List(i + 2) = OutCaps.szPname
  392.     Next i
  393. End Sub
  394.  
  395. Sub MidiIn_Close ()
  396.     
  397.     'If a MIDI In device was opened...
  398.     If hMidiIn <> NO_HANDLE Then
  399.     'Cancel MidiHook activity
  400.     frmMidiHook.MidiHook.Message(MIM_DATA) = False
  401.  
  402.     'Stop Midi In activity
  403.     vntRet = midiInStop(hMidiIn)
  404.     If vntRet <> 0 Then Call Midi_ErrorAlert(vntRet)
  405.  
  406.     'Close Midi In device
  407.     vntRet = midiInClose(hMidiIn)
  408.     If vntRet <> 0 Then Call Midi_ErrorAlert(vntRet)
  409.  
  410.     'Set Midi In handle to not enabled state
  411.     hMidiIn = NO_HANDLE
  412.     End If
  413. End Sub
  414.  
  415. Sub MidiIn_Open (ByVal nDevice)
  416.     'Close possible opened Midi In devices
  417.     Call MidiIn_Close
  418.     
  419.     'Open Midi In device
  420.     vntRet = midiInOpen(hMidiIn, nDevice, frmMidiHook.hWnd, 0, CALLBACK_WINDOW)
  421.     'An error occurred
  422.     If vntRet <> 0 Then
  423.     'Close all usual Midi Device Handles
  424.     Call Midi_Panic
  425.     'Try to open again
  426.     vntRet = midiInOpen(hMidiIn, nDevice, frmMidiHook.hWnd, 0, CALLBACK_WINDOW)
  427.     'Error again!
  428.     If vntRet <> 0 Then
  429.         'No solution
  430.         Call Midi_ErrorAlert(vntRet)
  431.         hMidiIn = NO_HANDLE
  432.         Exit Sub
  433.     End If
  434.     End If
  435.  
  436.     'Set frmMidiHook as a Callback Window
  437.     frmMidiHook.MidiHook.HwndHook = frmMidiHook.hWnd
  438.     
  439.     'Set MidiHook Control to intercept only Midi In Data Messages
  440.     frmMidiHook.MidiHook.Message(MIM_DATA) = True
  441.     
  442.     'Start Midi In activity
  443.     vntRet = midiInStart(hMidiIn)
  444.     If vntRet <> 0 Then
  445.     Call Midi_ErrorAlert(vntRet)
  446.     End If
  447.     
  448. End Sub
  449.  
  450. Sub MidiOut_Close ()
  451.     'If a MIDI Out device was opened...
  452.     If hMidiOut <> NO_HANDLE Then
  453.     'Close Midi Out device
  454.     vntRet = midiOutClose(hMidiOut)
  455.     If vntRet <> 0 Then
  456.         Call Midi_ErrorAlert(vntRet)
  457.     End If
  458.  
  459.     'Set Midi Out handle to not enabled state
  460.     hMidiOut = NO_HANDLE
  461.     End If
  462. End Sub
  463.  
  464. 'Returns True if succesfull, False if unsuccesfull
  465. Function MidiOut_ControlChange& (iChannel As Integer, iControlNumber As Integer, iControlValue As Integer)
  466.     Dim lMsg As Long
  467.  
  468.     lMsg = (CONTROLLER_CHANGE + iChannel) + (256& * iControlNumber) + (65536 * iControlValue)
  469.     MidiOut_ControlChange = MidiOut_Msg(lMsg)
  470. End Function
  471.  
  472. 'Returns True if succesfull, False if unsuccesfull
  473. Function MidiOut_Msg% (ByVal lMsg As Long)
  474.     If hMidiOut = NO_HANDLE Then
  475.     Call Dlg_Alert("Device not enabled!")
  476.     MidiOut_Msg = False
  477.     Exit Function
  478.     End If
  479.  
  480.     MidiOut_Msg = True
  481.  
  482.     vntRet = midiOutShortMsg(hMidiOut, lMsg)
  483.     If vntRet <> 0 Then
  484.     Call Midi_ErrorAlert(vntRet)
  485.     MidiOut_Msg = False
  486.     Exit Function
  487.     End If
  488.  
  489.     'You may show here a screen representation of Midi Data Out.
  490.     '*********************************************
  491.     'SPECIFIC TO THIS APPLICATION
  492.     If bVisualData = True Then
  493.     If frmVBSeq.picDataOut.BackColor = LED_OFF Then
  494.         frmVBSeq.picDataOut.BackColor = LED_ON
  495.     End If
  496.     lDataOutTime = timeGetTime()
  497.     End If
  498.     '*********************************************
  499.  
  500. End Function
  501.  
  502. 'Returns True if succesfull, False if unsuccesfull
  503. Function MidiOut_Mtc (ByVal nQfID As Integer, ByVal nHours As Integer, ByVal nMinutes As Integer, ByVal nSeconds As Integer, ByVal nFrames As Integer)
  504.     Dim lMidiMessage    As Long
  505.     Dim iMtcData        As Integer
  506.     Dim iLoNib          As Integer
  507.  
  508.     If hMidiOut = NO_HANDLE Then
  509.     Call Dlg_Alert("Device not enabled!")
  510.     MidiOut_Mtc = False
  511.     Exit Function
  512.     End If
  513.  
  514.     Select Case nQfID
  515.     Case 0:   'send frames lo Nibble
  516.         iLoNib = nFrames And &HF          'Bit0 to Bit3 of Frames
  517.  
  518.     Case 1:   'send frames hi Nibble
  519.         iLoNib = (nFrames And &H10) / 16  'Bit4 of Frames
  520.  
  521.     Case 2:   'send seconds lo Nibble
  522.         iLoNib = nSeconds And &HF         'Bit0 to Bit3 of Seconds
  523.  
  524.     Case 3:    'send seconds hi Nibble
  525.         iLoNib = (nSeconds And &H30) / 16 'Bit4 and Bit5 of Seconds
  526.  
  527.     Case 4:    'send minutes lo Nibble
  528.         iLoNib = nMinutes And &HF         'Bit0 to Bit3 of Minutes
  529.  
  530.     Case 5:    'send minutes hi Nibble
  531.         iLoNib = (nMinutes And &H30) / 16 'Bit4 and Bit5 of Minutes
  532.  
  533.     Case 6:    'send hours lo Nibble
  534.         iLoNib = nHours And &HF           'Bit0 to Bit3 of Hours
  535.  
  536.     Case 7:    'send hours hi Nibble and MTC frame mode
  537.         iLoNib = (nHours And &H10) / 16   'Bit0 = Bit 4 of Hours
  538.         iLoNib = iLoNib + nMtcMode * 2    'Bit1 and Bit2 = nMtcMode (0,1,2,3)
  539.  
  540.     End Select
  541.  
  542.     'Hi Nibble = nQfID
  543.     iMtcData = nQfID * 16 + iLoNib
  544.  
  545.     'Packed MTC Message -> Byte0 = Status / Byte1 = Data1 / Byte2 = 0
  546.     lMidiMessage = MTC_QFRAME + (iMtcData * 256&)
  547.  
  548.     MidiOut_Mtc = True
  549.     
  550.     vntRet = midiOutShortMsg(hMidiOut, lMidiMessage) 'send it out
  551.     If vntRet <> 0 Then
  552.     Call Midi_ErrorAlert(vntRet)
  553.     MidiOut_Mtc = False
  554.     Exit Function
  555.     End If
  556.  
  557.     'You may show here a screen representation of MTC Out.
  558.     '*****************************************************************
  559.     'SPECIFIC TO THIS APPLICATION
  560.     If bVisualMtc = True Then
  561.     If frmVBSeq.picMtcOut.BackColor = LED_OFF Then
  562.         frmVBSeq.picMtcOut.BackColor = LED_ON
  563.     End If
  564.     lMtcOutTime = timeGetTime()
  565.     End If
  566.     '*****************************************************************
  567.  
  568.  
  569. End Function
  570.  
  571. 'Returns True if succesfull, False if unsuccesfull
  572. Function MidiOut_NoteOff& (iChannel As Integer, iNoteNumber As Integer, iKeyvel As Integer)
  573.     Dim lMsg As Long
  574.  
  575.     lMsg = (NOTE_OFF + iChannel) + (256& * iNoteNumber) + (65536 * iKeyvel)
  576.     MidiOut_NoteOff = MidiOut_Msg(lMsg)
  577.  
  578. End Function
  579.  
  580. 'Returns True if succesfull, False if unsuccesfull
  581. Function MidiOut_NoteOn& (iChannel As Integer, iNoteNumber As Integer, iKeyvel As Integer)
  582.     Dim lMsg As Long
  583.  
  584.     lMsg = (NOTE_ON + iChannel) + (256& * iNoteNumber) + (65536 * iKeyvel)
  585.     MidiOut_NoteOn = MidiOut_Msg(lMsg)
  586.  
  587. End Function
  588.  
  589. Sub MidiOut_Open (ByVal nDevice)
  590.     'Close possible opened Midi Out Devices
  591.     Call MidiOut_Close
  592.  
  593.     'Open Midi Out device
  594.     vntRet = midiOutOpen(hMidiOut, nDevice, 0, 0, 0)
  595.     If vntRet <> 0 Then
  596.     'Close all usual Midi Device Handles
  597.     Call Midi_Panic
  598.     'Try to open again
  599.     vntRet = midiOutOpen(hMidiOut, nDevice, 0, 0, 0)
  600.     'If error persists
  601.     If vntRet <> 0 Then
  602.         'No solution
  603.         Call Midi_ErrorAlert(vntRet)
  604.         hMidiOut = NO_HANDLE
  605.     End If
  606.     End If
  607. End Sub
  608.  
  609. 'Returns True if succesfull, False if unsuccesfull
  610. Function MidiOut_ProgramChange& (iChannel As Integer, iProgramNumber As Integer)
  611.     Dim lMsg As Long
  612.  
  613.     lMsg = (PROGRAM_CHANGE + iChannel) + (256& * iProgramNumber)
  614.     MidiOut_ProgramChange = MidiOut_Msg(lMsg)
  615. End Function
  616.  
  617. Sub Mtc_Adjust (nHours As Integer, nMinutes As Integer, nSeconds As Integer, nFrames As Integer)
  618.     While nFrames >= nFramesPerSecond
  619.     nFrames = nFrames - nFramesPerSecond
  620.     nSeconds = nSeconds + 1
  621.     Wend
  622.  
  623.     While nSeconds >= 60
  624.     nSeconds = nSeconds - 60
  625.     nMinutes = nMinutes + 1
  626.     Wend
  627.  
  628.     While nMinutes >= 60
  629.     nMinutes = nMinutes - 60
  630.     nHours = nHours + 1
  631.     Wend
  632.  
  633.     While nHours >= 24
  634.     nHours = nHours - 24
  635.     Wend
  636.  
  637.     While nFrames < 0
  638.     nFrames = nFrames + nFramesPerSecond
  639.     nSeconds = nSeconds - 1
  640.     Wend
  641.  
  642.     While nSeconds < 0
  643.     nSeconds = nSeconds + 60
  644.     nMinutes = nMinutes - 1
  645.     Wend
  646.  
  647.     While nMinutes < 0
  648.     nMinutes = nMinutes + 60
  649.     nHours = nHours - 1
  650.     Wend
  651.  
  652.     While nHours < 0
  653.     nHours = nHours + 24
  654.     Wend
  655.  
  656. End Sub
  657.  
  658. Sub Mtc_Frames_to_HMSF (ByVal lTotalFrames As Long, iHours As Integer, iMinutes As Integer, iSeconds As Integer, iFrames As Integer)
  659.     Dim lNum As Long
  660.  
  661.     lNum = lTotalFrames
  662.  
  663.     iFrames = lNum Mod nFramesPerSecond
  664.  
  665.     lNum = Int(lNum / nFramesPerSecond)
  666.     iSeconds = lNum Mod 60
  667.  
  668.     lNum = Int(lNum / 60)
  669.     iMinutes = lNum Mod 60
  670.  
  671.     iHours = Int(lNum / 60)
  672. End Sub
  673.  
  674. Function Mtc_HMSF_To_Frames& (ByVal iHours As Integer, ByVal iMinutes As Integer, ByVal iSeconds As Integer, ByVal iFrames As Integer)
  675.     Dim lTotalFrames As Long
  676.  
  677.     lTotalFrames = (iHours * 3600& + iMinutes * 60& + iSeconds) * nFramesPerSecond + iFrames
  678.     Mtc_HMSF_To_Frames = lTotalFrames
  679. End Function
  680.  
  681. Function Mtc_HMSF_To_Ms& (ByVal iHours As Integer, ByVal iMinutes As Integer, ByVal iSeconds As Integer, ByVal iFrames As Integer)
  682.     Dim lTotalMs As Long
  683.  
  684.     lTotalMs = (iHours * 3600000) + (iMinutes * 60000) + (iSeconds * 1000&) + (iFrames * (1000& / nFramesPerSecond))
  685.     Mtc_HMSF_To_Ms = lTotalMs
  686. End Function
  687.  
  688. Sub Mtc_Ms_To_HMSF (ByVal lTotalMs As Long, iHours As Integer, iMinutes As Integer, iSeconds As Integer, iFrames As Integer)
  689.      Dim lNum As Long
  690.  
  691.     lNum = CLng(lTotalMs / fMsPerFrame)     'Rounded total N. of Frames
  692.  
  693.     iFrames = lNum Mod nFramesPerSecond
  694.  
  695.     lNum = Int(lNum / nFramesPerSecond)
  696.     iSeconds = lNum Mod 60
  697.  
  698.     lNum = Int(lNum / 60)
  699.     iMinutes = lNum Mod 60
  700.  
  701.     iHours = Int(lNum / 60)
  702. End Sub
  703.  
  704. Function Mtc_SetMode$ (iMode As Integer)
  705.     Dim sMsg As String
  706.  
  707.     nMtcMode = iMode
  708.     Select Case iMode
  709.        Case 0:
  710.         fMsPerQF = 250! / 24!       'must be single float
  711.         fMsPerFrame = 1000! / 24!
  712.         nFramesPerSecond = 24
  713.         sMsg = "24 f/s"
  714.     Case 1:
  715.         fMsPerQF = 250! / 25!
  716.         fMsPerFrame = 1000! / 25!
  717.         nFramesPerSecond = 25
  718.         sMsg = "25 f/s"
  719.     Case 2:
  720.         fMsPerQF = 250! / 29.96!
  721.         fMsPerFrame = 1000! / 29.96!
  722.         nFramesPerSecond = 30
  723.         sMsg = "30 f/s drop"
  724.         '
  725.         'Not supported in this version!!!!
  726.         '
  727.         '30 f/s drop frame mode is rarely used in MIDI applications.
  728.         'In this mode, selected frames are dropped to sync to
  729.         'american video 29.96 frame per second rate.
  730.         'Midihook_Message event procedure should take care of those
  731.         'dropped frames in its timing calculations.
  732.         'The procedure actually interprets dropped frames as discontinuous MTC!
  733.         'The MTC Functions and Subroutines should also be updated.
  734.         '
  735.         '
  736.     Case 3:
  737.         fMsPerQF = 250! / 30!
  738.         fMsPerFrame = 1000! / 30!
  739.         nFramesPerSecond = 30
  740.         sMsg = "30 f/s no drop"
  741.     End Select
  742.  
  743.     Mtc_SetMode = sMsg
  744. End Function
  745.  
  746.