本文主要是介绍用VB6来实现QBASIC中的Play语句，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！
很久以前写的了，用Midi的API函数来实现以前QBasic中的Play语句，控制符实现可能还不完善，感觉演奏的还是有些问题，懒得弄了，发出来吧。希望有人可以接着完善一下，关于Play语句可以参考一下这个https://www.cnblogs.com/djcsch2001/articles/1965318.html
用法，Play "ABCDEFGAB"
下边是这个bas模块文件的代码，例程代码下载地址 https://download.csdn.net/download/bakw/88457053
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public 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
Public Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Public Declare Function midiOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function timeGetDevCaps Lib "winmm.dll" (lpTimeCaps As TIMECAPS, ByVal uSize As Long) As Long
Public Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Public Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Public Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Public Const MIDI_MAPPER = -1 'MIDI
Public Const DSSCL_PRIORITY = 2 'DX7Type MIDIOUTCAPSwMid As IntegerwPid As IntegervDriverVersion As LongszPname As String * 32wTechnology As IntegerwVoices As IntegerwNotes As IntegerwChannelMask As IntegerdwSupport As Long
End TypeType TIMECAPSwPeriodMin As LongwPeriodMax As Long
End TypePrivate NumDevs As Long
Private WaveNumDevs As LongPrivate BestRes As LongPublic Function Initialize() As LongDim TC As TIMECAPS, Rv As LongDim hMidiOut As LongInitialize = 0NumDevs = midiOutGetNumDevs()WaveNumDevs = waveOutGetNumDevs()Rv = timeGetDevCaps(TC, Len(TC))If Rv <> 0 Then Exit Function 'ExitBestRes = TC.wPeriodMinRv = timeBeginPeriod(BestRes)If Rv <> 0 Then Exit Function 'ExitRv = midiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)If Rv <> 0 ThentimeEndPeriod BestResExit Function 'ExitEnd IfInitialize = hMidiOut
End FunctionPublic Sub Terminate(ByVal hMidiOut As Long)timeEndPeriod BestResmidiOutClose hMidiOut
End SubPublic Sub Play(ByVal MusicStr As String)Dim hMidiOut As Long, dwMsg As Long, I As Long, J As Integer, L As Integer, F As IntegerDim CH As String, Num As Integer, BFlip As Integer, T As Long, XT As LongDim Volume As Integer, Channel As Integer, BT As Long, Flip As IntegerMusicStr = Replace(MusicStr, Chr(0), "")MusicStr = Replace(MusicStr, Chr(32), "")hMidiOut = 0Volume = 100Channel = 0BT = 500BFlip = 60L = Len(MusicStr)If L = 0 Then Exit SubhMidiOut = InitializeIf hMidiOut = 0 ThenDebug.Print "Initialize Error"Exit SubEnd IfI = 1T = BTXT = 0F = 0Flip = BFlipDoXT = 0Flip = 0CH = UCase(Mid(MusicStr, I, 1))I = I + 1Select Case CHCase "A", "B", "C", "D", "E", "F", "G"Select Case CHCase "A"Flip = BFlip + 10Case "B"Flip = BFlip + 12Case "C"Flip = BFlipCase "D"Flip = BFlip + 2Case "E"Flip = BFlip + 4Case "F"Flip = BFlip + 6Case "G"Flip = BFlip + 8End SelectIf I <= L Then CH = Mid(MusicStr, I, 1) Else CH = ""If (CH = "+") Or (CH = "#") ThenFlip = Flip + 1I = I + 1ElseIf (CH = "-") Or (CH = "$") ThenFlip = Flip - 1I = I + 1End IfCH = ""If I <= L ThenDo Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopEnd IfIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 1If Num = 0 Then Num = 1If I <= L Then CH = Mid(MusicStr, I, 1) Else CH = ""T = CLng(BT / Num)If CH = "." ThenI = I + 1XT = 0.5 * TEnd IfCase "L"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 1If Num = 0 Then Num = 1T = CLng(BT / Num)XT = -TCase "M"Select Case Mid(MusicStr, I, 1)Case "N"F = 1Case "L"F = 0End SelectCase "O"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 4BFlip = 4 + 14 * NumXT = -TCase "P", "R"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 1If Num = 0 Then Num = 1If I <= L Then CH = Mid(MusicStr, I, 1) Else CH = ""T = CLng(BT / Num)If CH = "." ThenI = I + 1XT = 0.5 * TEnd IfCase "T"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 0If Num > 0 Then BT = 60000 \ NumCase "V"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 100Volume = NumCase "Y"CH = ""Do Until Not IsNumeric(Mid(MusicStr, I, 1))CH = CH & Mid(MusicStr, I, 1)I = I + 1If I > L Then Exit DoLoopIf IsNumeric(CH) Then Num = CInt(CH) Else Num = 0If hMidiOut <> 0 Then midiOutShortMsg hMidiOut, CLng(Num) * &H100 + &HC0 + CLng(Channel)XT = -TCase ElseEnd SelectIf Flip > 0 ThendwMsg = CLng(Volume) * &H10000 + CLng(Flip) * &H100 + &H90 + CLng(Channel)If hMidiOut <> 0 Then midiOutShortMsg hMidiOut, dwMsgEnd IfSleep T + XTIf Flip > 0 Or F > 0 ThendwMsg = CLng(Flip) * &H100 + &H80 + CLng(Channel)If hMidiOut <> 0 Then midiOutShortMsg hMidiOut, dwMsgEnd IfLoop Until I > Len(MusicStr)If hMidiOut <> 0 Then Terminate hMidiOut
End Sub
这篇关于用VB6来实现QBASIC中的Play语句的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！
