home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 November - Disc 2 / PCNET_CD_2006_11_2.iso / apps / Swishstudio2.exe / Main / Midi.cls < prev    next >
Encoding:
Visual Basic class definition  |  2006-10-05  |  8.8 KB  |  242 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 1  'Persistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Midi"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15.  
  16. ' Error values for functions used in this sample.
  17. ' These error values obtained from the include file mmsystem.h (a vc file).
  18. ' A descrption of the system functions in the winmm.dll can be found at
  19. ' http://msdn.microsoft.com/ (search for winmm.lib and midi).
  20. ' winmm.lib is the Windows Multimedia SDK.
  21. '
  22. '#define MMSYSERR_BASE          0
  23. '#define WAVERR_BASE            32
  24. '#define MIDIERR_BASE           64
  25. '#define TIMERR_BASE            96
  26. '#define JOYERR_BASE            160
  27. '#define MCIERR_BASE            256
  28. '#define MIXERR_BASE            1024
  29.  
  30. '#define MMSYSERR_NOERROR      0                    /* no error */
  31. '#define MMSYSERR_ERROR        (MMSYSERR_BASE + 1)  /* unspecified error */
  32. '#define MMSYSERR_BADDEVICEID  (MMSYSERR_BASE + 2)  /* device ID out of range */
  33. '#define MMSYSERR_NOTENABLED   (MMSYSERR_BASE + 3)  /* driver failed enable */
  34. '#define MMSYSERR_ALLOCATED    (MMSYSERR_BASE + 4)  /* device already allocated */
  35. '#define MMSYSERR_INVALHANDLE  (MMSYSERR_BASE + 5)  /* device handle is invalid */
  36. '#define MMSYSERR_NODRIVER     (MMSYSERR_BASE + 6)  /* no device driver present */
  37. '#define MMSYSERR_NOMEM        (MMSYSERR_BASE + 7)  /* memory allocation error */
  38. '#define MMSYSERR_NOTSUPPORTED (MMSYSERR_BASE + 8)  /* function isn't supported */
  39. '#define MMSYSERR_BADERRNUM    (MMSYSERR_BASE + 9)  /* error value out of range */
  40. '#define MMSYSERR_INVALFLAG    (MMSYSERR_BASE + 10) /* invalid flag passed */
  41. '#define MMSYSERR_INVALPARAM   (MMSYSERR_BASE + 11) /* invalid parameter passed */
  42. '#define MMSYSERR_HANDLEBUSY   (MMSYSERR_BASE + 12) /* handle being used */
  43. '                                                   /* simultaneously on another */
  44. '                                                   /* thread (eg callback) */
  45. '#define MMSYSERR_INVALIDALIAS (MMSYSERR_BASE + 13) /* specified alias not found */
  46. '#define MMSYSERR_BADDB        (MMSYSERR_BASE + 14) /* bad registry database */
  47. '#define MMSYSERR_KEYNOTFOUND  (MMSYSERR_BASE + 15) /* registry key not found */
  48. '#define MMSYSERR_READERROR    (MMSYSERR_BASE + 16) /* registry read error */
  49. '#define MMSYSERR_WRITEERROR   (MMSYSERR_BASE + 17) /* registry write error */
  50. '#define MMSYSERR_DELETEERROR  (MMSYSERR_BASE + 18) /* registry delete error */
  51. '#define MMSYSERR_VALNOTFOUND  (MMSYSERR_BASE + 19) /* registry value not found */
  52. '#define MMSYSERR_NODRIVERCB   (MMSYSERR_BASE + 20) /* driver does not call DriverCallback */
  53. '#define MMSYSERR_MOREDATA     (MMSYSERR_BASE + 21) /* more data to be returned */
  54. '#define MMSYSERR_LASTERROR    (MMSYSERR_BASE + 21) /* last error in range */
  55.  
  56.  
  57. 'User-defined variable the stores information about the MIDI output device.
  58. 'below is a VB representation of the C structure defined on MSDN.
  59. 'see http://msdn.microsoft.com/library/default.asp?url=/library/en-us/multimed/htm/_win32_midioutcaps_str.asp
  60.  
  61. Const MAXPNAMELEN = 32              ' Maximum product name length
  62.  
  63. Private Type MIDIOUTCAPS
  64.     wMid As Integer
  65.     wPid As Integer
  66.     vDriverVersion As Long
  67.     szPname As String * MAXPNAMELEN
  68.     wTechnology As Integer
  69. '/* flags for wTechnology field of MIDIOUTCAPS structure */
  70. '#define MOD_MIDIPORT    1  /* output port */
  71. '#define MOD_SYNTH       2  /* generic internal synth */
  72. '#define MOD_SQSYNTH     3  /* square wave internal synth */
  73. '#define MOD_FMSYNTH     4  /* FM internal synth */
  74. '#define MOD_MAPPER      5  /* MIDI mapper */
  75. '#define MOD_WAVETABLE   6  /* hardware wavetable synth */
  76. '#define MOD_SWSYNTH     7  /* software synth */
  77.     wVoices As Integer
  78.     wNotes As Integer
  79.     wChannelMask As Integer
  80.     dwSupport As Long
  81. '/* flags for dwSupport field of MIDIOUTCAPS structure */
  82. '#define MIDICAPS_VOLUME          0x0001  /* supports volume control */
  83. '#define MIDICAPS_LRVOLUME        0x0002  /* separate left-right volume control */
  84. '#define MIDICAPS_CACHE           0x0004
  85. '#define MIDICAPS_STREAM          0x0008  /* driver supports midiStreamOut directly */
  86.  
  87. End Type
  88.  
  89. ' the following are VB wrapper functions to access the system midi functions in the winmm.dll
  90. ' additional information on each of these functions can be found by searching for the function name at
  91. ' http://msdn.microsoft.com
  92. Private Declare Function midiOutGetNumDevs Lib "winmm.dll" () As Integer
  93.  
  94. Private Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" _
  95. (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
  96.  
  97. Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
  98.  
  99. Private Declare Function midiOutOpen Lib "winmm.dll" _
  100. (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  101.  
  102. Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
  103.  
  104. ' ************************************************************************
  105. ' Active X interface functions below.
  106. ' Each of the MIDIOUTCAPS items is accessed via a property.
  107.  
  108. ' Global variables
  109. Dim midicaps As MIDIOUTCAPS ' holds the capability of the MIDI device.
  110. Dim hMidi As Long ' handle to the midi device. Only support single device.
  111.  
  112. Public Property Get OutNumDevs()
  113.     OutNumDevs = midiOutGetNumDevs()
  114. End Property
  115.  
  116. Public Function LoadOutDevCaps(id)
  117.     LoadOutDevCaps = midiOutGetDevCaps(id, midicaps, Len(midicaps))
  118. End Function
  119.  
  120. Public Property Get ProdName()
  121.     ProdName = midicaps.szPname
  122. End Property
  123.  
  124. Public Property Get ManufId()
  125.     ManufId = midicaps.wMid
  126. End Property
  127.  
  128. Public Property Get ProdId()
  129.    ProdId = midicaps.wPid
  130. End Property
  131.  
  132. Public Property Get DriverVers()
  133.    DriverVers = midicaps.vDriverVersion
  134. End Property
  135. Public Property Get Technology()
  136.    Technology = midicaps.wTechnology
  137. End Property
  138.  
  139. Public Property Get Voices()
  140.    Voices = midicaps.wVoices
  141. End Property
  142.                                      
  143. Public Property Get Notes()
  144.     Notes = midicaps.wNotes
  145. End Property
  146.                                      
  147. Public Property Get ChannelMask()
  148.    ChannelMask = midicaps.wChannelMask
  149. End Property
  150.                                      
  151. Public Property Get SupportMask()
  152.    SupportMask = midicaps.dwSupport
  153. End Property
  154.  
  155. Public Function OutOpen(DeviceID)
  156.     Call midiOutClose(hMidi)  ' close if already open
  157.     OutOpen = midiOutOpen(hMidi, DeviceID, 0, 0, 0)
  158. End Function
  159.  
  160. Public Function OutClose()
  161.     OutClose = midiOutClose(hMidi)
  162. End Function
  163.  
  164. Public Function OutShortMessage(Msg)
  165.     OutShortMessage = midiOutShortMsg(hMidi, Msg)
  166. End Function
  167.  
  168. Public Function NoteStart(channel, note, Velocity) As String
  169. ' turn note on. simpler than calling OutShortMessage
  170.     Dim Msg
  171.     
  172.     If channel < 0 Or channel > 15 Then
  173.         NoteStart = "Bad channel number: " + channel
  174.         Return
  175.     End If
  176.     
  177.     If note < 0 Or note > 127 Then
  178.         NoteStart = "Bad note: " + note
  179.         Return
  180.     End If
  181.     
  182.     If Velocity < 0 Or Velocity > 127 Then
  183.         NoteStart = "Bad velocity: " + Velocity
  184.         Return
  185.     End If
  186.     
  187.     Msg = &H90 + ((note) * &H100) + (Velocity * &H10000) + channel
  188.     NoteStart = midiOutShortMsg(hMidi, Msg)
  189. End Function
  190.  
  191. Public Function NoteStop(channel, note) As String
  192. ' turn note off. simpler than calling OutShortMessage
  193.     Dim Msg
  194.     
  195.     If channel < 0 Or channel > 15 Then
  196.         NoteStop = "Bad channel number: " + channel
  197.         Return
  198.     End If
  199.     
  200.     If note < 0 Or note > 127 Then
  201.         NoteStop = "Bad note: " + note
  202.         Return
  203.     End If
  204.  
  205.     Msg = &H80 + ((note) * &H100) + channel
  206.     NoteStop = midiOutShortMsg(hMidi, Msg)
  207. End Function
  208.  
  209. Public Function Patch(channel, voice) As String
  210. ' Patch voice to channel. simpler than calling OutShortMessage
  211.     Dim Msg
  212.     
  213.     If channel < 0 Or channel > 15 Then
  214.         Patch = "Bad channel number: " + channel
  215.         Return
  216.     End If
  217.     
  218.     If voice < 0 Or voice > 127 Then
  219.         Patch = "Bad voice number: " + voice
  220.         Return
  221.     End If
  222.     
  223.     Msg = &HC0 + ((voice) * &H100) + channel
  224.     Patch = midiOutShortMsg(hMidi, Msg)
  225. End Function
  226.  
  227. Public Function PatchBank(bank) As String
  228. ' Patch 16 voices to channels. simpler than calling Patch multiple times.
  229.     Dim base
  230.     Dim i, Msg
  231.     If bank < 0 Or bank > 7 Then
  232.         PatchBank = "bad bank number: " + bank
  233.         Return
  234.     End If
  235.     base = bank * 16 ' calculate base value
  236.     For i = 0 To 15
  237.         Call Patch(i, base + i)
  238.     Next i
  239.     PatchBank = "OK"
  240. End Function
  241.  
  242.