VB中使用DirectX库的简明教程(11)

Dim objDX As New DirectX7
Dim objDMLoader As DirectMusicLoader
Dim objDMPerf As DirectMusicPerformance
Dim objDMSeg As DirectMusicSegment
Dim objDMSegSt As DirectMusicSegmentState
Dim DTimesig As DMUS_TIMESIGNATURE
Dim portcaps As DMUS_PORTCAPS

Dim lTimePassed As Long
Dim lMTime As Long
Dim lTempo, GetStartTime, Offset As Long
Dim ElapsedTime2 As Long
Dim ElapsedTime, sAllTime As String
Dim fIsPaused As Boolean
Sub GetTimePassed()
Dim min As Integer
Dim a As Single

'首先确定objDMSegSt以及objDMPerf是否有效
If objDMSegSt Is Nothing Or objDMPerf Is Nothing Then
Exit Sub
End If


'处于播放状态
If objDMPerf.IsPlaying(Nothing, objDMSegSt) = True Then
'获得以秒计算的播放时间
ElapsedTime2 = ((((objDMPerf.GetMusicTime() - (objDMSegSt.GetStartTime() _
- Offset)) / 768) * 60) / lTempo)

'获得分钟
min = 0
a = ElapsedTime2 - 60
Do While a >= 0
min = min 1
a = a - 60
Loop
ElapsedTime = Format(min, "00") & ":" & Format(Abs((ElapsedTime2 - (min * 60))), "00.0")
Else
If fIsPaused Then
Else
ElapsedTime = "00:00.0"
End If
End If
End Sub
Private Sub Command1_Click()
Set objDMLoader = Nothing
Set objDMLoader = objDX.DirectMusicLoaderCreate

CommonDialog1.Filter = "MIDI Files (*.mid)|*.mid" ' Set filters
CommonDialog1.InitDir = App.Path
CommonDialog1.ShowOpen

If Dir$(CommonDialog1.FileName) <> "" Then
Me.Caption = CommonDialog1.FileName
'读入MIDI文件
Set objDMSeg = objDMLoader.LoadSegment(CommonDialog1.FileName)

'获得MIDI文件的播放时间
lMTime = objDMPerf.GetMusicTime()
'播放一定程度的MIDI文件以获取文件信息
Call objDMPerf.PlaySegment(objDMSeg, 0, lMTime 2000)

'获取MIDI播放速度
lTempo = objDMPerf.GetTempo(lMTime 2000, 0)
Label2.Caption = "MIDI速度" Format(lTempo, "00.00")

'获得MIDI节拍信息
Call objDMPerf.GetTimeSig(lMTime 2000, 0, DTimesig)
Label3.Caption = "MIDI节拍" & DTimesig.beatsPerMeasure & "/" & DTimesig.beat

Dim a, Minutes, mtlength As Long
'获得MIDI播放长度
mtlength = (((objDMSeg.GetLength() / 768) * 60) / lTempo)

Minutes = 0
a = mtlength - 60
Do While a > 0
Minutes = Minutes 1
a = a - 60
Loop
Label1.Caption = "MIDI播放时间" Format(Minutes, "00") & ":" & _
Format((mtlength - (Minutes * 60)), "00.0")
sAllTime = Format(Minutes, "00") & ":" & Format((mtlength - (Minutes * 60)), "00.0")
'已经获得足够长度的MIDI文件信息，停止播放
Call objDMPerf.Stop(objDMSeg, Nothing, 0, 0)
objDMSeg.SetStandardMidiFile

Command2.Enabled = True
Else
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End If
End Sub

Private Sub Command2_Click()
Timer1.Enabled = True

If objDMSeg Is Nothing Then
MsgBox ("没有可以播放的MIDI文件，请先打开一个MIDI文件")
Exit Sub
End If

If fIsPaused Then '当前处于暂停状态
'获得暂停位置
Offset = lMTime - GetStartTime Offset 1
'设置开始播放点为暂停位置
Call objDMSeg.SetStartPoint(Offset)
'播放MIDI
Set objDMSegSt = objDMPerf.PlaySegment(objDMSeg, 0, 0)
fIsPaused = False
Sleep (90)
Else
Offset = 0
If objDMPerf.IsPlaying(objDMSeg, objDMSegSt) = True Then
'停止播放
Call objDMPerf.Stop(objDMSeg, objDMSegSt, 0, 0)
End If
objDMSeg.SetStartPoint (0)
Set objDMSegSt = objDMPerf.PlaySegment(objDMSeg, 0, 0)
Sleep (90)
End If
Command2.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
End Sub

Private Sub Command3_Click()
On Error GoTo LocalErrors

If objDMSeg Is Nothing Then Exit Sub

If objDMPerf.IsPlaying(objDMSeg, objDMSegSt) = True Then
fIsPaused = True
'获得已经播放的长度
lMTime = objDMPerf.GetMusicTime()
GetStartTime = objDMSegSt.GetStartTime()
Call objDMPerf.Stop(objDMSeg, Nothing, 0, 0)
End If
Command2.Enabled = True
Command3.Enabled = False
Command4.Enabled = False
Exit Sub
LocalErrors:
Call Err.Raise(Err.Number, Err.Source, Err.Description)
End Sub

Private Sub Command4_Click()
If objDMSeg Is Nothing Then
Exit Sub
End If

fIsPaused = False
'停止播放MIDI文件
Call objDMPerf.Stop(objDMSeg, objDMSegSt, 0, 0)
End Sub

Private Sub Form_Load()
Me.Show

'建立DirectMusicLoader对象
Set objDMLoader = objDX.DirectMusicLoaderCreate
'建立DirectMusicPerformance对象
Set objDMPerf = objDX.DirectMusicPerformanceCreate
'初始化DirectMusicPerformance对象
objDMPerf.Init Nothing, 0
objDMPerf.SetPort -1, 80
objDMPerf.SetMasterAutoDownload (True)
objDMPerf.SetMasterVolume (-700)

Command1.Caption = "打开MIDI文件"
Command2.Caption = "播放"
Command3.Caption = "暂停"
Command4.Caption = "停止"
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Timer1.Interval = 100
Timer1.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有