Imports System.Runtime.InteropServices
Imports System.Threading
Public Class Form1
'义 Windows API 函数
<DllImport(“winmm.dll”)>
Private Shared Function midiOutGetNumDevs() As Integer
End Function
<DllImport("winmm.dll")>
Private Shared Function midiOutGetDevCaps(ByVal uDeviceID As Integer, ByRef lpCaps As MIDIOUTCAPS, ByVal uSize As Integer) As Integer
End Function
<DllImport("winmm.dll")>
Private Shared Function midiOutClose(ByVal hMidiOut As IntPtr) As Integer
End Function
<DllImport("winmm.dll")>
Private Shared Function midiOutOpen(ByRef lphMidiOut As IntPtr, ByVal uDeviceID As Integer, ByVal dwCallback As Integer, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
End Function
<DllImport("winmm.dll")>
Private Shared Function midiOutShortMsg(ByVal hMidiOut As IntPtr, ByVal dwMsg As Integer) As Integer
End Function
'IDI 输出设备的结构体
Private Structure MIDIOUTCAPS
Public wMid As Short
Public wPid As Short
Public vDriverVersion As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Public szPname As String
Public wTechnology As Short
Public wVoices As Short
Public wNotes As Short
Public wChannelMask As Short
Public dwSupport As Integer
End Structure
Private hmidi As IntPtr 'IDI 句柄
Private curDevice As Integer '前 MIDI 设备索引
Private channel As Integer = 0 'IDI 通道
Private volume As Integer = 127 '量
Private selectedPatch As Integer '择的音色编号
Private Const baseNote As Integer = 60 '础音符
'义乐器和对应的 MIDI 音色值的字典
Private instrumentMidiMap As New Dictionary(Of String, Integer) From {
{"大钢琴（声学钢琴）", 0},
{"明亮的钢琴", 1},
{"电钢琴", 2},
{"酒吧钢琴", 3},
{"柔和的电钢琴", 4},
{"加合唱效果的电钢琴", 5},
{"羽管键琴（拨弦古钢琴）", 6},
{"科拉维科特琴（击弦古钢琴）", 7},
{"钢片琴", 8},
{"钟琴", 9},
{"八音盒", 10},
{"颤音琴", 11},
{"马林巴", 12},
{"木琴", 13},
{"管钟", 14},
{"大扬琴", 15},
{"击杆风琴", 16},
{"打击式风琴", 17},
{"摇滚风琴", 18},
{"教堂风琴", 19},
{"簧管风琴", 20},
{"手风琴", 21},
{"口琴", 22},
{"探戈手风琴", 23},
{"尼龙弦吉他", 24},
{"钢弦吉他", 25},
{"爵士电吉他", 26},
{"清音电吉他", 27},
{"闷音电吉他", 28},
{"加驱动效果的电吉他", 29},
{"加失真效果的电吉他", 30},
{"吉他和音", 31},
{"大贝司（声学贝司）", 32},
{"电贝司（指弹）", 33},
{"电贝司（拨片）", 34},
{"无品贝司", 35},
{"掌击贝司1", 36},
{"掌击贝司2", 37},
{"电子合成贝司1", 38},
{"电子合成贝司2", 39},
{"小提琴", 40},
{"中提琴", 41},
{"大提琴", 42},
{"低音大提琴", 43},
{"弦乐群颤音音色", 44},
{"弦乐群拨弦音色", 45},
{"竖琴", 46},
{"定音鼓", 47},
{"弦乐合奏音色1", 48},
{"弦乐合奏音色2", 49},
{"合成弦乐合奏音色1", 50},
{"合成弦乐合奏音色2", 51},
{"人声合唱啊", 52},
{"人声嘟", 53},
{"合成人声", 54},
{"管弦乐敲击齐奏", 55},
{"小号", 56},
{"长号", 57},
{"大号", 58},
{"加弱音器小号", 59},
{"法国号（圆号）", 60},
{"铜管组（铜管乐器合奏音色）", 61},
{"合成铜管音色1", 62},
{"合成铜管音色2", 63},
{"高音萨克斯风", 64},
{"次中音萨克斯风", 65},
{"中音萨克斯风", 66},
{"低音萨克斯风", 67},
{"双簧管", 68},
{"英国管", 69},
{"巴松（大管）", 70},
{"单簧管（黑管）", 71},
{"短笛", 72},
{"长笛", 73},
{"竖笛", 74},
{"排箫", 75},
{"吹瓶声", 76},
{"日本尺八", 77},
{"口哨声", 78},
{"奥卡雷那", 79},
{"合成主音1（方波）", 80},
{"合成主音2（锯齿波）", 81},
{"合成主音3", 82},
{"合成主音4", 83},
{"合成主音5", 84},
{"合成主音6（人声）", 85},
{"合成主音7（平行五度）", 86},
{"合成主音8（贝司加主音）", 87},
{"合成音色1（新世纪）", 88},
{"合成音色2（温暖）", 89},
{"合成音色3", 90},
{"合成音色4（合唱）", 91},
{"合成音色5", 92},
{"合成音色6（金属声）", 93},
{"合成音色7（光环）", 94},
{"合成音色8", 95},
{"合成效果1雨声", 96},
{"合成效果2音轨", 97},
{"合成效果3水晶", 98},
{"合成效果4大气", 99},
{"合成效果5明亮", 100},
{"合成效果6鬼怪", 101},
{"合成效果7回声", 102},
{"合成效果8科幻", 103},
{"西塔尔（印度）", 104},
{"班卓琴（美洲）", 105},
{"三昧线（日本）", 106},
{"十三弦筝（日本）", 107},
{"卡林巴", 108},
{"风笛", 109},
{"民族提琴", 110},
{"唢呐", 111},
{"叮当铃", 112},
{"阿哥哥鼓", 113},
{"钢鼓", 114},
{"木鱼", 115},
{"太鼓", 116},
{"古高音鼓", 117},
{"合成鼓", 118},
{"铜钹", 119},
{"磨弦", 120},
{"呼吸声", 121},
{"海浪声", 122},
{"鸟鸣", 123},
{"电话铃", 124},
{"直升机", 125},
{"鼓掌声", 126},
{"枪声", 127}
}
Private isPlaying As Boolean = False '放状态标志
Private pausedAt As Integer '停时的位置
Private timer As New System.Windows.Forms.Timer() '于控制播放节奏的计时器
Private noteDurations As New List(Of Tuple(Of Integer, Integer)) '明在类级别，使整个类都能访问
Private firstPlay As Boolean = True
' 新添加的变量用于第二个音轨
Private hmidi2 As IntPtr ' 第二个 MIDI 句柄
Private curDevice2 As Integer ' 第二个 MIDI 设备索引
Private channel2 As Integer = 1 ' 第二个 MIDI 通道
Private volume2 As Integer = 127 ' 第二个音轨的音量
Private selectedPatch2 As Integer ' 第二个音轨选择的音色编号
Private isPlaying2 As Boolean = False ' 第二个音轨的播放状态标志
Private pausedAt2 As Integer ' 第二个音轨暂停时的位置
Private currentIndex1 As Integer = 0 '一个音轨的当前索引
Private currentIndex2 As Integer = 0 '二个音轨的当前索引
Private noteDurations1 As New List(Of Tuple(Of Integer, Integer)) '一个文本框的音符时长列表
Private noteDurations2 As New List(Of Tuple(Of Integer, Integer)) '二个文本框的音符时长列表
Dim p As Integer = 200 '定义播放速度
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
curDevice = 0 '为第一个设备
OpenMidiDevice() '开 MIDI 设备
'器名称添加到多选框
For Each instrument In instrumentMidiMap.Keys
CheckBoxList1.Items.Add(instrument)
Next
CheckBoxList1.SetSelected(0, True) '始选中第一项
'始化计时器
timer.Interval = p '00 毫秒的间隔，可根据需要调整
AddHandler timer.Tick, AddressOf Timer_Tick
TextBox1.Text = "6 6 44 1 16 4 05 6 10 6 17 3 22 4 27 3 53 1 12 6 03 1 16 2 12 5 66 4 25 2 32 3 15 2 46 3 04 5 75 3 11 6 33 5 4"
TextBox2.Text = "7 4 13 1 43 3 25 5 21 3 61 1 46 2 73 2 43 4 21 6 12 2 40 3 56 2 23 2 62 1 53 2 52 4 21 3 10 2 64 2 43 5 42 2 5"
End Sub
'开 MIDI 设备的方法
Private Sub OpenMidiDevice()
Dim numDevices As Integer = midiOutGetNumDevs() '取设备数量
Dim caps As New MIDIOUTCAPS '备信息结构体
'历设备获取信息（这里可以根据需要进行处理，如显示设备名称等）
For i As Integer = 0 To numDevices - 1
midiOutGetDevCaps(i, caps, Marshal.SizeOf(caps))
Next
Dim rc As Integer = midiOutOpen(hmidi, curDevice, 0, 0, 0) '开设备
If rc <> 0 Then
MessageBox.Show("无法打开 MIDI 输出设备！")
End If
End Sub
' 同时播放两个音轨的方法
Private Sub PlayTwoTracks()
Dim thread1 As New Thread(AddressOf PlayTrack)
Dim thread2 As New Thread(AddressOf PlayTrack)
thread1.Start()
thread2.Start()
End Sub
' 第一个音轨的播放逻辑
Private Sub PlayTrack()
Dim noteDurations As New List(Of Tuple(Of Integer, Integer)) ' 声明为 PlayTrack1 方法的局部变量
Dim digitalScore As String = TextBox1.Text ' 假设这是第一个音轨的数字简谱
Dim scoreParts1 As String() = digitalScore.Split(" "c)
noteDurations1.Clear() ' 清空之前的内容
For Each part In scoreParts1
Dim parts As String() = part.Split("-") ' 尝试按 - 分割，以获取音符和可能的时长
If parts.Length = 1 Then
' 如果没有 - ，则默认时长为 1
noteDurations1.Add(Tuple.Create(Convert.ToInt32(parts(0)), 1))
ElseIf parts.Length = 2 Then
' 如果有 - ，则第一个部分是音符，第二个部分是时长
noteDurations1.Add(Tuple.Create(Convert.ToInt32(parts(0)), Convert.ToInt32(parts(1))))
Else
' 格式错误，处理或跳过
MessageBox.Show("数字简谱格式错误: " & part)
End If
Next
Dim timer As New System.Windows.Forms.Timer() ' 为第一个音轨创建独立的计时器
timer.Interval = p ' 200 毫秒的间隔，可根据需要调整
AddHandler timer.Tick, AddressOf Timer_Tick
Dim currentIndex1 As Integer = 0
timer.Tag = currentIndex1
timer.Start()
End Sub
Private Sub Button11_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button11.Click
If TextBox1.Text.Trim() = "" Or TextBox2.Text.Trim() = "" Then
MessageBox.Show("请在两个文本框中输入数字简谱！")
Return
End If
If Not isPlaying Then
noteDurations1.Clear()
noteDurations2.Clear()
ParseAndPlayDigitalScore(TextBox1.Text, noteDurations1)
ParseAndPlayDigitalScore(TextBox2.Text, noteDurations2)
isPlaying = True
firstPlay = True ' 设置首次播放标志
timer.Start()
End If
End Sub
'停按钮点击事件
Private Sub Button12_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button12.Click
If isPlaying Then
isPlaying = False
timer.Stop()
pausedAt = timer.Tag '录暂停时的位置
End If
End Sub
'止按钮点击事件
Private Sub Button14_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button14.Click
isPlaying = False
timer.Stop()
pausedAt = 0 '置暂停位置
End Sub
'续按钮点击事件
Private Sub Button13_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button13.Click
If Not isPlaying Then
isPlaying = True
timer.Start()
End If
End Sub
'析并播放数字简谱
Private Sub ParseAndPlayDigitalScore(ByVal digitalScore As String, ByRef noteDurations As List(Of Tuple(Of Integer, Integer)))
Dim scoreParts As String() = digitalScore.Split(" "c)
noteDurations.Clear() '空之前的内容
For Each part In scoreParts
Dim parts As String() = part.Split("-") '试按 - 分割，以获取音符和可能的时长
If parts.Length = 1 Then
'果没有 - ，则默认时长为 1
noteDurations.Add(Tuple.Create(Convert.ToInt32(parts(0)), 1))
ElseIf parts.Length = 2 Then
'果有 - ，则第一个部分是音符，第二个部分是时长
noteDurations.Add(Tuple.Create(Convert.ToInt32(parts(0)), Convert.ToInt32(parts(1))))
Else
'式错误，处理或跳过
MessageBox.Show("数字简谱格式错误: " & part)
End If
Next
End Sub
'时器的 Tick 事件，用于控制播放节奏
Private Sub Timer_Tick(ByVal sender As Object, ByVal e As EventArgs)
If firstPlay And (currentIndex1 >= noteDurations1.Count And currentIndex2 >= noteDurations2.Count) Then
timer.Stop()
isPlaying = False
firstPlay = False ' 播放完成后重置标志
Return
End If
If currentIndex1 < noteDurations1.Count And currentIndex2 < noteDurations2.Count Then
Dim noteValue1 As Integer = noteDurations1(currentIndex1).Item1
Dim duration1 As Integer = noteDurations1(currentIndex1).Item2
Dim noteValue2 As Integer = noteDurations2(currentIndex2).Item1
Dim duration2 As Integer = noteDurations2(currentIndex2).Item2
selectedPatch = instrumentMidiMap(CheckBoxList1.SelectedItem.ToString)
PlayNote(noteValue1)
PlayNote(noteValue2)
' 根据较长的时长暂停计时器
Dim maxDuration As Integer = Math.Max(duration1, duration2)
Thread.Sleep(maxDuration * p)
currentIndex1 += 1
currentIndex2 += 1
Else
If currentIndex1 >= noteDurations1.Count Then
currentIndex1 = 0
End If
If currentIndex2 >= noteDurations2.Count Then
currentIndex2 = 0
End If
If currentIndex1 >= noteDurations1.Count And currentIndex2 >= noteDurations2.Count Then
timer.Stop()
isPlaying = False
End If
End If
End Sub
'放音符的方法
Private Sub PlayNote(ByVal noteIndex As Integer)
selectedPatch = instrumentMidiMap(CheckBoxList1.SelectedItem.ToString)
' 发送第一个音轨的音色选择和音符消息
Dim patchChangeMessage1 As Integer = &HC0 Or (selectedPatch << 8)
midiOutShortMsg(hmidi, patchChangeMessage1)
Dim midiOutValue1 As Integer = &H90 Or ((baseNote + noteIndex) << 8) Or (volume << 16) Or (channel << 24)
midiOutShortMsg(hmidi, midiOutValue1)
' 发送第二个音轨的音色选择和音符消息
Dim patchChangeMessage2 As Integer = &HC0 Or (selectedPatch << 8)
midiOutShortMsg(hmidi2, patchChangeMessage2)
Dim midiOutValue2 As Integer = &H90 Or ((baseNote + noteIndex) << 8) Or (volume2 << 16) Or (channel2 << 24)
midiOutShortMsg(hmidi2, midiOutValue2)
End Sub
'闭 MIDI 设备
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles MyBase.FormClosing
midiOutClose(hmidi)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'获取文本框中的字符串
Dim str As String = TextBox1.Text
'遍历字符串中的每个字符
For i As Integer = 0 To str.Length - 1
'获取当前字符
Dim ch As Char = str(i)
'根据当前字符进行相应的操作
Select Case ch
Case "1...."
PlayNote(0)
Case "2...."
PlayNote(1)
Case "3...."
PlayNote(2)
Case "4...."
PlayNote(3)
Case "5...."
PlayNote(4)
Case "6...."
PlayNote(5)
Case "7...."
PlayNote(6)
Case "1..."
PlayNote(7)
Case "2..."
PlayNote(8)
Case "3..."
PlayNote(9)
Case "4..."
PlayNote(10)
Case "5..."
PlayNote(11)
Case "6..."
PlayNote(12)
Case "7..."
PlayNote(13)
Case "1.."
PlayNote(14)
Case "2.."
PlayNote(15)
Case "3.."
PlayNote(16)
Case "4.."
PlayNote(17)
Case "5.."
PlayNote(18)
Case "6.."
PlayNote(19)
Case "7.."
PlayNote(20)
Case "1."
PlayNote(21)
Case "2."
PlayNote(22)
Case "3."
PlayNote(23)
Case "4."
PlayNote(24)
Case "5."
PlayNote(25)
Case "6."
PlayNote(26)
Case "7."
PlayNote(27)
Case "1"
PlayNote(28)
Case "2"
PlayNote(29)
Case "3"
PlayNote(30)
Case "4"
PlayNote(31)
Case "5"
PlayNote(32)
Case "6"
PlayNote(33)
Case "7"
PlayNote(34)
Case "1'"
PlayNote(35)
Case "2'"
PlayNote(36)
Case "3'"
PlayNote(37)
Case "4'"
PlayNote(38)
Case "5'"
PlayNote(39)
Case "6'"
PlayNote(40)
Case "7'"
PlayNote(41)
Case "1''"
PlayNote(42)
Case "2''"
PlayNote(43)
Case "3''"
PlayNote(44)
Case "4''"
PlayNote(45)
Case "5''"
PlayNote(46)
Case "6''"
PlayNote(47)
Case "7''"
PlayNote(48)
Case "1'''"
PlayNote(49)
Case "2'''"
PlayNote(1)
Case "3'''"
PlayNote(50)
Case "4'''"
PlayNote(51)
Case "5'''"
PlayNote(52)
Case "6'''"
PlayNote(53)
Case "7'''"
PlayNote(54)
Case "1''''"
PlayNote(55)
Case "2''''"
PlayNote(56)
Case "3''''"
PlayNote(57)
Case "4''''"
PlayNote(58)
Case "5''''"
PlayNote(59)
Case "6''''"
PlayNote(60)
Case "7''''"
PlayNote(61)
'根据需要添加更多的 Case 语句，每个 Case 语句对应不同的数字字符串和对应的 音频 文件
End Select
System.Threading.Thread.Sleep(p) '暂停 200 毫秒，以控制播放节奏
Next
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
'获取文本框中的字符串
Dim str As String = TextBox2.Text
'遍历字符串中的每个字符
For i As Integer = 0 To str.Length - 1
'获取当前字符
Dim ch As Char = str(i)
'根据当前字符进行相应的操作
Select Case ch
Case "1...."
PlayNote(0)
Case "2...."
PlayNote(1)
Case "3...."
PlayNote(2)
Case "4...."
PlayNote(3)
Case "5...."
PlayNote(4)
Case "6...."
PlayNote(5)
Case "7...."
PlayNote(6)
Case "1..."
PlayNote(7)
Case "2..."
PlayNote(8)
Case "3..."
PlayNote(9)
Case "4..."
PlayNote(10)
Case "5..."
PlayNote(11)
Case "6..."
PlayNote(12)
Case "7..."
PlayNote(13)
Case "1.."
PlayNote(14)
Case "2.."
PlayNote(15)
Case "3.."
PlayNote(16)
Case "4.."
PlayNote(17)
Case "5.."
PlayNote(18)
Case "6.."
PlayNote(19)
Case "7.."
PlayNote(20)
Case "1."
PlayNote(21)
Case "2."
PlayNote(22)
Case "3."
PlayNote(23)
Case "4."
PlayNote(24)
Case "5."
PlayNote(25)
Case "6."
PlayNote(26)
Case "7."
PlayNote(27)
Case "1"
PlayNote(28)
Case "2"
PlayNote(29)
Case "3"
PlayNote(30)
Case "4"
PlayNote(31)
Case "5"
PlayNote(32)
Case "6"
PlayNote(33)
Case "7"
PlayNote(34)
Case "1'"
PlayNote(35)
Case "2'"
PlayNote(36)
Case "3'"
PlayNote(37)
Case "4'"
PlayNote(38)
Case "5'"
PlayNote(39)
Case "6'"
PlayNote(40)
Case "7'"
PlayNote(41)
Case "1''"
PlayNote(42)
Case "2''"
PlayNote(43)
Case "3''"
PlayNote(44)
Case "4''"
PlayNote(45)
Case "5''"
PlayNote(46)
Case "6''"
PlayNote(47)
Case "7''"
PlayNote(48)
Case "1'''"
PlayNote(49)
Case "2'''"
PlayNote(1)
Case "3'''"
PlayNote(50)
Case "4'''"
PlayNote(51)
Case "5'''"
PlayNote(52)
Case "6'''"
PlayNote(53)
Case "7'''"
PlayNote(54)
Case "1''''"
PlayNote(55)
Case "2''''"
PlayNote(56)
Case "3''''"
PlayNote(57)
Case "4''''"
PlayNote(58)
Case "5''''"
PlayNote(59)
Case "6''''"
PlayNote(60)
Case "7''''"
PlayNote(61)
'根据需要添加更多的 Case 语句，每个 Case 语句对应不同的数字字符串和对应的 音频 文件
End Select
System.Threading.Thread.Sleep(p) '暂停 200 毫秒，以控制播放节奏
Next
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
midiOutClose(hmidi)
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Call OpenMidiDevice()
End Sub
'随机谱曲
Private Sub Button5_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button5.Click
Randomize()
'定义数组来存储数据
Dim a(8) As String
a = {"0", "1", "2", "3", "4", "5", "6", "7"}
For io As Integer = 0 To 10
TextBox1.Text = TextBox1.Text & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7)
Next
End Sub
'随机谱曲
Private Sub Button6_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button6.Click
Randomize()
'定义数组来存储数据
Dim a(8) As String
a = {"0", "1", "2", "3", "4", "5", "6", "7"}
For io As Integer = 0 To 10
TextBox2.Text = TextBox2.Text & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7) & " " & a(Rnd() * 7)
Next
End Sub
Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
TextBox1.Text = ""
TextBox2.Text = ""
End Sub
End Class
155
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
