VB.NET版本小钢琴程序代码2024-8-2-QZQ

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) '始选中第一项
        TextBox1.Text = "1 2 3 4 5 6 7 8"
        TextBox2.Text = "6 5 4 3 2 1 7 6"



        '始化计时器
        timer.Interval = p '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


    ' 打开第二个 MIDI 设备的方法
    Private Sub OpenMidiDevice2()
        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(hmidi2, curDevice2, 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 = "" ' 假设这是第一个音轨的数字简谱

        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 PlayTrack2()
        Dim noteDurations2 As New List(Of Tuple(Of Integer, Integer)) ' 声明为 PlayTrack2 方法的局部变量

        Dim digitalScore2 As String = "" ' 假设这是第二个音轨的数字简谱

        Dim scoreParts2 As String() = digitalScore2.Split(" "c)

        noteDurations2.Clear() ' 清空之前的内容

        For Each part In scoreParts2
            Dim parts As String() = part.Split("-") ' 尝试按 - 分割，以获取音符和可能的时长

            If parts.Length = 1 Then
                ' 如果没有 - ，则默认时长为 1
                noteDurations2.Add(Tuple.Create(Convert.ToInt32(parts(0)), 1))
            ElseIf parts.Length = 2 Then
                ' 如果有 - ，则第一个部分是音符，第二个部分是时长
                noteDurations2.Add(Tuple.Create(Convert.ToInt32(parts(0)), Convert.ToInt32(parts(1))))
            Else
                ' 格式错误，处理或跳过
                MessageBox.Show("数字简谱格式错误: " & part)
            End If
        Next

        Dim timer2 As New System.Windows.Forms.Timer() ' 为第二个音轨创建独立的计时器
        timer2.Interval = p ' 200 毫秒的间隔，可根据需要调整
        AddHandler timer2.Tick, AddressOf Timer2_Tick

        Dim currentIndex2 As Integer = 0

        timer2.Tag = currentIndex2 + 1

        timer2.Start()
    End Sub

    Private Sub Timer2_Tick(ByVal sender As Object, ByVal e As EventArgs)
        Dim currentIndex2 As Integer = CInt(timer2.Tag)

        If currentIndex2 < noteDurations2.Count Then ' 现在可以访问 noteDurations2 了
            Dim noteValue As Integer = noteDurations2(currentIndex2).Item1
            Dim duration As Integer = noteDurations2(currentIndex2).Item2

            selectedPatch2 = instrumentMidiMap(CheckBoxList1.SelectedItem.ToString) ' 获取选中的音色编号
            ' 发送音色选择消息
            Dim patchChangeMessage2 As Integer = &HC0 Or (selectedPatch2 << 8)
            midiOutShortMsg(hmidi2, patchChangeMessage2)

            Dim midiOutValue2 As Integer = &H90 Or ((baseNote + noteValue) << 8) Or (volume2 << 16) Or (channel2 << 24)
            midiOutShortMsg(hmidi2, midiOutValue2)

            ' 根据时长暂停计时器
            Timer2.Interval = duration * p
            timer2.Tag = currentIndex2 + 1
        Else
            Timer2.Stop()
        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
            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.Tag = pausedAt '复暂停位置
            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
End Class