VB版本电子琴支持双音轨简谱播放源代码

Option Explicit

Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Dim mm As New sMidi
Private Const sColr = &H4000&

Private Sub CmdQuit_Click()
Unload FrmMain
Set FrmMain = Nothing
End
End Sub

Private Sub Form_Load()

PicA(12).CurrentX = 120
PicA(12).CurrentY = 2460
PicA(12).Print “F”
PicA(12).ForeColor = &HFF0000
PicA(12).CurrentX = 60
PicA(12).CurrentY = 2100
PicA(12).Print 1
PicA(14).CurrentX = 120
PicA(14).CurrentY = 2460
PicA(14).Print “G”
PicA(14).ForeColor = &HFF0000
PicA(14).CurrentX = 60
PicA(14).CurrentY = 2100
PicA(14).Print 2
PicA(16).CurrentX = 120
PicA(16).CurrentY = 2460
PicA(16).Print “H”
PicA(16).ForeColor = &HFF0000
PicA(16).CurrentX = 60
PicA(16).CurrentY = 2100
PicA(16).Print 3
PicA(17).CurrentX = 120
PicA(17).CurrentY = 2460
PicA(17).Print “J”
PicA(17).ForeColor = &HFF0000
PicA(17).CurrentX = 60
PicA(17).CurrentY = 2100
PicA(17).Print 4
PicA(19).CurrentX = 120
PicA(19).CurrentY = 2460
PicA(19).Print “K”
PicA(19).ForeColor = &HFF0000
PicA(19).CurrentX = 60
PicA(19).CurrentY = 2100
PicA(19).Print 5
PicA(21).CurrentX = 120
PicA(21).CurrentY = 2460
PicA(21).Print “L”
PicA(21).ForeColor = &HFF0000
PicA(21).CurrentX = 60
PicA(21).CurrentY = 2100
PicA(21).Print 6
PicA(23).CurrentX = 135
PicA(23).CurrentY = 2445
PicA(23).Print “;”
PicA(23).ForeColor = &HFF0000
PicA(23).CurrentX = 60
PicA(23).CurrentY = 2100
PicA(23).Print 7
PicA(11).CurrentX = 120
PicA(11).CurrentY = 2460
PicA(11).Print “D”
PicA(11).ForeColor = &HFF0000
PicA(11).CurrentX = 60
PicA(11).CurrentY = 2100
PicA(11).Print 7
PicA(11).CurrentX = 150
PicA(11).CurrentY = 2190
PicA(11).Print “.”
PicA(9).CurrentX = 120
PicA(9).CurrentY = 2460
PicA(9).Print “S”
PicA(9).ForeColor = &HFF0000
PicA(9).CurrentX = 60
PicA(9).CurrentY = 2100
PicA(9).Print 6
PicA(9).CurrentX = 150
PicA(9).CurrentY = 2190
PicA(9).Print “.”
PicA(7).CurrentX = 120
PicA(7).CurrentY = 2460
PicA(7).Print “A”
PicA(7).ForeColor = &HFF0000
PicA(7).CurrentX = 60
PicA(7).CurrentY = 2100
PicA(7).Print 5
PicA(7).CurrentX = 150
PicA(7).CurrentY = 2190
PicA(7).Print “.”
PicA(5).CurrentX = 120
PicA(5).CurrentY = 2460
PicA(5).Print “R”
PicA(5).ForeColor = &HFF0000
PicA(5).CurrentX = 60
PicA(5).CurrentY = 2100
PicA(5).Print 4
PicA(5).CurrentX = 150
PicA(5).CurrentY = 2190
PicA(5).Print “.”
PicA(4).CurrentX = 120
PicA(4).CurrentY = 2460
PicA(4).Print “E”
PicA(4).ForeColor = &HFF0000
PicA(4).CurrentX = 60
PicA(4).CurrentY = 2100
PicA(4).Print 3
PicA(4).CurrentX = 150
PicA(4).CurrentY = 2190
PicA(4).Print “.”
PicA(2).CurrentX = 90
PicA(2).CurrentY = 2460
PicA(2).Print “W”
PicA(2).ForeColor = &HFF0000
PicA(2).CurrentX = 60
PicA(2).CurrentY = 2100
PicA(2).Print 2
PicA(2).CurrentX = 150
PicA(2).CurrentY = 2190
PicA(2).Print “.”
PicA(0).CurrentX = 120
PicA(0).CurrentY = 2460
PicA(0).Print “Q”
PicA(0).ForeColor = &HFF0000
PicA(0).CurrentX = 60
PicA(0).CurrentY = 2100
PicA(0).Print 1
PicA(0).CurrentX = 150
PicA(0).CurrentY = 2190
PicA(0).Print “.”
PicA(24).CurrentX = 120
PicA(24).CurrentY = 2520
PicA(24).Print “”“”
PicA(24).ForeColor = &HFF0000
PicA(24).CurrentX = 60
PicA(24).CurrentY = 2100
PicA(24).Print 1
PicA(24).CurrentX = 150
PicA(24).CurrentY = 1890
PicA(24).Print “.”
PicA(26).CurrentX = 120
PicA(26).CurrentY = 2460
PicA(26).Print “U”
PicA(26).ForeColor = &HFF0000
PicA(26).CurrentX = 60
PicA(26).CurrentY = 2100
PicA(26).Print 2
PicA(26).CurrentX = 150
PicA(26).CurrentY = 1890
PicA(26).Print “.”
PicA(28).CurrentX = 120
PicA(28).CurrentY = 2460
PicA(28).Print “I”
PicA(28).ForeColor = &HFF0000
PicA(28).CurrentX = 60
PicA(28).CurrentY = 2100
PicA(28).Print 3
PicA(28).CurrentX = 150
PicA(28).CurrentY = 1890
PicA(28).Print “.”
PicA(29).CurrentX = 120
PicA(29).CurrentY = 2460
PicA(29).Print “O”
PicA(29).ForeColor = &HFF0000
PicA(29).CurrentX = 60
PicA(29).CurrentY = 2100
PicA(29).Print 4
PicA(29).CurrentX = 150
PicA(29).CurrentY = 1890
PicA(29).Print “.”
PicA(31).CurrentX = 120
PicA(31).CurrentY = 2460
PicA(31).Print “P”
PicA(31).ForeColor = &HFF0000
PicA(31).CurrentX = 60
PicA(31).CurrentY = 2100
PicA(31).Print 5
PicA(31).CurrentX = 150
PicA(31).CurrentY = 1890
PicA(31).Print “.”
PicA(33).CurrentX = 135
PicA(33).CurrentY = 2445
PicA(33).Print “[”
PicA(33).ForeColor = &HFF0000
PicA(33).CurrentX = 60
PicA(33).CurrentY = 2100
PicA(33).Print 6
PicA(33).CurrentX = 150
PicA(33).CurrentY = 1890
PicA(33).Print “.”
PicA(35).CurrentX = 135
PicA(35).CurrentY = 2445
PicA(35).Print “]”
PicA(35).ForeColor = &HFF0000
PicA(35).CurrentX = 60
PicA(35).CurrentY = 2100
PicA(35).Print 7
PicA(35).CurrentX = 150
PicA(35).CurrentY = 1890
PicA(35).Print “.”

