home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / sound / vbpian / piano2.txt < prev    next >
Encoding:
Text File  |  1995-02-27  |  3.6 KB  |  128 lines
  1. Dim NoteCatchCount As Integer
  2. Dim NoteOnCatcher(1024) As Integer
  3.  
  4.  
  5. Sub About_Click ()
  6.     AboutBox1.Show Modal
  7. End Sub
  8.  
  9. Sub Exit_Click ()
  10.     X% = MidiOutClose(hmidioutcopy)
  11.     End
  12. End Sub
  13.  
  14. Sub Form_Load ()
  15.     Screen.MousePointer = 11
  16.     Piano.Left = 0
  17.     Piano.Top = 0
  18.     
  19.     ' Open Midi Driver
  20.     MidiOutOpenPort
  21.     
  22.     HScrollMIDIChannel.Value = 0
  23.     HScrollPatch.Value = 0
  24.     HScrollVolume.Value = 100
  25.     HScrollPan.Value = 64
  26.     HScrollOctave.Value = 0
  27.     Screen.MousePointer = 0
  28. End Sub
  29.  
  30. Sub Form_Unload (Cancel As Integer)
  31.     X% = MidiOutClose(hmidioutcopy)
  32. End Sub
  33.  
  34. Sub HScrollMIDIChannel_Change ()
  35.     ' Change Midi Channel to Vscroll1 value
  36.     MidiChannelOut = HScrollMIDIChannel.Value
  37.  
  38.     ' Display new channel
  39.     MidiChannelOutLabel.Caption = Str$(MidiChannelOut + 1)
  40.  
  41.     ' Sets the Patch & Volume for the current Midi Channel Out
  42.     HScrollPatch.Value = MidiPatch(MidiChannelOut)
  43.     HScrollVolume.Value = MidiVolume(MidiChannelOut)
  44.     HScrollPan.Value = MidiPan(MidiChannelOut)
  45.     HScrollOctave.Value = Octave(MidiChannelOut) / 12
  46. End Sub
  47.  
  48. Sub HScrollOctave_Change ()
  49.     LabelOctave.Caption = Str$(HScrollOctave.Value)
  50.     Octave(MidiChannelOut) = (HScrollOctave.Value * 12)
  51. End Sub
  52.  
  53. Sub HScrollPan_Change ()
  54.     MidiPan(MidiChannelOut) = HScrollPan.Value
  55.  
  56.     ' 05-16-92 Pan Midi Out routine
  57.     MidiEventOut = 176 + MidiChannelOut
  58.     MidiNoteOut = 10
  59.     MidiVelOut = MidiPan(MidiChannelOut)
  60.     SendMidiOut
  61. End Sub
  62.  
  63. Sub HScrollPatch_Change ()
  64.     ' Sets the Patch for the current Midi Channel Out
  65.     MidiPatch(MidiChannelOut) = HScrollPatch.Value
  66.     ReadPatch
  67.  
  68.     ' 05-15-92 Patch Midi Out routine
  69.     MidiEventOut = &HC0 + MidiChannelOut
  70.     MidiNoteOut = MidiPatch(MidiChannelOut)
  71.     MidiVelOut = 0
  72.     SendMidiOut
  73.  
  74. End Sub
  75.  
  76. Sub HScrollVolume_Change ()
  77.     MidiVelocity = HScrollVolume.Value
  78.     MidiVolume(MidiChannelOut) = HScrollVolume.Value
  79.     VolumeLabel.Caption = Str$(MidiVelocity)
  80. End Sub
  81.  
  82. Sub PanelWhite_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
  83.     For nn = 0 To NoteCatchCount - 1
  84.         MidiEventOut = 144 + MidiChannelOut
  85.         MidiVelOut = 0
  86.         MidiNoteOut = NoteOnCatcher(nn)
  87.         SendMidiOut
  88.  
  89.         NoteMOD = (NoteOnCatcher(nn) - Octave(MidiChannelOut)) Mod 12
  90.  
  91.         If NoteMOD = 0 Or NoteMOD = 2 Or NoteMOD = 4 Or NoteMOD = 5 Or NoteMOD = 7 Or NoteMOD = 9 Or NoteMOD = 11 Then
  92.             Piano.PanelWhite(NoteOnCatcher(nn) - Octave(MidiChannelOut)).BevelOuter = 2
  93.         Else
  94.             Piano.PanelWhite(NoteOnCatcher(nn) - Octave(MidiChannelOut)).BevelOuter = 2
  95.         End If
  96.     Next nn
  97.  
  98.     NoteCatchCount = 0
  99. End Sub
  100.  
  101. Sub PanelWhite_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
  102.     'If still on same note, discard
  103.     If NoteCatchCount > 0 Then
  104.        If NoteOnCatcher(NoteCatchCount - 1) = Index + Octave(MidiChannelOut) Then
  105.             Exit Sub
  106.        End If
  107.     End If
  108.  
  109.     NoteMOD = (Index) Mod 12
  110.     If NoteMOD = 0 Or NoteMOD = 2 Or NoteMOD = 4 Or NoteMOD = 5 Or NoteMOD = 7 Or NoteMOD = 9 Or NoteMOD = 11 Then
  111.         Piano.PanelWhite(Index).BevelOuter = 0
  112.     Else
  113.         Piano.PanelWhite(Index).BevelOuter = 0
  114.     End If
  115.     MidiEventOut = 144 + MidiChannelOut
  116.     MidiVelOut = MidiVelocity
  117.     MidiNoteOut = Index + Octave(MidiChannelOut)
  118.     SendMidiOut
  119.  
  120.     'Since drag/drop is being used, we must keep track of the note being played.
  121.     NoteOnCatcher(NoteCatchCount) = MidiNoteOut
  122.     If NoteCatchCount < 750 Then 'Don't let array get out of range
  123.         NoteCatchCount = NoteCatchCount + 1
  124.     End If
  125.  
  126. End Sub
  127.  
  128.