vb6.0版本电子琴简谱播放器代码QZQ

Option Explicit

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

Private Const sColr = &H4000&

Dim mm As Variant '不再使用 New sMidi，而是使用 Variant 类型，可以存储不同类型的数据

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

Dim Index As Integer
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

Private 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

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

Private 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

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

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

Private 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

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

Private Sub Command2_Click()
Dim s1 As String
Dim i As Integer
Dim note1 As String
Dim noteValue1 As Integer

Dim beatsPerMinute As Integer
beatsPerMinute = Val(Combo4.List(Combo4.ListIndex))
Dim beatsPerMeasure As Integer
Dim noteDuration As Integer

Select Case Combo5.ListIndex
Case 0 '1/2
beatsPerMeasure = 1
noteDuration = 60000 / beatsPerMinute / 2
Case 1 '2/2
beatsPerMeasure = 2
noteDuration = 60000 / beatsPerMinute / 2
Case 2 '1/4
beatsPerMeasure = 1
noteDuration = 60000 / beatsPerMinute / 4
Case 3 '2/4
beatsPerMeasure = 2
noteDuration = 60000 / beatsPerMinute / 2
Case 4 '3/4
beatsPerMeasure = 3
noteDuration = 60000 / beatsPerMinute / 3
Case 5 '4/4
beatsPerMeasure = 4
noteDuration = 60000 / beatsPerMinute / 4
Case 6 '5/4
beatsPerMeasure = 5
noteDuration = 60000 / beatsPerMinute / 5
Case 7 '6/4
beatsPerMeasure = 6
noteDuration = 60000 / beatsPerMinute / 6
Case 8 '7/4
beatsPerMeasure = 7
noteDuration = 60000 / beatsPerMinute / 7
Case 9 '3/8
beatsPerMeasure = 3
noteDuration = 60000 / beatsPerMinute / 8 * 3
Case 10 '4/8
beatsPerMeasure = 4
noteDuration = 60000 / beatsPerMinute / 8 * 4
Case 11 '6/8
beatsPerMeasure = 6
noteDuration = 60000 / beatsPerMinute / 8 * 6
Case 12 '7/8
beatsPerMeasure = 7
noteDuration = 60000 / beatsPerMinute / 8 * 7
Case 13 '8/8
beatsPerMeasure = 8
noteDuration = 60000 / beatsPerMinute / 8 * 8
Case 14 '9/8
beatsPerMeasure = 9
noteDuration = 60000 / beatsPerMinute / 8 * 9
Case 15 '11/8
beatsPerMeasure = 11
noteDuration = 60000 / beatsPerMinute / 8 * 11
Case 16 '12/8
beatsPerMeasure = 12
noteDuration = 60000 / beatsPerMinute / 8 * 12
Case 17 ‘8/16
beatsPerMeasure = 8
noteDuration = 60000 / beatsPerMinute / 16 * 8
Case 18 ‘9/16
beatsPerMeasure = 9
noteDuration = 60000 / beatsPerMinute / 16 * 9
Case 19 ‘10/16
beatsPerMeasure = 10
noteDuration = 60000 / beatsPerMinute / 16 * 10
Case 20 ‘12/16
beatsPerMeasure = 12
noteDuration = 60000 / beatsPerMinute / 16 * 12
Case 21 ‘14/16
beatsPerMeasure = 14
noteDuration = 60000 / beatsPerMinute / 16 * 14
Case 22 ‘16/16
beatsPerMeasure = 16
noteDuration = 60000 / beatsPerMinute / 16 * 16
‘…添加更多情况
End Select
s1 = Text1.Text
For i = 1 To Len(s1)
If i <= Len(s1) Then
note1 = Mid(s1, i, 1)
Else
note1 = “”
End If
Dim midiNote1 As Integer
Select Case note1
Case “1.”
midiNote1 = 22
Case “2.”
midiNote1 = 23
Case “3.”
midiNote1 = 24
Case “4.”
midiNote1 = 25
Case “5.”
midiNote1 = 26
Case “6.”
midiNote1 = 27
Case “7.”
midiNote1 = 28
Case “1”
midiNote1 = 29
Case “2”
midiNote1 = 30
Case “3”
midiNote1 = 31
Case “4”
midiNote1 = 32
Case “5”
midiNote1 = 33
Case “6”
midiNote1 = 34
Case “7”
midiNote1