PicA(1).CurrentX = 105
PicA(1).CurrentY = 1320
PicA(1).Print “1”
PicA(3).CurrentX = 120
PicA(3).CurrentY = 1320
PicA(3).Print “2”
PicA(6).CurrentX = 105
PicA(6).CurrentY = 1320
PicA(6).Print “Z”
PicA(8).CurrentX = 105
PicA(8).CurrentY = 1320
PicA(8).Print “X”
PicA(10).CurrentX = 105
PicA(10).CurrentY = 1320
PicA(10).Print “C”
PicA(13).CurrentX = 105
PicA(13).CurrentY = 1320
PicA(13).Print “V”
PicA(15).CurrentX = 105
PicA(15).CurrentY = 1320
PicA(15).Print “B”
PicA(18).CurrentX = 105
PicA(18).CurrentY = 1320
PicA(18).Print “N”
PicA(20).CurrentX = 105
PicA(20).CurrentY = 1320
PicA(20).Print “M”
PicA(22).CurrentX = 150
PicA(22).CurrentY = 1275
PicA(22).Print “,”
PicA(25).CurrentX = 150
PicA(25).CurrentY = 1305
PicA(25).Print “.”
PicA(27).CurrentX = 120
PicA(27).CurrentY = 1320
PicA(27).Print “/”
PicA(30).CurrentX = 120
PicA(30).CurrentY = 1320
PicA(30).Print “8”
PicA(32).CurrentX = 120
PicA(32).CurrentY = 1320
PicA(32).Print “9”
PicA(34).CurrentX = 120
PicA(34).CurrentY = 1320
PicA(34).Print “0”
mm.MidOpen
End Sub

