1,502
社区成员
发帖
与我相关
我的任务
分享
Private Sub open_Click()
Dim b As String
Dim ch(16) As Integer
Dim Channel As Integer
Dim Temp As String
Dim ChannelNo As Integer
Dim MusicNo As Integer
Dim filename As String
Dim i, j As Long
For j = 1 To 16
For i = 1 To 3000
Delay(j, i) = -1
Next i
Next j
Me.CommonDialog1.ShowOpen
If Me.CommonDialog1.filename = "" Then Exit Sub
filename = Me.CommonDialog1.filename
If Dir(filename) = "" Then
MsgBox "找不到文件"
Exit Sub
End If
Open filename For Input As #1
Do While Not EOF(1)
Input #1, b
If InStr(UCase(b), "CHANNEL") <> 0 Then
Temp = Trim(Mid(b, 9, 10))
ChannelNo = Val(Mid(Temp, 1, InStr(Temp, " ")))
MusicNo = Val(Mid(Temp, InStr(Temp, " "), 10))
Call midi_outshort(&HB0 + ChannelNo, 0, 0)
Call midi_outshort(&HC0 + ChannelNo, MusicNo, 0)
Else
Channel = Val(Mid(b, 14, 2))
ch(Channel) = ch(Channel) + 1
Sound(Channel, ch(Channel)) = Mid(b, 1, 10)
Delay(Channel, ch(Channel)) = Val(Mid(b, 11, 3))
End If
Loop
Close #1
End Sub
Private Sub play_Click()
Dim s As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
'Timer1.Enabled = True
For i = 1 To 16
Playch(i) = 1
PlaySound(i) = Sound(i, 1)
PlayDelay(i) = Delay(i, 1)
For j = 1 To 10
s = Mid(PlaySound(i), j, 1)
If s <> " " And s <> "" Then StartNote NoteFromkey(Asc(s)), i
Next j
Next i
Call PlaySoundTimer
Private Sub PlaySoundTimer()
Dim i As Integer
Dim k As Integer
Dim j As Integer
Dim s As String
flag = True
Do While flag
k = 0
For i = 1 To 16
' k = k + PlayDelay(Playch(i))
k = k + PlayDelay(i)
If k = -16 Then
flag = False
Exit Sub
End If
Next i
For i = 1 To 16
If PlayDelay(i) <> -1 Then
If PlayDelay(i) = 0 Then
'关闭上一组
' StopNote NoteFromKey(Asc(Mid(PlaySound(i), 1, 1))), i
For j = 1 To 10
s = Mid(PlaySound(i), j, 1)
If s <> " " And s <> "" Then StopNote NoteFromkey(Asc(s)), i
Next j
Playch(i) = Playch(i) + 1
PlaySound(i) = Sound(i, Playch(i))
PlayDelay(i) = Delay(i, Playch(i))
'开启下一组
' StartNote NoteFromKey(Asc(Mid(PlaySound(i), 1, 1)))
For j = 1 To 10
s = Mid(PlaySound(i), j, 1)
If s <> " " And s <> "" Then StartNote NoteFromkey(Asc(s)), i
Next j
Else
PlayDelay(i) = PlayDelay(i) - 1
End If
End If
Next i
DoEvents
Sleep (DelayTimer)
DoEvents
Loop
End Sub
Private Sub stop_Click()
Timer1.Enabled = False
flag = False
DoEvents
If flag = False Then
End If
End Sub