自动随机弹奏钢琴程序vb源代码.zip

第1文件 Option Explicit Const INVALID_NOTE = -1 ' Code for keyboard keys that we don't handle Dim numDevices As Long ' number of midi output devices Dim curDevice As Long ' current midi device Dim hmidi As Long ' midi output handle Dim rc As Long ' return code Dim midimsg As Long ' midi output message buffer Dim channel As Integer ' midi output channel Dim volume As Integer ' midi volume Dim baseNote As Integer ' the first note on our "piano" Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Set the value for the starting note of the piano Private Sub base_Click() Dim s As String Dim i As Integer s = InputBox("Enter the new base note for the keyboard (0 - 111)", "Base note", CStr(baseNote)) If IsNumeric(s) Then i = CInt(s) If (i >= 0 And i < 112) Then baseNote = i End If End If End Sub ' Select the midi output channel Private Sub chan_Click(Index As Integer) chan(channel).Checked = False channel = Index chan(channel).Checked = True End Sub ' Open the midi device selected in the menu. The menu index equals the ' midi device number + 1. Private Sub device_Click(Index As Integer) device(curDevice + 1).Checked = False device(Index).Checked = True curDevice = Index - 1 rc = midiOutClose(hmidi) rc = midiOutOpen(hmidi, curDevice, 0, 0, 0) If (rc <> 0) Then MsgBox "Couldn't open midi out, rc = " & rc End If End Sub ' If user presses a keyboard key, start the corresponding midi note Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) StartNote NoteFromKey(KeyCode) End Sub ' If user lifts a keyboard key, stop the corresponding midi note Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) StopNote NoteFromKey(KeyCode) End Sub Private Sub Form_Load() Dim i As Long Dim caps As MIDIOUTCAPS ' Set the first device as midi mapper device(0).Caption = "MIDI Mapper" device(0).Visible = True device(0).Enabled = True ' Get the rest of the midi devices numDevices = midiOutGetNumDevs() For i = 0 To (numDevices - 1) midiOutGetDevCaps i, caps, Len(caps) device(i + 1).Caption = caps.szPname device(i + 1).Visible = True device(i + 1).Enabled = True Next ' Select the MIDI Mapper as the default device device_Click (0) ' Set the default channel channel = 0 chan(channel).Checked = True ' Set the base note baseNote = 60 ' Set volume range volume = 127 vol.Min = 127 vol.Max = 0 vol.Value = volume End Sub Private Sub Form_Unload(Cancel As Integer) ' Close current midi device rc = midiOutClose(hmidi) End Sub ' Start a note when user click on it Private Sub key_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) StartNote (Index) End Sub ' Stop the note when user lifts the mouse button Private Sub key_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) StopNote (Index) End Sub ' Press the button and send midi start event Private Sub StartNote(Index As Integer) If (Index = INVALID_NOTE) Then Exit Sub End If If (key(Index).Value = 1) Then Exit Sub End If key(Index).Value = 1 midimsg = &H90 + ((baseNote + Index) * &H100) + (volume * &H10000) + channel midiOutShortMsg hmidi, midimsg End Sub ' Raise the button and send midi stop event Private Sub StopNote(Index As Integer) If (Index = INVALID_NOTE) Then Exit Sub End If key(Index).Value = 0 midimsg = &H80 + ((baseNote + Index) * &H100) + channel midiOutShortMsg hmidi, midimsg End Sub ' Get the note corresponding to a keyboard key Private Function NoteFromKey(key As Integer) NoteFromKey = INVALID_NOTE Select Case key Case vbKeyZ NoteFromKey = 0 Case vbKeyS NoteFromKey = 1 Case vbKeyX NoteFromKey = 2 Case vbKeyD NoteFromKey = 3 Case vbKeyC NoteFromKey = 4 Case vbKeyV NoteFromKey = 5 Case vbKeyG NoteFromKey = 6 Case vbKeyB NoteFromKey = 7 Case vbKeyH NoteFromKey = 8 Case vbKeyN NoteFromKey = 9 Case vbKeyJ NoteFromKey = 10 Case vbKeyM NoteFromKey = 11 Case 188 ' comma NoteFromKey = 12 Case vbKeyL NoteFromKey = 13 Case 190 ' period NoteFromKey = 14 Case 186 ' semicolon NoteFromKey = 15 Case 191 ' forward slash NoteFromKey = 16 End Select End Function ' Set the volume Private Sub vol_Change() volume = vol.Value End Sub Private Sub Timer1_Timer() Dim i As Integer Randomize i = Rnd * 12 Select Case i Case 0 Label2.Caption = "Z" Call StartNote(0) Sleep 500 Call StopNote(0) Case 1 Label2.Caption = "S" Call StartNote(1) Sleep 500 Call StopNote(1) Case 2 Label2.Caption = "X" Call StartNote(2) Sleep 500 Call StopNote(2) Case 3 Label2.Caption = "D" Call StartNote(3) Sleep 500 Call StopNote(3) Case 4 Label2.Caption = "C" Call StartNote(4) Sleep 500 Call StopNote(4) Case 5 Label2.Caption = "V" Call StartNote(5) Sleep 500 Call StopNote(5) Case 6 Label2.Caption = "B" Call StartNote(6) Sleep 500 Call StopNote(6) Case 7 Label2.Caption = "G" Call StartNote(7) Sleep 500 Call StopNote(7) Case 8 Label2.Caption = "H" Call StartNote(8) Sleep 500 Call StopNote(8) Case 9 Label2.Caption = "N" Call StartNote(9) Sleep 500 Call StopNote(9) Case 10 Label2.Caption = "J" Call StartNote(10) Sleep 500 Call StopNote(10) Case 11 Label2.Caption = "M" Call StartNote(11) Sleep 500 Call StopNote(11) End Select End Sub 第2文件 'This is a complete piano application u can contact me at haisrini@email.com Option Explicit Public Const MAXPNAMELEN = 32 ' Maximum product name length ' Error values for functions used in this sample. See the function for more information Public Const MMSYSERR_BASE = 0 Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2) ' device ID out of range Public Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11) ' invalid parameter passed Public Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6) ' no device driver present Public Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7) ' memory allocation error Public Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5) ' device handle is invalid Public Const MIDIERR_BASE = 64 Public Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1) ' still something playing Public Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3) ' hardware is still busy Public Const MIDIERR_BADOPENMODE = (MIDIERR_BASE + 6) ' operation unsupported w/ open mode 'User-defined variable the stores information about the MIDI output device. Type MIDIOUTCAPS wMid As Integer ' Manufacturer identifier of the device driver for the MIDI output device ' For a list of identifiers, see the Manufacturer Indentifier topic in the ' Multimedia Reference of the Platform SDK. wPid As Integer ' Product Identifier Product of the MIDI output device. For a list of ' product identifiers, see the Product Identifiers topic in the Multimedia ' Reference of the Platform SDK. vDriverVersion As Long ' Version number of the device driver for the MIDI output device. ' The high-order byte is the major version number, and the low-order byte is ' the minor ver