VS2010旗舰版的VB.NET版本小钢琴代码-CSDN博客

本文链接：https://blog.csdn.net/qq_32257509/article/details/140821779
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 noteDurations1 As New List(Of Tuple(Of Integer, Integer)) '一个文本框的音符时长列表
Private noteDurations2 As New List(Of Tuple(Of Integer, Integer)) '二个文本框的音符时长列表
Private currentIndex1 As Integer = 0 '一个音轨的当前索引
Private currentIndex2 As Integer = 0 '二个音轨的当前索引

Dim p As Integer = 200 '定义播放速度






Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
    curDevice = 0 '认为第一个设备
    OpenMidiDevice() '开 MIDI 设备

    TextBox1.Text = "1 2 3 4 5 6 7 2 3"
    TextBox2.Text = "2 1 4 3 2 1 2 1 3"






    '器名称添加到多选框
    For Each instrument In instrumentMidiMap.Keys
        CheckBoxList1.Items.Add(instrument)
    Next
    CheckBoxList1.SetSelected(0, True) '始选中第一项

    '始化计时器
    timer.Interval = 1 '00 毫秒的间隔，可根据需要调整
    AddHandler timer.Tick, AddressOf Timer_Tick
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 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
        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

'停按钮点击事件
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 '置暂停位置
    currentIndex1 = 0
    currentIndex2 = 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.Tag = pausedAt '复暂停位置
        timer.Start()
    End If
End Sub

'时器的 Tick 事件，用于控制播放节奏
Private Sub Timer_Tick(ByVal sender As Object, ByVal e As EventArgs)
    If currentIndex1 < noteDurations1.Count Then
        Dim noteValue1 As Integer = noteDurations1(currentIndex1).Item1
        Dim duration1 As Integer = noteDurations1(currentIndex1).Item2

        selectedPatch = instrumentMidiMap(CheckBoxList1.SelectedItem.ToString)
        PlayNote(noteValue1)

        '据时长暂停计时器
        Thread.Sleep(duration1 * p)
        currentIndex1 += 1
    Else
        currentIndex1 = 0
    End If

    If currentIndex2 < noteDurations2.Count Then
        Dim noteValue2 As Integer = noteDurations2(currentIndex2).Item1
        Dim duration2 As Integer = noteDurations2(currentIndex2).Item2

        selectedPatch = instrumentMidiMap(CheckBoxList1.SelectedItem.ToString)
        PlayNote(noteValue2)

        '据时长暂停计时器
        Thread.Sleep(duration2 * p)
        currentIndex2 += 1
    Else
        currentIndex2 = 0
    End If

    If currentIndex1 >= noteDurations1.Count And currentIndex2 >= noteDurations2.Count Then
        timer.Stop()
        isPlaying = False
    End If
End Sub

'放音符的方法
Private Sub PlayNote(ByVal noteIndex As Integer)
    '送音色选择消息
    Dim patchChangeMessage As Integer = &HC0 Or (selectedPatch << 8)
    midiOutShortMsg(hmidi, patchChangeMessage)

    Dim midiOutValue As Integer = &H90 Or ((baseNote + noteIndex) << 8) Or (volume << 16) Or (channel << 24)
    midiOutShortMsg(hmidi, midiOutValue)
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
    If TextBox1.Text.Trim() = "" Then
        MessageBox.Show("请在文本框1中输入数字简谱！")
        Return
    End If

    If Not isPlaying Then

        noteDurations1.Clear()
        ParseAndPlayDigitalScore(TextBox1.Text, noteDurations1)

        isPlaying = True
        timer.Start()
    End If


End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    If TextBox2.Text.Trim() = "" Then
        MessageBox.Show("请先输入数字简谱！")
        Return
    End If

    If Not isPlaying Then
        noteDurations1.Clear()
        ParseAndPlayDigitalScore(TextBox1.Text, noteDurations1)

        isPlaying = True
        timer.Start()
    End If
End Sub
End Class