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)
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