Private Sub Form_Unload(Cancel As Integer)
mm.MidStop
mm.MidClose
Set mm = Nothing
End Sub

Private Sub PicA_Click(Index As Integer)
mm.outNum (Index + 48)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 81: Call PicA_Click(0)
Case 49: Call PicA_Click(1)
Case 87: Call PicA_Click(2)
Case 50: Call PicA_Click(3)
Case 69: Call PicA_Click(4)
Case 82: Call PicA_Click(5)
Case 90: Call PicA_Click(6)
Case 65: Call PicA_Click(7)
Case 88: Call PicA_Click(8)
Case 83: Call PicA_Click(9)
Case 67: Call PicA_Click(10)
Case 68: Call PicA_Click(11)
Case 70: Call PicA_Click(12)
Case 86: Call PicA_Click(13)
Case 71: Call PicA_Click(14)
Case 66: Call PicA_Click(15)
Case 72: Call PicA_Click(16)
Case 74: Call PicA_Click(17)
Case 78: Call PicA_Click(18)
Case 75: Call PicA_Click(19)
Case 77: Call PicA_Click(20)
Case 76: Call PicA_Click(21)
Case 188: Call PicA_Click(22)
Case 186: Call PicA_Click(23)
Case 222: Call PicA_Click(24)
Case 190: Call PicA_Click(25)
Case 85: Call PicA_Click(26)
Case 191: Call PicA_Click(27)
Case 73: Call PicA_Click(28)
Case 79: Call PicA_Click(29)
Case 56: Call PicA_Click(30)
Case 80: Call PicA_Click(31)
Case 57: Call PicA_Click(32)
Case 219: Call PicA_Click(33)
Case 48: Call PicA_Click(34)
Case 221: Call PicA_Click(35)
End Select
End Sub

Private Sub Command1_Click()
Dim s1 As String
Dim s2 As String
Dim i As Integer

s1 = Text1(0).Text
s2 = Text2(1).Text '假设第二个文本框的名称为 Text1(1)

For i = 1 To Len(s1) Or Len(s2) '取两个字符串长度中的较大值作为循环次数
    Dim note1 As String
    Dim note2 As String
    
    If i <= Len(s1) Then
        note1 = Mid(s1, i, 1)
    Else
        note1 = "" '如果第一个字符串结束了，设置为空字符串
    End If
    
    If i <= Len(s2) Then
        note2 = Mid(s2, i, 1)
    Else
        note2 = "" '如果第二个字符串结束了，设置为空字符串
    End If
    
    Dim midiNote1 As Integer
    Dim midiNote2 As Integer
    
    Select Case note1
        Case "1"
            midiNote1 = 23
        Case "2"
            midiNote1 = 34
        Case "3"
            midiNote1 = 36
        Case "4"
            midiNote1 = 38
        Case "5"
            midiNote1 = 40
        Case "6"
            midiNote1 = 42
        Case "7"
            midiNote1 = 44
        Case Else
            midiNote1 = 0
    End Select
    
    Select Case note2
        Case "1"
            midiNote2 = 23
        Case "2"
            midiNote2 = 34
        Case "3"
            midiNote2 = 36
        Case "4"
            midiNote2 = 38
        Case "5"
            midiNote2 = 40
        Case "6"
            midiNote2 = 42
        Case "7"
            midiNote2 = 44
        Case Else
            midiNote2 = 0
    End Select
    
    If midiNote1 > 0 Then
        Call PicA_Click(midiNote1)
    End If
    
    If midiNote2 > 0 Then
        Call PicA_Click(midiNote2)
    End If
    
    Sleep 300
