求改代码：VB控制MIDI

Question

本帖最后由 bcrun 于 2011-05-27 08:54:50 编辑

Answer 1

通过测试lMidiAPIReturn = midiOutOpen(mlMIDIOutHandle, -1, 0, 0, 0)
返回值为4，也就是说并没有打开MIDI设备

Answer 2

试一试这个，你的代码有误，我修改如下：Option ExplicitPrivate 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

Answer 3

本帖最后由 bcrun 于 2011-05-27 08:56:03 编辑

  

Answer 4

为方便阅读,我重发如下:
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
Dim i, j, k, s(8) As Integer
Dim cf As Boolean
Private Sub Form_Load()
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
mlmidiouthandle = 0
lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0)
volume = 90
channel = 0
i = 1
Text1.Text = ""
Do While i <= 8 '第一层循环，用于取8个数
    cf = False '是否取到了重复的数
    Randomize
    k = Int(Rnd() * 8) + 1 '获取随机数
    For j = 1 To i '第二层循环，判断是否取到的数字发生了重复
        If k = s(j) Then '当发生重复的时候标记cf变量
            cf = True
            Exit For
        End If
    Next
    If cf = False Then '如果取得数字没有重复，进行赋值，并显示在text1文本框
        'Text1.Text = Text1.Text & k & Chr(13) & Chr(10)
        s(i) = k
        tone = notes(k, 2)
        'MsgBox tone
        lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
        Sleep 100
        'MsgBox (s(i))
        Text1.Text = Text1.Text + Str(s(i))
        i = i + 1 '继续取下一个数字，直到i=8
    End If
Loop
End Sub

Answer 5

在Command2最后加一句即可
midiOutClose mlmidiouthandle

Answer 6

loop后加这句关闭设备：
lMidiAPIReturn = midiOutClose(mlmidiouthandle)

Answer 7

谢几位的补充,我加上了,如下行红色,好使,但是:
当我按Command2达到十多次时(比如11次或16次不等),就不出声了,最后一次出声时还会拖长声音,我每次都是等最后的声响完才又按的,是不是还得加什么语句?
请大师们斧正!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
Dim i, j, k, s(8) As Integer
Dim cf As Boolean
Private Sub Form_Load()
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
mlmidiouthandle = 0
lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0)
volume = 90
channel = 0
i = 1
Text1.Text = ""
Do While i <= 8 '第一层循环，用于取8个数
    cf = False '是否取到了重复的数
    Randomize
    k = Int(Rnd() * 8) + 1 '获取随机数
    For j = 1 To i '第二层循环，判断是否取到的数字发生了重复
        If k = s(j) Then '当发生重复的时候标记cf变量
            cf = True
            Exit For
        End If
    Next
    If cf = False Then '如果取得数字没有重复，进行赋值，并显示在text1文本框
        'Text1.Text = Text1.Text & k & Chr(13) & Chr(10)
        s(i) = k
        tone = notes(k, 2)
        'MsgBox tone
        lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
        Sleep 100
        'MsgBox (s(i))
        Text1.Text = Text1.Text + Str(s(i))
        i = i + 1 '继续取下一个数字，直到i=8
    End If
    DoEvents
Loop
lMidiAPIReturn = midiOutClose(mlmidiouthandle)
End Sub

Answer 8

上面倒数第二行有问题,重发如下:
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
Dim i, j, k, s(8) As Integer
Dim cf As Boolean
Private Sub Form_Load()
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
mlmidiouthandle = 0
lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0)
volume = 90
channel = 0
i = 1
Text1.Text = ""
Do While i <= 8 '第一层循环，用于取8个数
    cf = False '是否取到了重复的数
    Randomize
    k = Int(Rnd() * 8) + 1 '获取随机数
    For j = 1 To i '第二层循环，判断是否取到的数字发生了重复
        If k = s(j) Then '当发生重复的时候标记cf变量
            cf = True
            Exit For
        End If
    Next
    If cf = False Then '如果取得数字没有重复，进行赋值，并显示在text1文本框
        'Text1.Text = Text1.Text & k & Chr(13) & Chr(10)
        s(i) = k
        tone = notes(k, 2)
        'MsgBox tone
        lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
        Sleep 100
        'MsgBox (s(i))
        Text1.Text = Text1.Text + Str(s(i))
        i = i + 1 '继续取下一个数字，直到i=8
    End If
    DoEvents
Loop
lMidiAPIReturn = midiOutClose(mlmidiouthandle)
End Sub

Answer 9

楼主精神可嘉！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

Answer 10

各位达人好！为了给老伴打谱，来到了这里，遇到这么多VB & Midi 达人，增长见识!
我也有些关于Midi的问题请教：
1. 通过以上讨论，使用midiOutShortMsg控制 音色（乐器）、音符（频率）、音量（声强度）的问题已经解决，但发生的长度是如何确定的？如何控制？
2. Midi文件的文件格式如何？哪里有较详细的官方的说明？
3. 有能将midi文件打开转换成简谱 和 编辑简谱并能存为midi 的源程序吗？请好心人能把对我的帮助发到 ,我很少上网，怕找不到这里了，谢谢！

Answer 11

最简单的代码在此，详细的解释和说明。我刚写的，虽然结贴了，不过给大家做参考吧http://baike.baidu.com/view/7969.htm#6