VB编写DirectX简明教程_VB.NET程序_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

VB编写DirectX简明教程

作者：闵涛文章来源：闵涛的学习笔记点击数：6131 更新时间：2009/4/23 18:58:56

''''以黑色圈标出收听者所在的位置 Picture1.Circle (Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2), 4 ''''以红色圈标出声音所在的位置 X = CInt(m_pos.X) + Picture1.ScaleWidth / 2 z = CInt(m_pos.z) + Picture1.ScaleHeight / 2 Picture1.Circle (X, z), 4, RGB(255, 0, 0) End Sub Sub Load(sFile As String) Dim bufferDesc1 As DSBUFFERDESC Dim waveFormat1 As WAVEFORMATEX ''''设置将建立的DirectSoundBuffer对象的属性 bufferDesc1.lFlags = (DSBCAPS_CTRL3D Or DSBCAPS_CTRLFREQUENCY Or _ DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME) Or DSBCAPS_STATIC ''''建立DirectSoundBuffer对象 Set m_dsBuffer = m_ds.CreateSoundBufferFromFile(sFile, bufferDesc1, _ waveFormat1) ''''设置DirectSoundBuffer对象的声音（0为最大） m_dsBuffer.SetVolume 0 ''''设置DirectSoundBuffer对象 Set m_ds3dBuffer = m_dsBuffer.GetDirectSound3DBuffer ''''设置DirectSoundBuffer对象的播放方向属性 m_ds3dBuffer.SetConeOrientation 1, 1, 1, DS3D_IMMEDIATE m_ds3dBuffer.SetConeAngles DS3D_MINCONEANGLE, 100, DS3D_IMMEDIATE m_ds3dBuffer.SetConeOutsideVolume -100, DS3D_IMMEDIATE ''''设置DirectSoundBuffer对象的播放位置属性 m_ds3dBuffer.SetPosition m_pos.X / 50, 0, m_pos.z / 50, DS3D_IMMEDIATE End Sub Sub UpdatePosition(X As Single, z As Single) m_pos.X = X - Picture1.ScaleWidth / 2 m_pos.z = z - Picture1.ScaleHeight / 2 DrawPositions If m_ds3dBuffer Is Nothing Then Exit Sub ''''重新设置DirectSoundBuffer对象的播放位置属性 m_ds3dBuffer.SetPosition m_pos.X / 50, 0, m_pos.z / 50, DS3D_IMMEDIATE End Sub Private Sub Command1_Click() If m_dsBuffer Is Nothing Then Call Load(App.Path + "\demo.wav") End If ''''循环播放声音文件 m_dsBuffer.Play 1 End Sub Private Sub Command2_Click() If m_dsBuffer Is Nothing Then Exit Sub m_dsBuffer.Stop m_dsBuffer.SetCurrentPosition 0 End Sub Private Sub Form_Load() Dim i As Integer Command1.Caption = "播放" Command2.Caption = "停止" Me.Show DoEvents On Local Error Resume Next ''''建立DirectSound对象 Set m_ds = m_dx.DirectSoundCreate(vbNullString) If Err.Number <> 0 Then MsgBox "无法佳丽DirectSound对象，请查看声卡或驱动程序是否安装正确" End End If ''''设置DirectSound对象的协作模式 m_ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY Dim primDesc As DSBUFFERDESC, format As WAVEFORMATEX primDesc.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_PRIMARYBUFFER ''''建立主声音缓冲对象 Set m_dsPrimaryBuffer = m_ds.CreateSoundBuffer(primDesc, format) ''''建立DirectSound3DListener对象 Set m_dsListener = m_dsPrimaryBuffer.GetDirectSound3DListener() m_pos.X = 10: m_pos.z = 50 UpdatePosition m_pos.X, m_pos.z End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then UpdatePosition X, Y End If End Sub Private Sub Picture1_Paint() DrawPositions End Sub

运行程序，在PictureBox中回出现一个黑色和一个红色的小圆圈。黑色的代表虚拟的收听者的位置，红色的代表音源的位置。点击"播放"按钮即可以播放Demo.wav文件，你可以点击PictureBox中的不同位置来设置音源的位置，然后再听一下声音发生的改变，在本人的爱机上安装的只是普通双声道声卡，所以效果不是很明显，有高档多声道声卡的朋友可以使用上面的程序感受一下你的声卡的三维效果。
五、 DirectMusic
同DirectSound类对象不同，DirectMusic类对象负责控制对于音乐数据进行播放（象一个MIDI文件）。DirectMusic对象类主要包括以下对象：
DirectMusicLoader
DirectMusicPerformance
DirectMusicSegment

DirectMusicLoader对象负责装载音乐数据文件，利用DirectX7对象的
DirectMusicLoaderCreate方法可以建立一个DirectMusicLoader对象。
DirectMusicSegment对象描述了一个音乐片断
DirectMusicPerformance对象负责对音乐数据回放进行全面控制。它可以定位音乐数据输出通道、播放音乐片断、发送消息、处理事件、获取音乐数据的相关信息等。利用DirectX7的DirectMusicPerformanceCreate方法可以建立一个DirectMusicPerformance对象。
下面是一个具体的利用DirectMusic类对象播放音乐数据文件的范例程序。首先建立一个新的工程文件，加入DirectX7说明库，然后在Form1中加入4个CommandButton控件，3个Label控件，一个CommonDialog控件和一个Timer控件。然后在Form1德代码窗口中加入以下代码：
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal lMilliseconds As Long)

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)
    Set objDMSegSt = Nothing
    Set objDMSeg = Nothing
    Set objDMPerf = Nothing
    Set objDMLoader = Nothing
    End
End Sub

Private Sub Timer1_Timer()
    GetTimePassed
    Label1.Caption = "MIDI播放时间：" + ElapsedTime + " 总时间：" + sAllTime
End Sub

运行程序，点击"打开MIDI文件"文件按钮打开一个MIDI文件，点击"播放"按钮播放文件，点击"暂停"按钮暂停播放，点击"停止"按钮停止播放。
上面的程序比较的简单，我就不做讲解了，大家可以自己分析。
由于DirectX编程是绕开了操作系统而直接对硬件进行操作，所以在编程过程中一定要比较的小心谨慎，由于Windows2000提供了对于Dire

上一页 [1] [2] [3] [4] [5] [6] 下一页

[常用软件]Flashget 1.x 简明教程  [网页制作]样式表CSS简明教程
[网页制作]CSS基础学习：样式表CSS简明教程  [网页制作]简明教程 SPAN和DIV的区别
[网页制作]XSL简明教程  [Web开发]推荐阅读HTML简明教程

教程录入：mintao 责任编辑：mintao

上一篇教程： Windows未公开函数揭密——之三

下一篇教程：深入Scripting Runtime Library 之一

【字体：小大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网]

　网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）

同类栏目

· C语言系列 · VB.NET程序
· JAVA开发 · Delphi程序
· 脚本语言

热门推荐

没有教程

赞助链接

闵涛博文

500 - 内部服务器错误。

您查找的资源存在问题，因而无法显示。

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18

闵涛站盟:医药大全-武穴网。A打造B、C、D……