Next

End Sub

类模块代码
Option Explicit

'Power By QQ:30892070

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 Rc As Long
Private Hmidi As Long
Private StopMidimsg

Private Const CurDevice = 0
Private Const Channel = 0
Private Const Volume = 100

Private mvarsType As Integer

'0 Acoustic Grand Piano 大钢琴（声学钢琴）
'1 Bright Acoustic Piano 明亮的钢琴
'2 Electric Grand Piano 电钢琴
'3 Honky-tonk Piano 酒吧钢琴
'4 Rhodes Piano 柔和的电钢琴
'5 Chorused Piano 加合唱效果的电钢琴
'6 Harpsichord 羽管键琴（拨弦古钢琴）
'7 Clavichord 科拉维科特琴（击弦古钢琴）
'色彩打击乐器
'8 Celesta 钢片琴
'9 Glockenspiel 钟琴
'10 Music box 八音盒
'11 Vibraphone 颤音琴
'12 Marimba 马林巴
'13 Xylophone 木琴
'14 Tubular Bells 管钟
'15 Dulcimer 大扬琴
'风琴
'16 Hammond Organ 击杆风琴
'17 Percussive Organ 打击式风琴
'18 Rock Organ 摇滚风琴
'19 Church Organ 教堂风琴
'20 Reed Organ 簧管风琴
'21 Accordian 手风琴
'22 Harmonica 口琴
'23 Tango Accordian 探戈手风琴
'吉他
'24 Acoustic Guitar (nylon) 尼龙弦吉他
'25 Acoustic Guitar (steel) 钢弦吉他
'26 Electric Guitar (jazz) 爵士电吉他
'27 Electric Guitar (clean) 清音电吉他
'28 Electric Guitar (muted) 闷音电吉他
'29 Overdriven Guitar 加驱动效果的电吉他
'30 Distortion Guitar 加失真效果的电吉他
'31 Guitar Harmonics 吉他和音
'贝司
'32 Acoustic Bass 大贝司（声学贝司）
'33 Electric Bass(finger) 电贝司（指弹）
'34 Electric Bass (pick) 电贝司（拨片）
'35 Fretless Bass 无品贝司
'36 Slap Bass 1 掌击Bass 1
'37 Slap Bass 2 掌击Bass 2
'38 Synth Bass 1 电子合成Bass 1
'39 Synth Bass 2 电子合成Bass 2
'弦乐
'40 Violin 小提琴
'41 Viola 中提琴
'42 Cello 大提琴
'43 Contrabass 低音大提琴
'44 Tremolo Strings 弦乐群颤音音色
'45 Pizzicato Strings 弦乐群拨弦音色
'46 Orchestral Harp 竖琴
'47 Timpani 定音鼓
'合奏/合唱
'48 String Ensemble 1 弦乐合奏音色1
'49 String Ensemble 2 弦乐合奏音色2
'50 Synth Strings 1 合成弦乐合奏音色1
'51 Synth Strings 2 合成弦乐合奏音色2
'52 Choir Aahs 人声合唱“啊”
'53 Voice Oohs 人声“嘟”
'54 Synth Voice 合成人声
'55 Orchestra Hit 管弦乐敲击齐奏
'铜管
'56 Trumpet 小号
'57 Trombone 长号
'58 Tuba 大号
'59 Muted Trumpet 加弱音器小号
'60 French Horn 法国号（圆号）
'61 Brass Section 铜管组（铜管乐器合奏音色）
'62 Synth Brass 1 合成铜管音色1
'63 Synth Brass 2 合成铜管音色2
'簧管
'64 Soprano Sax 高音萨克斯风
'65 Alto Sax 次中音萨克斯风
'66 Tenor Sax 中音萨克斯风
'67 Baritone Sax 低音萨克斯风
'68 Oboe 双簧管
'69 English Horn 英国管
'70 Bassoon 巴松(大管)
'71 Clarinet 单簧管(黑管)
'笛
'72 Piccolo 短笛
'73 Flute 长笛
'74 Recorder 竖笛
'75 Pan Flute 排箫
'76 Bottle Blow [中文名称暂缺]
'77 Shakuhachi 日本尺八
'78 Whistle 口哨声
'79 Ocarina 奥卡雷那
'合成主音
'80 Lead 1 (square) 合成主音1（方波）
'81 Lead 2 (sawtooth) 合成主音2（锯齿波）
'82 Lead 3 (caliope lead) 合成主音3
'83 Lead 4 (chiff lead) 合成主音4
'84 Lead 5 (charang) 合成主音5
'85 Lead 6 (voice) 合成主音6（人声）
'86 Lead 7 (fifths) 合成主音7（平行五度）
'87 Lead 8 (bass+lead) 合成主音8（贝司加主音）
'合成音色
'88 Pad 1 (new age) 合成音色1（新世纪）
'89 Pad 2 (warm) 合成音色2 （温暖）
'90 Pad 3 (polysynth) 合成音色3
'91 Pad 4 (choir) 合成音色4 （合唱）
'92 Pad 5 (bowed) 合成音色5
'93 Pad 6 (metallic) 合成音色6 （金属声）
'94 Pad 7 (halo) 合成音色7 （光环）
'95 Pad 8 (sweep) 合成音色8
'合成效果
'96 FX 1 (rain) 合成效果 1 雨声
'97 FX 2 (soundtrack) 合成效果 2 音轨
'98 FX 3 (crystal) 合成效果 3 水晶
'99 FX 4 (atmosphere) 合成效果 4 大气
'100 FX 5 (brightness) 合成效果 5 明亮
'101 FX 6 (goblins) 合成效果 6 鬼怪
'102 FX 7 (echoes) 合成效果 7 回声
'103 FX 8 (sci-fi) 合成效果 8 科幻
'民间乐器
'104 Sitar 西塔尔(印度)
'105 Banjo 班卓琴(美洲)
'106 Shamisen 三昧线(日本)
'107 Koto 十三弦筝(日本)
'108 Kalimba 卡林巴
'109 Bagpipe 风笛
'110 Fiddle 民族提琴
'111 Shanai 山奈
'打击乐器
'112 Tinkle Bell 叮当铃
'113 Agogo [中文名称暂缺]
'114 Steel Drums 钢鼓
'115 Woodblock 木鱼
'116 Taiko Drum 太鼓
'117 Melodic Tom 通通鼓
'118 Synth Drum 合成鼓
'119 Reverse Cymbal 铜钹
'Sound Effects 声音效果
'120 Guitar Fret Noise 吉他换把杂音
'121 Breath Noise 呼吸声
'122 Seashore 海浪声
'123 Bird Tweet 鸟鸣
'124 Telephone Ring 电话铃
'125 Helicopter 直升机
'126 Applause 鼓掌声
'127 Gunshot

