求改代码：VB统制MIDI

2013-08-01

求改代码：VB控制MIDI本帖最后由 bcrun 于 2011-05-27 08:54:50 编辑请不要给我什么现成的代码例子，网上的“

求改代码：VB控制MIDI
本帖最后由 bcrun 于 2011-05-27 08:54:50 编辑请不要给我什么现成的代码例子，网上的“电子钢琴”例子我下了几个都太复杂

您要是真会的话，就请您把下面的代码帮我改到能出声，以下代码就想播出一个音符C

Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private 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 Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Sub Command1_Click()
Dim lMidiAPIReturn As Long
Dim tone As Integer
mlMIDIOutHandle = 0
lMidiAPIReturn = midiOutOpen(mlMIDIOutHandle, -1, 0, 0, 0)
tone = 60
volume = 90
channel = 0
lMidiAPIReturn = midiOutShortMsg(midiout, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
End Sub

[解决办法]
试一试这个，你的代码有误，我修改如下：

Option Explicit

Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private 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 Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private 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 mlmidiouthandle
End Sub

[解决办法]
在Command2最后加一句即可
midiOutClose mlmidiouthandle

[解决办法]
设备打开了要再关闭,下次才好使
[解决办法]
loop后加这句关闭设备：
lMidiAPIReturn = midiOutClose(mlmidiouthandle)
[解决办法]
楼主精神可嘉！

Option Explicit
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private 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 Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private 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) = 72
End Sub
'--------------------
Private Sub Command2_Click()
Dim lMidiAPIReturn As Long
Dim tone As Integer
Dim mlmidiouthandle As Long
Dim volume As Long
Dim channel As Long
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim t As Integer
Dim 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

热点排行