读书人

求改代码:VB控制MIDI,该怎么处理

发布时间: 2012-04-08 14:38:30 作者: rapoo

求改代码: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 

读书人网 >VB

热点推荐