home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mtc / mtc.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  32.0 KB  |  951 lines
  1. Option Explicit
  2.  
  3. Global Frame_Mode As Integer   '24,25,29,30
  4. Global TC_Type As Integer      '0,  1, 2, 3
  5. Global MTC_Time As Long        'External Time in ms.
  6. Global Ms_per_QF As Single     'Ms. per Quarter Frame (1000/Frame_Mode)
  7. Global QF_Counter As Integer   '0...7  (Quarter Frame Message Counter)
  8.  
  9. Global hhh As Integer          'Actual Hours
  10. Global mmm As Integer          'Minutes
  11. Global sss As Integer          'Seconds
  12. Global fff As Integer          'Frames
  13.  
  14. Global disp_hhh As Integer     'Display Hours
  15. Global disp_mmm As Integer     'Minutes
  16. Global disp_sss As Integer     'Seconds
  17. Global disp_fff As Integer     'Frames
  18.  
  19. Global flgStop As Integer
  20. Global flgDown As Integer
  21. Global flgReadStop As Integer
  22.  
  23. 'Midi Device Handles
  24. Global hMidiIn As Integer               'usually 966 or 986
  25. Global hMidiOut As Integer              '   "        "   "
  26. Global Const NO_HANDLE = -1000          'Device closed
  27.      
  28. 'InBuffer parameters (circular buffer)
  29. Global ReadIndex As Integer               'Where to read from buffer
  30. Global WriteIndex As Integer              'where to write into buffer
  31. Global BuffCounter As Integer           'N. of messages in buffer
  32. Global InBuffer(1023) As Long           'Buffer (0...1023)
  33. Global Const BUFFSIZE = 1024            'max. 1024 messages
  34.  
  35. 'If InBuffer is full and a message arrives, increment NumErrors
  36. Global NumErrors As Long
  37.  
  38. 'Wait for this flag to be active before change InBuffer Parameters
  39. Global flgChangeIt As Integer        'True=changes allowed, False=not allowed
  40.  
  41. 'Device ID
  42. Global InDevice As Integer          'Midi In Device
  43. Global OutDevice As Integer         'Midi Out Device
  44.  
  45. Global flgGoodbye As Integer        'If true exit polling loop
  46.                                     'For API Functions Calls
  47. Global ret As Integer
  48.  
  49.  
  50. ''''''''''  General Constants '''''''''''''''
  51.  
  52. ' Booleans
  53. Global Const YES = True
  54. Global Const NO = False
  55.  
  56. ' DragOver
  57. Global Const ENTER = 0
  58. Global Const LEAVE = 1
  59.  
  60. ' Colors
  61. Global Const BLACK = &H0&
  62. Global Const RED = &HFF&
  63. Global Const GREEN = &HFF00&
  64. Global Const YELLOW = &HFFFF&
  65. Global Const BLUE = &HFF0000
  66. Global Const MAGENTA = &HFF00FF
  67. Global Const CYAN = &HFFFF00
  68. Global Const WHITE = &HFFFFFF
  69. Global Const GRAY = &HC0C0C0
  70. Global Const BURDEOS = &H80
  71. Global Const DARKGRREN = &H8000
  72. Global Const DARKBLUE = &H800000
  73. Global Const MIDLEGREEN = &H8080
  74. Global Const LILA = &H800080
  75. Global Const VERDFOSC = &H808000
  76. Global Const DARKGREY = &H808080
  77.  
  78. 'MousePointer
  79. Global Const DEFAULT = 0        ' 0 - Default
  80. Global Const ARROW = 1          ' 1 - Arrow
  81. Global Const CROSSHAIR = 2      ' 2 - Cross
  82. Global Const IBEAM = 3          ' 3 - I-Beam
  83. Global Const ICON_POINTER = 4   ' 4 - Icon
  84. Global Const SIZE_POINTER = 5   ' 5 - Size
  85. Global Const SIZE_NE_SW = 6     ' 6 - Size NE SW
  86. Global Const SIZE_N_S = 7       ' 7 - Size N S
  87. Global Const SIZE_NW_SE = 8     ' 8 - Size NW SE
  88. Global Const SIZE_W_E = 9       ' 9 - Size W E
  89. Global Const UP_ARROW = 10      ' 10 - Up Arrow
  90. Global Const HOURGLASS = 11     ' 11 - Hourglass
  91. Global Const NO_DROP = 12       ' 12 - No drop
  92.  
  93. ' MsgBox parameters
  94. Global Const MB_OK = 0                 ' OK button only
  95. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  96. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  97. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  98. Global Const MB_YESNO = 4              ' Yes and No buttons
  99. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  100.  
  101. Global Const MB_ICONSTOP = 16          ' Critical message
  102. Global Const MB_ICONQUESTION = 32      ' Warning query
  103. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  104. Global Const MB_ICONINFORMATION = 64   ' Information message
  105.  
  106. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  107. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  108. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  109. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  110. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  111.  
  112. ' MsgBox return values
  113. Global Const IDOK = 1                  ' OK button pressed
  114. Global Const IDCANCEL = 2              ' Cancel button pressed
  115. Global Const IDABORT = 3               ' Abort button pressed
  116. Global Const IDRETRY = 4               ' Retry button pressed
  117. Global Const IDIGNORE = 5              ' Ignore button pressed
  118. Global Const IDYES = 6                 ' Yes button pressed
  119. Global Const IDNO = 7                  ' No button pressed
  120.  
  121. ' Key Codes
  122. Global Const KEY_LBUTTON = &H1
  123. Global Const KEY_RBUTTON = &H2
  124. Global Const KEY_CANCEL = &H3
  125. Global Const KEY_MBUTTON = &H4    ' NOT contiguous with L & R BUTTON
  126. Global Const KEY_BACK = &H8
  127. Global Const KEY_TAB = &H9
  128. Global Const KEY_CLEAR = &HC
  129. Global Const KEY_RETURN = &HD
  130. Global Const KEY_SHIFT = &H10
  131. Global Const KEY_CONTROL = &H11
  132. Global Const KEY_MENU = &H12
  133. Global Const KEY_PAUSE = &H13
  134. Global Const KEY_CAPITAL = &H14
  135. Global Const KEY_ESCAPE = &H1B
  136. Global Const KEY_SPACE = &H20
  137. Global Const KEY_PRIOR = &H21
  138. Global Const KEY_NEXT = &H22
  139. Global Const KEY_END = &H23
  140. Global Const KEY_HOME = &H24
  141. Global Const KEY_LEFT = &H25
  142. Global Const KEY_UP = &H26
  143. Global Const KEY_RIGHT = &H27
  144. Global Const KEY_DOWN = &H28
  145. Global Const KEY_SELECT = &H29
  146. Global Const KEY_PRINT = &H2A
  147. Global Const KEY_EXECUTE = &H2B
  148. Global Const KEY_SNAPSHOT = &H2C
  149. Global Const KEY_INSERT = &H2D
  150. Global Const KEY_DELETE = &H2E
  151. Global Const KEY_HELP = &H2F
  152.  
  153. ' KEY_A thru KEY_Z are the same as their ASCII equivalents: 'A' thru 'Z'
  154. ' KEY_0 thru KEY_9 are the same as their ASCII equivalents: '0' thru '9'
  155.  
  156. Global Const KEY_NUMPAD0 = &H60
  157. Global Const KEY_NUMPAD1 = &H61
  158. Global Const KEY_NUMPAD2 = &H62
  159. Global Const KEY_NUMPAD3 = &H63
  160. Global Const KEY_NUMPAD4 = &H64
  161. Global Const KEY_NUMPAD5 = &H65
  162. Global Const KEY_NUMPAD6 = &H66
  163. Global Const KEY_NUMPAD7 = &H67
  164. Global Const KEY_NUMPAD8 = &H68
  165. Global Const KEY_NUMPAD9 = &H69
  166. Global Const KEY_MULTIPLY = &H6A
  167. Global Const KEY_ADD = &H6B
  168. Global Const KEY_SEPARATOR = &H6C
  169. Global Const KEY_SUBTRACT = &H6D
  170. Global Const KEY_DECIMAL = &H6E
  171. Global Const KEY_DIVIDE = &H6F
  172. Global Const KEY_F1 = &H70
  173. Global Const KEY_F2 = &H71
  174. Global Const KEY_F3 = &H72
  175. Global Const KEY_F4 = &H73
  176. Global Const KEY_F5 = &H74
  177. Global Const KEY_F6 = &H75
  178. Global Const KEY_F7 = &H76
  179. Global Const KEY_F8 = &H77
  180. Global Const KEY_F9 = &H78
  181. Global Const KEY_F10 = &H79
  182. Global Const KEY_F11 = &H7A
  183. Global Const KEY_F12 = &H7B
  184. Global Const KEY_F13 = &H7C
  185. Global Const KEY_F14 = &H7D
  186. Global Const KEY_F15 = &H7E
  187. Global Const KEY_F16 = &H7F
  188.  
  189. Global Const KEY_NUMLOCK = &H90
  190.  
  191. Global Const SHIFT_MASK = 1
  192. Global Const CTRL_MASK = 2
  193. Global Const ALT_MASK = 4
  194.  
  195. Global Const LEFT_BUTTON = 1
  196. Global Const RIGHT_BUTTON = 2
  197. Global Const MIDDLE_BUTTON = 4
  198.  
  199. 'SYSTEM Errors
  200. Global Const MMSYSERR_BASE = 0
  201. Global Const MMSYSERR_NOERROR = 0                        ' cap error
  202. Global Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)        ' error sense especificar
  203. Global Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)  ' ID de dispositiu err≥nia
  204. Global Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)   ' no es pot activar el dispositiu
  205. Global Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)    ' el dispositiu ja estα activat
  206. Global Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)  ' Handle de dispositiu incorrecte
  207. Global Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)     ' no existeix el driver del dispositiu
  208. Global Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)        ' no hi ha prou mem≥ria
  209. Global Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8) ' funci≤ no suportada
  210. Global Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)    ' error fora de marge
  211. Global Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10)   ' flag passat incorrecte
  212. Global Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)  ' parαmetre passat incorrecte
  213. Global Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 11)   ' ·ltim error del marge
  214.  
  215.  
  216. 'MIDI Errors
  217. Global Const MIDIERR_BASE = 64
  218. Global Const MIDIERR_UNPREPARED = (MIDIERR_BASE + 0)     ' capτalera no preparada (SYSEX)
  219. Global Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1)   ' play no ha acabat
  220. Global Const MIDIERR_NOMAP = (MIDIERR_BASE + 2)          ' no hi ha el mapa MIDI
  221. Global Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3)       ' el hardware estα ocupat
  222. Global Const MIDIERR_NODEVICE = (MIDIERR_BASE + 4)       ' el port estα desconectat
  223. Global Const MIDIERR_INVALIDSETUP = (MIDIERR_BASE + 5)   ' setup incorrecte
  224. Global Const MIDIERR_LASTERROR = (MIDIERR_BASE + 5)      ' ·ltim error del marge
  225.  
  226. 'tipus de data de MIDI audio
  227. Global Const MIDIPATCHSIZE = 128
  228.  
  229.  
  230. 'MISSATGES
  231.  
  232. 'missatges de MIDI Input
  233. Global Const MM_MIM_OPEN = &H3C1
  234. Global Const MM_MIM_CLOSE = &H3C2
  235. Global Const MM_MIM_DATA = &H3C3
  236. Global Const MM_MIM_LONGDATA = &H3C4
  237. Global Const MM_MIM_ERROR = &H3C5
  238. Global Const MM_MIM_LONGERROR = &H3C6
  239.  
  240. 'missatges de MIDI Output
  241. Global Const MM_MOM_OPEN = &H3C7
  242. Global Const MM_MOM_CLOSE = &H3C8
  243. Global Const MM_MOM_DONE = &H3C9
  244.  
  245.  
  246. 'missatges de MIDI callback
  247. Global Const MIM_OPEN = MM_MIM_OPEN
  248. Global Const MIM_CLOSE = MM_MIM_CLOSE
  249. Global Const MIM_DATA = MM_MIM_DATA
  250. Global Const MIM_LONGDATA = MM_MIM_LONGDATA
  251. Global Const MIM_ERROR = MM_MIM_ERROR
  252. Global Const MIM_LONGERROR = MM_MIM_LONGERROR
  253. Global Const MOM_OPEN = MM_MOM_OPEN
  254. Global Const MOM_CLOSE = MM_MOM_CLOSE
  255. Global Const MOM_DONE = MM_MOM_DONE
  256.  
  257. ' device ID del mapa MIDI
  258. Global Const MIDIMAPPER = (-1)
  259. Global Const MIDI_MAPPER = (-1)
  260.  
  261. ' flags per wFlags a midiOutCachePatches(), midiOutCacheDrumPatches()
  262. Global Const MIDI_CACHE_ALL = 1
  263. Global Const MIDI_CACHE_BESTFIT = 2
  264. Global Const MIDI_CACHE_QUERY = 3
  265. Global Const MIDI_UNCACHE = 4
  266.  
  267.  
  268. ' flags usats a waveOutOpen(), waveInOpen(), midiInOpen(), and
  269. ' midiOutOpen() per especificar el tipus de parαmetre dwCallback.
  270.  
  271. Global Const CALLBACK_TYPEMASK = &H70000         ' callback de tipus mask
  272. Global Const CALLBACK_NULL = &H0&                ' cap callback
  273. Global Const CALLBACK_WINDOW = &H10000           ' dwCallback Θs HWND (finestra)
  274. Global Const CALLBACK_TASK = &H20000             ' dwCallback Θs HTASK (tasca)
  275. Global Const CALLBACK_FUNCTION = &H30000         ' dwCallback Θs FARPROC (funci≤)
  276.  
  277.  
  278. '    IDs de fabricants i productes
  279. '    Usat com wMid i wPid a WAVEOUTCAPS, WAVEINCAPS,
  280. '    MIDIOUTCAPS, MIDIINCAPS, AUXCAPS, JOYCAPS
  281.  
  282. ' IDs de fabricants
  283. Global Const MM_MICROSOFT = 1                 ' Microsoft Corp.
  284.  
  285. ' IDs de productes
  286. Global Const MM_MIDI_MAPPER = 1               ' MIDI Mapper
  287. Global Const MM_WAVE_MAPPER = 2               ' Wave Mapper
  288. Global Const MM_SNDBLST_MIDIOUT = 3           ' Sound Blaster MIDI output port
  289. Global Const MM_SNDBLST_MIDIIN = 4            ' Sound Blaster MIDI input port
  290. Global Const MM_SNDBLST_SYNTH = 5             ' Sound Blaster internal synthesizer
  291. Global Const MM_SNDBLST_WAVEOUT = 6           ' Sound Blaster waveform output
  292. Global Const MM_SNDBLST_WAVEIN = 7            ' Sound Blaster waveform input
  293. Global Const MM_ADLIB = 9                     ' Ad Lib-compatible synthesizer
  294. Global Const MM_MPU401_MIDIOUT = 10           ' MPU401-compatible MIDI output port
  295. Global Const MM_MPU401_MIDIIN = 11            ' MPU401-compatible MIDI input port
  296. Global Const MM_PC_JOYSTICK = 12              ' Joystick adapter
  297.  
  298. ' flags per wTechnology a MIDIOUTCAPS
  299. Global Const MOD_MIDIPORT = 1    ' port hardware
  300. Global Const MOD_SYNTH = 2       ' sintetitzador intern genΦric
  301. Global Const MOD_SQSYNTH = 3     ' sintet. intern d'ona quadrada
  302. Global Const MOD_FMSYNTH = 4     ' sintet. intern FM
  303. Global Const MOD_MAPPER = 5      ' mapa MIDI
  304.  
  305. ' flags per dwSupport a MIDIOUTCAPS
  306. Global Const MIDICAPS_VOLUME = &H1             ' suporta control de volum
  307. Global Const MIDICAPS_LRVOLUME = &H2           ' suporta control independent esquerra/dreta
  308. Global Const MIDICAPS_CACHE = &H4              ' suporta cache de patch
  309.  
  310.  
  311. ' estructura de les capacitats del dispositiu MIDI output
  312. Type MidiOutCaps
  313.     wMid As Integer                ' ID del fabricant
  314.     wPid As Integer                ' ID del producte
  315.     vDriverVersion As Integer      ' versi≤ del driver
  316.     szPname As String * 32         ' nom del producte (string acabat en NULL)
  317.     wTechnology As Integer         ' tipus de dispositiu
  318.     wVoices As Integer             ' n. de veus (nomΘs sintet. intern)
  319.     wNotes As Integer              ' max n. de notes (nomΘs sintet. intern)
  320.     wChannelMask As Integer        ' canals utilitzables (nomΘs sintet. intern)
  321.     dwSupport As Long              ' controls extres suportats (volum, etc)
  322. End Type
  323.  
  324.  
  325. ' estructura de les capacitats del dispositiu MIDI input
  326. Type MidiInCaps
  327.     wMid As Integer                ' ID del fabricant
  328.     wPid As Integer                ' ID del producte
  329.     vDriverVersion As Integer      ' versi≤ del driver
  330.     szPname As String * 32         ' nom del producte (string acabat en NULL)
  331. End Type
  332.  
  333.  
  334. ' flags per dwFlags a MIDIHDR
  335. Global Const MHDR_DONE = &H1                   ' bit que indica operaci≤ completada
  336. Global Const MHDR_PREPARED = &H2               ' bit que indica que el header estα preparat
  337. Global Const MHDR_INQUEUE = &H4                ' bit reservat pel driver
  338.  
  339. ' header d'un bloc de data MIDI (SYSEX)
  340. Type MIDIHDR
  341.     lpData As Long                    ' pointer a un bloc de data
  342.     dwBufferLength As Long            ' dimensions del buffer
  343.     dwBytesRecorded As Long           ' n. de Bytes gravats (nomΘs per Input)
  344.     dwUser As Long                    ' utilitzable per l'usuari
  345.     dwFlags As Long                   ' flags (veure les definicions anteriors)
  346.     lpNext As Long                    ' reservat pel driver
  347.     reserved As Long                  ' reservat pel driver
  348. End Type
  349.  
  350. ' tipus de data que utilitza windows per enviar missatges midi
  351. Type MidiShortMsg
  352.     dwTimestamp     As Long   'temps en que s'ha rebut el missatge (ms. desde Start)
  353.     dwMidiMsg       As Long   'missatge
  354. End Type
  355.  
  356. ' Funcions MIDI OUT
  357. 'n. de dispositius Midi Output?
  358. Declare Function midiOutGetNumDevs% Lib "MMSYSTEM.DLL" ()
  359. 'capacitats d'un dispositiu Midi Output en concret?
  360. Declare Function midiOutGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiOutCaps, ByVal uSize%)
  361. 'Volum (pregunta)
  362. Declare Function midiOutGetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpdwVolume&)
  363. 'Volum (assigna)
  364. Declare Function midiOutSetVolume% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, ByVal dwVolume&)
  365. 'Texte d'un error MidiOut
  366. Declare Function midiOutGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  367. 'Obre un dispositiu MIDI
  368. Declare Function midiOutOpen% Lib "MMSYSTEM.DLL" (lphMidiOut As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  369. 'Tanca un dispositiu MIDI
  370. Declare Function midiOutClose% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  371. 'Prepara un header per rebre SYSEX
  372. Declare Function midiOutPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  373. 'Desprepara un header
  374. Declare Function midiOutUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  375. 'Envia un missatge Midi normal pel Midi Out (3 Bytes)
  376. Declare Function midiOutShortMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal dwMsg&)
  377. 'Envia un missatge llarg (SYSEX) pel Midi Out
  378. Declare Function midiOutLongMsg% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpMidiOutHdr As MIDIHDR, ByVal uSize%)
  379. 'Reset al dispositiu Midi Out
  380. Declare Function midiOutReset% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%)
  381. 'Cache els patches de sons
  382. Declare Function midiOutCachePatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uBank%, lpwPatchArray%, ByVal uFlags%)
  383. 'Cache els patches de drums
  384. Declare Function midiOutCacheDrumPatches% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uPatch%, lpwKeyArray%, ByVal uFlags%)
  385. 'Pregunta ID d'un dispositiu
  386. Declare Function midiOutGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, lpuDeviceID%)
  387. 'Envia un Byte pel Midi Out
  388. Declare Function midiOutMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiOut%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  389.  
  390. 'Funcions MIDI IN
  391. Declare Function midiInGetNumDevs% Lib "MMSYSTEM.DLL" ()
  392. Declare Function midiInGetDevCaps% Lib "MMSYSTEM.DLL" (ByVal uDeviceID%, lpCaps As MidiInCaps, ByVal uSize%)
  393. Declare Function midiInGetErrorText% Lib "MMSYSTEM.DLL" (ByVal uError%, ByVal lpText$, ByVal uSize%)
  394. Declare Function midiInOpen% Lib "MMSYSTEM.DLL" (lphMidiIn As Integer, ByVal uDeviceID%, ByVal dwCallback&, ByVal dwInstance&, ByVal dwFlags&)
  395. Declare Function midiInClose% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  396. Declare Function midiInPrepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  397. Declare Function midiInUnprepareHeader% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  398. Declare Function midiInAddBuffer% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpMidiInHdr As MIDIHDR, ByVal uSize%)
  399. Declare Function midiInStart% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  400. Declare Function midiInStop% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  401. Declare Function midiInReset% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%)
  402. Declare Function midiInGetID% Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, lpuDeviceID%)
  403. Declare Function midiInMessage& Lib "MMSYSTEM.DLL" (ByVal hMidiIn%, ByVal uMessage%, ByVal dw1&, ByVal dw2&)
  404.  
  405. ' Temps del sistema en alta resoluci≤ (Multimedia)
  406. Declare Function timeGetTime& Lib "mmsystem" ()
  407.  
  408. 'Translates a Midi Error into a Message Box.
  409. Sub Alerta_MidiError (er As Integer)
  410.     Dim Msg As String
  411.  
  412.     Select Case er
  413.         Case MMSYSERR_BADDEVICEID
  414.             Msg = "Bad Device ID! "
  415.         Case MMSYSERR_NOTENABLED
  416.             Msg = "Device not Enabled!"
  417.         Case MMSYSERR_ALLOCATED
  418.             Msg = "Device allready allocated!"
  419.         Case MMSYSERR_INVALHANDLE
  420.             Msg = "Invalid Device Handle!"
  421.         Case MMSYSERR_NODRIVER
  422.             Msg = "No Driver!"
  423.         Case MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)
  424.             Msg = "Out of Memory!"
  425.         Case MMSYSERR_NOTSUPPORTED
  426.             Msg = "Function not supported!"
  427.         Case MMSYSERR_BADERRNUM
  428.             Msg = "Bad Error Number!"
  429.         Case MMSYSERR_INVALFLAG
  430.             Msg = "Invalid Flag!"
  431.         Case MMSYSERR_INVALPARAM
  432.             Msg = "Invalid Parameter!"
  433.         Case MMSYSERR_LASTERROR
  434.             Msg = "System last Error!"
  435.         Case MIDIERR_UNPREPARED
  436.             Msg = "Header unprepared!"
  437.         Case MIDIERR_STILLPLAYING
  438.             Msg = "Still Playing!"
  439.         Case MIDIERR_NOMAP
  440.             Msg = "No MIDI Mapper!"
  441.         Case MIDIERR_NOTREADY
  442.             Msg = "Hardware not ready! "
  443.         Case MIDIERR_NODEVICE
  444.             Msg = "No Device!"
  445.         Case MIDIERR_INVALIDSETUP
  446.             Msg = "Invalid Setup!"
  447.         Case MIDIERR_LASTERROR
  448.             Msg = "MIDI Last Error!"
  449.         Case Else
  450.             Msg = "Unexpected Error!"
  451.     End Select
  452.  
  453.     Dlg_Alert (Msg)
  454. End Sub
  455.  
  456. Sub Display_Adjust ()
  457.     Dim st As String
  458.  
  459.     While disp_fff >= Frame_Mode
  460.         disp_fff = disp_fff - Frame_Mode
  461.         disp_sss = disp_sss + 1
  462.     Wend
  463.  
  464.     While disp_sss >= 60
  465.         disp_sss = disp_sss - 60
  466.         disp_mmm = disp_mmm + 1
  467.     Wend
  468.  
  469.     While disp_mmm >= 60
  470.         disp_mmm = disp_mmm - 60
  471.         disp_hhh = disp_hhh + 1
  472.     Wend
  473.  
  474.     While disp_hhh >= 24
  475.         disp_hhh = disp_hhh - 24
  476.     Wend
  477.  
  478.     While disp_fff < 0
  479.         disp_fff = disp_fff + Frame_Mode
  480.         disp_sss = disp_sss - 1
  481.     Wend
  482.  
  483.     While disp_sss < 0
  484.         disp_sss = disp_sss + 60
  485.         disp_mmm = disp_mmm - 1
  486.     Wend
  487.  
  488.     While disp_mmm < 0
  489.         disp_mmm = disp_mmm + 60
  490.         disp_hhh = disp_hhh - 1
  491.     Wend
  492.  
  493.     While disp_hhh < 0
  494.         disp_hhh = disp_hhh + 24
  495.     Wend
  496.  
  497.     st = Format$(disp_hhh, "00")
  498.     If MTCForm.txtHours.Caption <> st Then MTCForm.txtHours.Caption = st
  499.     st = Format$(disp_mmm, "00")
  500.     If MTCForm.txtMinutes.Caption <> st Then MTCForm.txtMinutes.Caption = st
  501.     st = Format$(disp_sss, "00")
  502.     If MTCForm.txtSeconds.Caption <> st Then MTCForm.txtSeconds.Caption = st
  503.     MTCForm.txtFrames.Caption = Format$(disp_fff, "00")
  504. End Sub
  505.  
  506. Sub Dlg_Alert (m$)
  507.      Beep
  508.      MsgBox m$, MB_OK + MB_ICONEXCLAMATION, "ALERT"
  509. End Sub
  510.  
  511. Sub Erase_Display ()
  512.     MTCForm.txtHours = "--"
  513.     MTCForm.txtMinutes = "--"
  514.     MTCForm.txtSeconds = "--"
  515.     MTCForm.txtFrames = "--"
  516. End Sub
  517.  
  518. Function IsNumber (kk As Integer)
  519.     Select Case kk
  520.         Case Asc("0") To Asc("9")
  521.             IsNumber = True
  522.         Case KEY_NUMPAD0 To KEY_NUMPAD9
  523.             IsNumber = True
  524.         Case Else
  525.             IsNumber = False
  526.     End Select
  527. End Function
  528.  
  529. Function KeyToNumber (KeyCode) As Integer
  530.     If KeyCode >= Asc("0") And KeyCode <= Asc("9") Then
  531.         KeyToNumber = KeyCode - Asc("0")
  532.     ElseIf KeyCode >= KEY_NUMPAD0 And KeyCode <= KEY_NUMPAD9 Then
  533.         KeyToNumber = KeyCode - KEY_NUMPAD0
  534.     Else
  535.         KeyToNumber = -1
  536.     End If
  537. End Function
  538.  
  539. 'Tanca el port Midi In
  540. Sub MidiIn_Close ()
  541.     If hMidiIn <> NO_HANDLE Then
  542.         MTCForm.MidiHook.Message(MIM_DATA) = False
  543.  
  544.         ret = midiInStop(hMidiIn)
  545.         If ret <> 0 Then
  546.             Alerta_MidiError (ret)
  547.             Exit Sub
  548.         End If
  549.  
  550.         ret = midiInClose(hMidiIn)
  551.         hMidiIn = NO_HANDLE
  552.         If ret <> 0 Then
  553.             Alerta_MidiError (ret)
  554.             Exit Sub
  555.         End If
  556.     End If
  557. End Sub
  558.  
  559. 'Obre un port Midi In
  560. Sub MidiIn_Open (nDevice)
  561.     MTCForm.MidiHook.HwndHook = MTCForm.hWnd
  562.     MTCForm.MidiHook.Message(MIM_DATA) = True
  563.  
  564.     MidiIn_Close
  565.  
  566.     ret = midiInOpen(hMidiIn, nDevice, MTCForm.hWnd, 0, CALLBACK_WINDOW)
  567.     If ret <> 0 Then
  568.         Alerta_MidiError (ret)
  569.         hMidiIn = NO_HANDLE
  570.         Exit Sub
  571.     End If
  572.  
  573.     ret = midiInStart(hMidiIn)
  574.         If ret <> 0 Then
  575.             Alerta_MidiError (ret)
  576.             ret = midiInClose(hMidiIn)
  577.         Exit Sub
  578.     End If
  579. End Sub
  580.  
  581. 'Llegeix un missatge guardat a InBuffer
  582. 'Si no hi ha cap missatge torna 0
  583. Function MidiIn_Read () As Long
  584.     Dim Msg As Long
  585.  
  586.     If BuffCounter = 0 Then
  587.         MidiIn_Read = 0&
  588.         Exit Function
  589.     End If
  590.  
  591.     Do                           'Wait que flgChangeIt sigui True
  592.         If flgChangeIt = True Then
  593.             flgChangeIt = False
  594.             Exit Do              'surt del bucle
  595.         End If
  596.         DoEvents
  597.     Loop
  598.  
  599.     MidiIn_Read = InBuffer(ReadIndex)
  600.     ReadIndex = ReadIndex + 1
  601.     If ReadIndex = BUFFSIZE Then ReadIndex = 0     'D≤na la volta
  602.     BuffCounter = BuffCounter - 1
  603.     flgChangeIt = True
  604. End Function
  605.  
  606. 'Tanca Midi Out
  607. Sub MidiOut_Close ()
  608.  
  609.     If hMidiOut <> NO_HANDLE Then
  610.         ret = midiOutClose(hMidiOut)
  611.         If ret <> 0 Then
  612.             Alerta_MidiError (ret)
  613.             Exit Sub
  614.         End If
  615.         hMidiOut = NO_HANDLE
  616.     End If
  617. End Sub
  618.  
  619. 'Obre un dispositiu Midi Out
  620. Sub MidiOut_Open (nDevice)
  621.     MidiOut_Close
  622.     ret = midiOutOpen(hMidiOut, nDevice, 0, 0, 0)
  623.     If ret <> 0 Then
  624.         Alerta_MidiError (ret)
  625.         Exit Sub
  626.     End If
  627. End Sub
  628.  
  629. 'Envia un codi pel Midi Out
  630. Function MidiOut_Write (Msg As Long) As Integer
  631.  
  632.     MidiOut_Write = True
  633.  
  634.     ret = midiOutShortMsg(hMidiOut, Msg)
  635.     If ret <> 0 Then
  636.         Alerta_MidiError (ret)
  637.         MidiOut_Write = False
  638.         Exit Function
  639.     End If
  640.     MTCForm.OutShow.Caption = "u"
  641. End Function
  642.  
  643. Sub MTC_Read ()
  644.     Dim Msg As Long, dd As Integer, oldt As Long, newt As Long
  645.     Dim ln As Integer, Expected As Integer
  646.     Dim flgCatching As Integer, tt As Integer, st As String
  647.     Dim h As Integer, m As Integer, s As Integer, f As Integer
  648.  
  649.     Erase_Display
  650.     flgCatching = True
  651.     Expected = &H0
  652.     flgReadStop = False
  653.  
  654.     oldt = timeGetTime()
  655.     While flgReadStop = False
  656.         newt = timeGetTime()
  657.  
  658.         If newt - oldt > 3000 Then   '3 segons
  659.             Erase_Display
  660.             flgCatching = True
  661.             Expected = &H0
  662.         End If
  663.  
  664.         Msg = MidiIn_Read()
  665.         If Msg = 0& Then GoTo ReadLoop_End
  666.         If (Msg And &HFF) <> &HF1 Then GoTo ReadLoop_End
  667.         oldt = newt
  668.         dd = (Msg And &HFF00) / 256
  669.         Select Case (dd And &HF0)
  670.             Case &H0:
  671.                 If Expected <> &H0 Then
  672.                     Erase_Display
  673.                     flgCatching = True
  674.                     Expected = &H0
  675.                 Else
  676.                     ln = (dd And &HF)
  677.                     Expected = &H10
  678.                 End If
  679.  
  680.             Case &H10:
  681.                 If Expected <> &H10 Then
  682.                     Erase_Display
  683.                     flgCatching = True
  684.                     Expected = &H0
  685.                 Else
  686.                     f = (dd And &HF) * 16 + ln
  687.                     Expected = &H20
  688.                 End If
  689.  
  690.             Case &H20:
  691.                 If Expected <> &H20 Then
  692.                     Erase_Display
  693.                     flgCatching = True
  694.                     Expected = &H0
  695.                 Else
  696.                     ln = (dd And &HF)
  697.                     Expected = &H30
  698.                 End If
  699.  
  700.             Case &H30:
  701.                 If Expected <> &H30 Then
  702.                     Erase_Display
  703.                     flgCatching = True
  704.                     Expected = &H0
  705.                 Else
  706.                     s = (dd And &HF) * 16 + ln
  707.                     Expected = &H40
  708.                 End If
  709.  
  710.             Case &H40:
  711.                 If Expected <> &H40 Then
  712.                     Erase_Display
  713.                     flgCatching = True
  714.                     Expected = &H0
  715.                 Else
  716.                     If flgCatching = False Then
  717.                         fff = fff + 1
  718.                         SMPTE_Adjust
  719.                         disp_fff = disp_fff + 1
  720.                         Display_Adjust
  721.                     End If
  722.                     ln = (dd And &HF)
  723.                     Expected = &H50
  724.                 End If
  725.  
  726.             Case &H50:
  727.                 If Expected <> &H50 Then
  728.                     Erase_Display
  729.                     flgCatching = True
  730.                     Expected = &H0
  731.                 Else
  732.                     m = (dd And &HF) * 16 + ln
  733.                     Expected = &H60
  734.                 End If
  735.  
  736.             Case &H60:
  737.                 If Expected <> &H60 Then
  738.                     Erase_Display
  739.                     flgCatching = True
  740.                     Expected = &H0
  741.                 Else
  742.                     ln = (dd And &HF)
  743.                     Expected = &H70
  744.                 End If
  745.  
  746.             Case &H70:
  747.                 If Expected <> &H70 Then
  748.                     Erase_Display
  749.                     flgCatching = True
  750.                     Expected = &H0
  751.                 Else
  752.                     h = (dd And &H1) * 16 + ln
  753.                     tt = (dd And &H6) / 2
  754.  
  755.                     If flgCatching = False Then
  756.                         If SMPTE_to_Frames(h, m, s, f) - SMPTE_to_Frames(hhh, mmm, sss, fff) <> 1& Then
  757.                             Erase_Display
  758.                             flgCatching = True
  759.                             Expected = &H0
  760.                         Else
  761.                             fff = fff + 1
  762.                             disp_fff = disp_fff + 1
  763.                         End If
  764.                     Else
  765.                         flgCatching = False
  766.                         hhh = h
  767.                         disp_hhh = h
  768.                         mmm = m
  769.                         disp_mmm = m
  770.                         sss = s
  771.                         disp_sss = s
  772.                         fff = f + 2
  773.                         disp_fff = f + 2
  774.                         TC_Type = tt
  775.                         Select Case tt
  776.                             Case 0:
  777.                                 Ms_per_QF = 250 / 24
  778.                                 Frame_Mode = 24
  779.                                 st = "SMPTE : 24 Fr/s"
  780.                             Case 1:
  781.                                 Ms_per_QF = 250 / 25
  782.                                 Frame_Mode = 25
  783.                                 st = "SMPTE : 25 Fr/s"
  784.                             Case 2:
  785.                                 Ms_per_QF = 250 / 29
  786.                                 Frame_Mode = 29
  787.                                 st = "SMPTE : 30 (Drop-Frame)"
  788.                             Case 3:
  789.                                 Ms_per_QF = 250 / 30
  790.                                 Frame_Mode = 30
  791.                                 st = "SMPTE : 30 (Non-Drop)"
  792.                         End Select
  793.                         If MTCForm.Caption <> st Then MTCForm.Caption = st
  794.                     End If
  795.                     SMPTE_Adjust
  796.                     Display_Adjust
  797.                     Expected = &H0
  798.                 End If
  799.  
  800.         End Select
  801.  
  802. ReadLoop_End:
  803.         DoEvents
  804.     Wend
  805. End Sub
  806.  
  807. Sub MTC_Write ()
  808.     Dim CurrentTime As Long, OldTime As Long
  809.     Dim Msg As Long
  810.  
  811.     OldTime = timeGetTime()
  812.     QF_Counter = 0
  813.     flgStop = False
  814.     While flgStop = False
  815.         CurrentTime = timeGetTime()
  816.         If CurrentTime - OldTime > Ms_per_QF Then
  817.             If QF_Send() = False Then Exit Sub
  818.             OldTime = OldTime + Ms_per_QF
  819.             QF_Counter = QF_Counter + 1
  820.             If QF_Counter = 4 Then
  821.                 disp_fff = disp_fff + 1  'Change display every frame
  822.                 Display_Adjust
  823.             ElseIf QF_Counter = 8 Then
  824.                 disp_fff = disp_fff + 1  'Change display every frame
  825.                 Display_Adjust
  826.                 fff = fff + 2            'Change MTC every two frames
  827.                 SMPTE_Adjust
  828.                 QF_Counter = 0
  829.             End If
  830.             DoEvents
  831.         End If
  832.     Wend
  833. End Sub
  834.  
  835. Sub Panic ()
  836.     ret = midiInClose(966)    'Usual Device Handles
  837.     ret = midiInClose(986)
  838.     ret = midiOutClose(966)
  839.     ret = midiOutClose(986)
  840. End Sub
  841.  
  842. Function QF_Send () As Integer
  843.     Dim tt As Long, nbl As Integer
  844.  
  845.     tt = &HF1&
  846.     Select Case QF_Counter
  847.         Case 0:
  848.             nbl = &H0 + (fff And &HF)           'f [ffff]
  849.             tt = tt + nbl * 256
  850.         Case 1:
  851.             nbl = &H10 + (fff And &H10) / 16   '[f] ffff
  852.             tt = tt + nbl * 256
  853.         Case 2:
  854.             nbl = &H20 + (sss And &HF)          'ss [ssss]
  855.             tt = tt + nbl * 256
  856.         Case 3:
  857.             nbl = &H30 + (sss And &H30) / 16    '[ss] ssss
  858.             tt = tt + nbl * 256
  859.         Case 4:
  860.             nbl = &H40 + (mmm And &HF)          'mm [mmmm]
  861.             tt = tt + nbl * 256
  862.         Case 5:
  863.             nbl = &H50 + (mmm And &H30) / 16    '[mm] mmmm
  864.             tt = tt + nbl * 256
  865.         Case 6:
  866.             nbl = &H60 + (hhh And &HF)          'h [hhhh]
  867.             tt = tt + nbl * 256
  868.         Case 7:
  869.             nbl = &H70 + (hhh And &H10) / 16    '[h] hhhh
  870.             nbl = nbl + TC_Type * 2             '[tth]
  871.             tt = tt + nbl * 256
  872.     End Select
  873.     QF_Send = MidiOut_Write(tt)
  874. End Function
  875.  
  876. 'Inicialitza el buffer de Midi In
  877. Sub Reset_BufferIn ()
  878.     flgChangeIt = False
  879.     WriteIndex = 0
  880.     ReadIndex = 0
  881.     BuffCounter = 0
  882.     flgChangeIt = True
  883. End Sub
  884.  
  885. Sub SMPTE_Adjust ()
  886.     Dim st As String
  887.  
  888.     While fff >= Frame_Mode
  889.         fff = fff - Frame_Mode
  890.         sss = sss + 1
  891.     Wend
  892.  
  893.     While sss >= 60
  894.         sss = sss - 60
  895.         mmm = mmm + 1
  896.     Wend
  897.  
  898.     While mmm >= 60
  899.         mmm = mmm - 60
  900.         hhh = hhh + 1
  901.     Wend
  902.  
  903.     While hhh >= 24
  904.         hhh = hhh - 24
  905.     Wend
  906.  
  907.     While fff < 0
  908.         fff = fff + Frame_Mode
  909.         sss = sss - 1
  910.     Wend
  911.  
  912.     While sss < 0
  913.         sss = sss + 60
  914.         mmm = mmm - 1
  915.     Wend
  916.  
  917.     While mmm < 0
  918.         mmm = mmm + 60
  919.         hhh = hhh - 1
  920.     Wend
  921.  
  922.     While hhh < 0
  923.         hhh = hhh + 24
  924.     Wend
  925.  
  926. End Sub
  927.  
  928. Function SMPTE_to_Frames (h, m, s, f) As Long
  929.     Dim rr As Long
  930.  
  931.     rr = (h * 3600& + m * 60 + s) * Frame_Mode + f
  932.     SMPTE_to_Frames = rr
  933. End Function
  934.  
  935. Function SMPTE_to_Ms (hh As Integer, mm As Integer, ss As Integer, ff As Integer) As Long
  936.     Dim rr As Long
  937.  
  938.     rr = hh * 3600000 + mm * 60000 + ss * 1000 + ff * (1000 / Frame_Mode)
  939.     SMPTE_to_Ms = rr
  940. End Function
  941.  
  942. Sub Wait (tt As Long)
  943.     Dim t1 As Long, t2 As Long
  944.  
  945.     t1 = timeGetTime()
  946.     Do
  947.         t2 = timeGetTime()
  948.     Loop Until t2 - t1 >= tt
  949. End Sub
  950.  
  951.