home *** CD-ROM | disk | FTP | other *** search
/ Mundo do CD-ROM 16 / CDROM16.iso / nando / MUSICA / PIANO.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-02-09  |  2.5 KB  |  66 lines
  1. ' MIDI Functions Windows 3.1
  2. Declare Function MidiOutOpen Lib "mmsystem.dll" (hMidiOut As Long, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  3. Declare Function MidiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  4. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  5. Declare Function MidiOutSetVolume Lib "mmsystem.dll" (ByVal wDeviceID As Integer, ByVal dwVolume As Long) As Integer
  6. Declare Function MidiOutGetID Lib "mmsystem.dll" (ByVal hMidOut As Integer, lpwDeviceID As Integer) As Integer
  7.  
  8. ' Other API Functions
  9. Declare Function GetPrivateProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Def$, ByVal Ret$, ByVal Size%, ByVal Fname$) As Integer
  10. Declare Function sndPlaySound Lib "mmsystem" (ByVal lpsSound As String, ByVal wFlag As Integer) As Integer
  11.  
  12. Global MidiEventOut, MidiNoteOut, MidiVelOut As Long
  13. Global hMidiOut As Long
  14. Global hMidiOutCopy As Integer
  15. Global MidiOpenError As String
  16.  
  17. Global Const MODAL = 1
  18. Global Const ShiftKey = 1
  19.  
  20. ' The Patch number array used for current patch for each midi channel
  21. ' Then Volume array used for each channels volume setting
  22. ' TrackChannel is array for the current midi channel that that Track on the mixi is set to.
  23. Global MidiPatch(16), MidiVolume(16), TrackChannel(16), MidiPan(16), Octave(16) As Integer
  24.  
  25. ' The current Midi Channel out set on Piano form
  26. Global MidiChannelOut As Integer
  27.  
  28. ' The Velocity (Volume) of notes for current midi channel
  29. Global MidiVelocity As Integer
  30.  
  31. 'Boolean for it CapsLock has been pressed or not
  32. Global CapsLock As Integer
  33.  
  34. ' NoteRepeat used to stop the same key from repeating.  CapsLock detects if it is down.
  35. Global NoteRepeat As Integer
  36.  
  37. Sub MidiOutOpenPort ()
  38.     MidiOpenError = Str$(MidiOutOpen(hMidiOut, -1, 0, 0, 0))
  39.     hMidiOutCopy = hMidiOut
  40. End Sub
  41.  
  42. Sub ReadPatch ()
  43.     Dim Sname As String, Ret As String, Ext As String
  44.     Ret = String$(255, 0)
  45.     Default1$ = Ret
  46.     Sname = "General MIDI"
  47.     Ext = Str$(MidiPatch(MidiChannelOut))
  48.     FileName$ = App.Path & "\PATCH.INI"
  49.     nSize = GetPrivateProfileString(Sname, Ext, Default1$, Ret, Len(Ret), FileName$)
  50.     'FRM_Piano.PatchLabel.Caption = Ret
  51. End Sub
  52.  
  53. Sub SendMidiOut ()
  54.     
  55.     Dim MidiMessage As Long
  56.     Dim lowint As Long
  57.     Dim highint As Long
  58.     
  59.     lowint = (MidiNoteOut * 256) + MidiEventOut
  60.     highint = (MidiVelOut * 256) * 256
  61.  
  62.     MidiMessage = lowint + highint
  63.     X% = MidiOutShortMsg(hMidiOutCopy, MidiMessage)
  64. End Sub
  65.  
  66.