Public Property Let sType(ByVal New_Data As Integer)
If Not IsNumeric(New_Data) Then New_Data = 0
If New_Data < 0 Then New_Data = 0
If New_Data > 127 Then New_Data = 127
mvarsType = New_Data
midiOutShortMsg Hmidi, mvarsType * &H100 + &HC0
End Property

Public Property Get sType() As Integer
sType = mvarsType
End Property

Public Function MidOpen() As Long
Call midiOutClose(Hmidi)
Rc = midiOutOpen(Hmidi, CurDevice, 0, 0, 0)
If (Rc <> 0) Then
Call midiOutClose(Hmidi)
End If
midiOutShortMsg Hmidi, &HC0
MidOpen = Rc
End Function

Public Sub MidStop()
Call midiOutShortMsg(Hmidi, StopMidimsg)
End Sub

Public Sub MidClose()
Call midiOutClose(Hmidi)
End Sub

Public Sub outNum(ByVal sNum As Integer)
If Not IsNumeric(sNum) Then Exit Sub
If sNum < 0 Then sNum = 0
If sNum > 127 Then sNum = 127
StopMidimsg = &H80 + ((sNum) * &H100) + Channel
Call midiOutShortMsg(Hmidi, &H90 + ((sNum) * &H100) + (Volume * &H10000) + Channel)
End Sub