求改代码:VB控制MIDI
请不要给我什么现成的代码例子,网上的“电子钢琴”例子我下了几个都太复杂
您要是真会的话,就请您把下面的代码帮我改到能出声,以下代码就想播出一个音符C
- VB code
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As LongPrivate Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongPrivate Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As LongPrivate Sub Command1_Click()Dim lMidiAPIReturn As LongDim tone As IntegermlMIDIOutHandle = 0lMidiAPIReturn = midiOutOpen(mlMIDIOutHandle, -1, 0, 0, 0)tone = 60volume = 90channel = 0lMidiAPIReturn = midiOutShortMsg(midiout, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)End Sub
[解决办法]
试一试这个,你的代码有误,我修改如下:
- VB code
Option ExplicitPrivate Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As LongPrivate Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongPrivate Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As LongPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Sub Command1_Click() Dim lMidiAPIReturn As Long Dim tone As Integer Dim mlmidiouthandle As Long Dim volume As Long Dim channel As Long mlmidiouthandle = 0 lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0) tone = 60 volume = 90 channel = 0 lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel) Sleep 1000 midiOutClose mlmidiouthandleEnd Sub
[解决办法]
在Command2最后加一句即可
midiOutClose mlmidiouthandle
[解决办法]
设备打开了要再关闭,下次才好使
[解决办法]
loop后加这句关闭设备:
lMidiAPIReturn = midiOutClose(mlmidiouthandle)
[解决办法]
楼主精神可嘉!
- VB code
Option ExplicitPrivate Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As LongPrivate Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongPrivate Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As LongPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'--------------------Dim notes(1 To 8, 1 To 2) As Variant'--------------------Private Sub Form_Load() Randomize '此语句应在初始化时调用一次即可 notes(1, 1) = "C4": notes(1, 2) = 60 notes(2, 1) = "D4": notes(2, 2) = 62 notes(3, 1) = "E4": notes(3, 2) = 64 notes(4, 1) = "F4": notes(4, 2) = 65 notes(5, 1) = "G4": notes(5, 2) = 67 notes(6, 1) = "A5": notes(6, 2) = 69 notes(7, 1) = "B5": notes(7, 2) = 71 notes(8, 1) = "C5": notes(8, 2) = 72End Sub'--------------------Private Sub Command2_Click()Dim lMidiAPIReturn As LongDim tone As IntegerDim mlmidiouthandle As LongDim volume As LongDim channel As LongDim i As IntegerDim a As IntegerDim b As IntegerDim t As IntegerDim s(8) As Integer For i = 1 To 8 s(i) = i Next '随机打乱s(i)的顺序 即洗牌 For i = 8 To 2 Step -1 a = i: b = Int(Rnd() * i) + 1 If a <> b Then t = s(a): s(a) = s(b): s(b) = t End If Next mlmidiouthandle = 0 lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0) volume = 90 channel = 0 Text1.Text = "" For i = 1 To 8 Text1.Text = Text1.Text + CStr(s(i)) + " " + notes(s(i), 1) + ", " Text1.Refresh tone = notes(s(i), 2) lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel) Sleep 100 Next lMidiAPIReturn = midiOutClose(mlmidiouthandle)End Sub