home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_2 / VB_PIANO / PIANO.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-09-03  |  3.0 KB  |  76 lines
  1. Declare Function GetWindowsDirectory Lib "kernel" (ByVal P$, ByVal S%) As Integer
  2. Declare Function GetModuleHandle Lib "kernel" (ByVal FileName$) As Integer
  3. Declare Function GetModuleFileName Lib "kernel" (ByVal hModule%, ByVal FilName$, ByVal nSize%) As Integer
  4. Global PianoPath As String
  5.  
  6. ' MIDI Functions Windows 3.1
  7. 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
  8. Declare Function MidiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  9. Declare Function MidiOutGetNumDevs Lib "mmsystem.dll" () As Integer
  10. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  11.  
  12. Global MidiEventOut, MidiNoteOut, MidiVelOut As Long
  13.  
  14. Global hMidiOut As Long
  15. Global hMidiOutCopy As Integer
  16. Global MidiOpenError As String
  17.  
  18. Global Const MODAL = 1
  19.  
  20. Global Const ShiftKey = 1
  21.  
  22. Declare Function GetProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Def$, ByVal Ret$, ByVal Size%) As Integer
  23. Declare Function WriteProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Set1$) As Integer
  24. Declare Function GetPrivateProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Def$, ByVal Ret$, ByVal Size%, ByVal Fname$) As Integer
  25. Declare Function WritePrivateProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Set1$, ByVal Fname$) As Integer
  26.  
  27. ' The Patch number array used for current patch for each midi channel
  28. ' Then Volume array used for each channels volume setting
  29. ' TrackChannel is array for the current midi channel that that Track on the mixi is set to.
  30. Global MidiPatch(16), MidiVolume(16), TrackChannel(16), MidiPan(16), Octave(16) As Integer
  31.  
  32. ' The current Midi Channel out set on Piano form
  33. Global MidiChannelOut As Integer
  34.  
  35. ' The Velocity (Volume) of notes for current midi channel
  36. Global MidiVelocity As Integer
  37.  
  38. 'Boolean for it CapsLock has been pressed or not
  39. Global CapsLock As Integer
  40.  
  41. ' NoteRepeat used to stop the same key from repeating.  CapsLock detects if it is down.
  42. Global NoteRepeat As Integer
  43.  
  44. ' Play wave sounds
  45. Declare Function sndPlaySound Lib "mmsystem" (ByVal lpsSound As String, ByVal wFlag As Integer) As Integer
  46.  
  47. Sub MidiOutOpenPort ()
  48.     'Open Midi Out while song is not playing
  49.     MidiOpenError = Str$(MidiOutOpen(hMidiOut, -1, 0, 0, 0))
  50.     hMidiOutCopy = hMidiOut
  51. End Sub
  52.  
  53. Sub ReadPatch ()
  54.     Dim Sname As String, Ret As String, Ext As String
  55.     Ret = String$(255, 0)
  56.     Default1$ = Ret
  57.     Sname = "General MIDI"
  58.     Ext = Str$(MidiPatch(MidiChannelOut))
  59.     FileName$ = "PATCH.INI"
  60.     nSize = GetPrivateProfileString(Sname, Ext, Default1$, Ret, Len(Ret), FileName$)
  61.     Piano.PatchLabel.Caption = Ret
  62. End Sub
  63.  
  64. Sub SendMidiOut ()
  65.     Dim MidiMessage As Long
  66.     Dim lowint As Long
  67.     Dim highint As Long
  68.     
  69.     lowint = (MidiNoteOut * 256) + MidiEventOut
  70.     highint = (MidiVelOut * 256) * 256
  71.  
  72.     MidiMessage = lowint + highint
  73.     X% = MidiOutShortMsg(hMidiOutCopy, MidiMessage)
  74. End Sub
  75.  
  76.