魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~2音效模块

魔塔之拯救白娘子完整工程下载地址：
继续上一文，游戏引擎相关源码。
ModMain.bas：作用，用来绘制图片精灵，管理物理精灵图片池。

Option Explicit'主入口
'
'管理物理精灵图片池
'
Private Type TYPE_PATH                  '路径结构.Count As Long                       '当前结构中包含的路径点数量Index As Long                       '当前使用的路径点Xs() As Long                        'X与Y路径点序列,单位为像素Ys() As LongXSpeed() As Single                  '移动到下一点的速度,单位为像素/帧,填充路径时事先计算好YSpeed() As SingleAngle As Single                     '位于当前点时的角度
End TypePrivate Type SAVE_FILEPictures() As String                '需要加载的精灵图象,格式为[文件名],[横向数量],[纵向数量]Paths() As TYPE_PATH                '需要加载的精灵路径
End TypeDim Paths() As TYPE_PATH
Dim oGraphs() As xGraphPoolSub Main()frmMain.Show
End SubPublic Sub LoadResData(ByVal sFileName As String)'加载路径与图形'
'    Dim tmpBuff As SAVE_FILE, lFn As Long
'    Dim I As Long, tmpStr() As String
'
'    lFn = FreeFile
'    Open sFileName For Binary As #lFn
'        Get #lFn, , tmpBuff
'    Close #lFn
'
'    With tmpBuff
'        ReDim oPics(UBound(.Pictures))
'        For I = 0 To UBound(.Pictures)
'            Set oPics(I) = New xGraphPool
'            tmpStr() = Split(.Pictures, ",")
'
'            oPics(I).LoadGraph tmpStr(0), xgBLACK, tmpStr(1), tmpStr(2)
'        Next
'    End With
End SubPublic Sub DrawGraph(lPicIndex As Long, sngCell As Single, sngAngle As Single, mX As Long, mY As Long)'按参数绘图'Dim i As IntegerWith oGraphs(lPicIndex)i = Int(sngCell)If i <> .Cell Then .Cell = i.SetRotate sngAngle.DrawGraph mX, mYEnd With
End Sub

xShow.cls这个模块用来播放背景音乐。


'impactX Game Engine v1.0.0
'本类模块用于多媒体文件的回放和处理
'使用本类模块必须遵守:
'你可以免费使用本引擎及代码
'使用本引擎后的责任由使用者承担
'你可以任意拷贝本引擎代码，但必须保证其完整性
'希望我能得到你使用本引擎制作出的程序
'使用DirectShow，必须在工程->引用菜单中添加ActiveMovie control type library
'Davy.xu sunicdavy@sina.com qq:20998333
Option Explicit
Private m_objBasicAudio  As IBasicAudio         'Basic Audio Object
Private m_objBasicVideo As IBasicVideo          'Basic Video Object
Private m_objMediaEvent As IMediaEvent        'MediaEvent Object
Private m_objVideoWindow As IVideoWindow   'VideoWindow Object
Private m_objMediaControl As IMediaControl    'MediaControl Object
Private m_objMediaPosition As IMediaPosition 'MediaPosition Object
Private m_dblStartPosition As Double
Private m_dblRunLength As Double
Private m_boolVideoRunning As Boolean
Private m_Vol As Integer
Private m_Bal As Integer
Private m_hWnd As Long
Private m_Width As Integer
Private m_Height As Integer
Private m_Top As Integer
Private m_Left As Integer
'初始化设定DShow的对象参数
Public Sub InitDXShow(hWnd As Long, Width As Integer, Height As Integer, Optional Left As Integer = 0, Optional Top As Integer = 0)m_hWnd = hWndm_Width = Widthm_Height = Heightm_Top = Topm_Left = Left
End Sub
'载入媒体,支持媒体类型为mpg,avi,wav,mov,mp3
Public Sub LoadMedia(Pathname As String)
On Local Error GoTo ErrLineIf Mid(Pathname, 2, 1) <> ":" Then Pathname = App.Path & "\" & PathnameIf Len(Dir(Pathname)) = 0 ThenDebug.Print "[PlayMeida]Err:文件不存在!"Debug.Print Pathname
'        MsgBox "音乐文件不存在，但不影响游戏运行！"Exit SubEnd IfSet m_objMediaControl = New FilgraphManagerCall m_objMediaControl.RenderFile(Pathname)Set m_objBasicAudio = m_objMediaControlm_objBasicAudio.Volume = (m_Vol - 100) * 40m_objBasicAudio.Balance = m_Bal * 50Set m_objVideoWindow = m_objMediaControlm_objVideoWindow.WindowStyle = CLng(&H6000000)m_objVideoWindow.Top = m_Topm_objVideoWindow.Left = m_Leftm_objVideoWindow.Width = m_Widthm_objVideoWindow.Height = m_Heightm_objVideoWindow.Owner = m_hWndSet m_objMediaEvent = m_objMediaControl '播放,停止,暂停的控制对象Set m_objMediaPosition = m_objMediaControl '媒体位置控制对象m_dblStartPosition = 0m_objMediaPosition.Rate = 1m_dblRunLength = Round(m_objMediaPosition.Duration, 2)DoEventsExit Sub
ErrLine:Err.ClearResume Next
End Sub
'音量的获取和设定
Public Property Get Volume() As IntegerVolume = m_Vol
End Property
Public Property Let Volume(ByVal Vol As Integer)m_Vol = Volm_objBasicAudio.Volume = (Vol - 100) * 40
End Property
'播放进度的获取和设置
Public Property Get MediaPosition() As DoubleMediaPosition = m_objMediaPosition.CurrentPosition
End Property
Public Property Let MediaPosition(ByVal Position As Double)m_objMediaPosition.CurrentPosition = Position
End Property
'声道平衡的获取和设置
Public Property Get Balance() As IntegerBalance = m_Bal
End Property
Public Property Let Balance(ByVal bal As Integer)m_Bal = balm_objBasicAudio.Balance = bal * 50
End Property
'获取媒体播放长度
Public Property Get Duration() As DoubleDuration = m_dblRunLength
End Property
'检测媒体是否在播放
Public Property Get isPlaying() As BooleanisPlaying = IIf(m_objMediaPosition.CurrentPosition < m_dblRunLength, True, False)
End Property
'播放媒体
Public Sub PlayMedia()If CLng(m_objMediaPosition.CurrentPosition) < CLng(m_dblStartPosition) Thenm_objMediaPosition.CurrentPosition = m_dblStartPositionElseIf CLng(m_objMediaPosition.CurrentPosition) = CLng(m_dblRunLength) Thenm_objMediaPosition.CurrentPosition = m_dblStartPositionEnd IfCall m_objMediaControl.Runm_boolVideoRunning = TrueDoEventsDoEvents
End Sub
'暂停播放
Public Sub PauseMedia()Call m_objMediaControl.Pausem_boolVideoRunning = False
End Sub
'停止播放
Public Sub StopMedia()Call m_objMediaControl.Stopm_boolVideoRunning = Falsem_objMediaPosition.CurrentPosition = 0
End Sub
'卸载DShow
Public Sub UnloadDXShow()m_boolVideoRunning = FalseDoEventsIf Not m_objMediaControl Is Nothing Thenm_objMediaControl.StopEnd If'            If Not m_objVideoWindow Is Nothing Then
'               m_objVideoWindow.Left = Screen.Width * 8
'               m_objVideoWindow.Height = Screen.Height * 8
'               m_objVideoWindow.Owner = 0
'            End IfIf Not m_objBasicAudio Is Nothing Then Set m_objBasicAudio = NothingIf Not m_objBasicVideo Is Nothing Then Set m_objBasicVideo = NothingIf Not m_objMediaControl Is Nothing Then Set m_objMediaControl = NothingIf Not m_objVideoWindow Is Nothing Then Set m_objVideoWindow = NothingIf Not m_objMediaPosition Is Nothing Then Set m_objMediaPosition = Nothing
End Sub
Private Sub Class_Initialize()m_Vol = 100
End Sub

xAudio.cls 这个模块主要用来播放音效，比如走路声，开门声等。

'impactX Game Engine
'本类模块用于对WAV,MIDI格式的声音进行回放和处理
'使用本类模块必须遵守:
'你可以免费使用本引擎及代码
'使用本引擎后的责任由使用者承担
'你可以任意拷贝本引擎代码，但必须保证其完整性
'希望我能得到你使用本引擎制作出的程序
'Davy.xu sunicdavy@sina.com qq:20998333
Option Explicit
Dim DX As New DirectX8
Dim DS As DirectSound8
Dim DMA As DMUS_AUDIOPARAMS'Dim myDSBuff(0 To 8) As DirectSoundSecondaryBuffer8
'Public myBuffDESC As DSBUFFERDESC
'Dim myWavFormat As WAVEFORMATEXDim DAperformance As DirectMusicPerformance8    '播放器
Dim DAloader As DirectMusicLoader8              '载入器
Dim dmPath As DirectMusicAudioPath8 '媒体路径,做调节音量用
Dim m_PausePos As Long '停止位置(待修正)
'功能:初始化DirectAudio
Public Function InitDXAudio(hWnd As Long) As BooleanOn Error GoTo ErrHSet DAloader = DX.DirectMusicLoaderCreateSet DAperformance = DX.DirectMusicPerformanceCreateDAperformance.InitAudio hWnd, DMUS_AUDIOF_ALL, DMA, Nothing, DMUS_APATH_DYNAMIC_STEREO, 64Set dmPath = DAperformance.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 64, True)InitDXAudio = TrueExit Function
ErrH:Debug.Print "Err:[InitDXAudio] 初始化错误"InitDXAudio = FalseEnd Function
'功能:初始化DirectAudio的WAVE处理部分
Public Function InitDXSound(hWnd As Long) As BooleanInitDXSound = False'建立播放对象控件Set DS = DX.DirectSoundCreate(vbNullString)DS.SetCooperativeLevel hWnd, DSSCL_PRIORITY '建立缓冲区InitDXSound = True
End FunctionPublic Function LoadWav(Pathname As String) As DirectSoundSecondaryBuffer8On Error GoTo ErrHDim DSbufSC As DSBUFFERDESCPathname = Trim(Pathname)If Len(Pathname) = 0 ThenDebug.Print "Err [LoadWav] 路径为空"EndEnd IfIf Mid(Pathname, 2, 1) <> ":" Then Pathname = App.Path & "\" & PathnameIf LCase(Right(Pathname, 3)) <> "wav" And LCase(Right(Pathname, 3)) <> "mid" ThenDebug.Print "Err [LoadWav] 载入格式不正确,只能载入wav文件"EndEnd IfIf Len(Dir(Pathname)) = 0 ThenDebug.Print "Err:[LoadWav] 文件不存在"Debug.Print PathnameEndEnd IfDSbufSC.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_STATIC Or DSBCAPS_CTRLPOSITIONNOTIFYSet LoadWav = DS.CreateSoundBufferFromFile(Pathname, DSbufSC)Exit Function
ErrH:Debug.Print "Err [LoadWav] 载入错误"Debug.Print Pathname
End Function'功能:载入音乐文件
'参数:音乐缓冲索引,路径.没有盘符的路径自动识别为工作目录
Public Function LoadAudio(Pathname As String) As DirectMusicSegment8On Error GoTo ErrHPathname = Trim(Pathname)If Len(Pathname) = 0 ThenDebug.Print "Err [LoadAudio] 路径为空"EndEnd IfIf Mid(Pathname, 2, 1) <> ":" Then Pathname = App.Path & "\" & PathnameIf LCase(Right(Pathname, 3)) <> "wav" And LCase(Right(Pathname, 3)) <> "mid" ThenDebug.Print "Err [LoadAudio] 载入格式不正确,只能载入wav和mid文件"EndEnd IfIf Len(Dir(Pathname)) = 0 ThenDebug.Print "Err:[LoadAudio] 文件不存在"Debug.Print PathnameEndEnd IfSet LoadAudio = DAloader.LoadSegment(Pathname)LoadAudio.Download dmPathExit Function
ErrH:Debug.Print "Err [LoadAudio] 载入错误 "Debug.Print PathnameDebug.Print "在非NT系统中(如Win98),请不要在路径中带有中文"
End Function'功能: 播放索引号对应音乐缓冲里的音乐
Public Sub PlayAudio(Buf As DirectMusicSegment8, Optional isRepeat As Boolean = False)On Error GoTo ErrHIf isRepeat ThenBuf.SetRepeats INFINITEEnd IfDAperformance.PlaySegmentEx Buf, DMUS_SEGF_SECONDARY, 0, Nothing, dmPathExit Sub
ErrH:Debug.Print "Err [PlayAudio] 播放时错误"
End Sub'功能: 播放索引号对应音乐缓冲里的音乐
Public Sub PlayWav(Buf As DirectSoundSecondaryBuffer8, Optional isRepeat As Boolean = False)On Error GoTo ErrHBuf.SetCurrentPosition 0If isRepeat ThenBuf.Play DSBPLAY_LOOPINGElseBuf.Play DSBPLAY_DEFAULTEnd IfExit Sub
ErrH:If Buf Is Nothing ThenDebug.Print "Err [PlayWav] 没有载入音乐，播放时错误"ElseDebug.Print "Err [PlayWav] 播放时错误 "End IfEnd Sub
'功能:停止播放音乐
Public Sub StopWav(Buf As DirectSoundSecondaryBuffer8)On Error GoTo ErrHBuf.StopExit Sub
ErrH:Debug.Print "Err [StopWav] 停止时错误"
End Sub'功能:停止播放音乐
Public Sub StopAudio(Buf As DirectMusicSegment8)On Error GoTo ErrHm_PausePos = Buf.GetStartPointDAperformance.StopEx Buf, 0, 0Exit Sub
ErrH:Debug.Print "Err [StopAudio] 停止时错误 "
End Sub
'功能:设置Wav音乐音量
'参数:范围(0~100)
Public Sub SetWavVolume(Buf As DirectSoundSecondaryBuffer8, Volume As Integer)If Volume < 0 Or Volume > 100 Then Exit SubBuf.SetVolume Volume * 30 - 3000
End Sub
'功能:设定声音左右平衡度
'参数:范围(左)-10~10(右)
Public Sub SetWavPan(Buf As DirectSoundSecondaryBuffer8, Lev As Integer)If Lev < -10 Or Lev > 10 Then Exit SubBuf.SetPan ((Lev + 10) * 5 - 50) * 100
End Sub
'功能:设置音乐音量
'参数:范围(0~100)
Public Sub SetAudioVolume(Vol As Integer)If Vol < 0 Or Vol > 100 Then Exit SubdmPath.SetVolume -(1 - Vol / 100) * 5000, 0
End Sub
'功能:音乐是否在播放
Public Function IsWavPlaying(Buf As DirectSoundSecondaryBuffer8) As BooleanIsWavPlaying = IIf(Buf.GetStatus = DSBSTATUS_PLAYING, True, False)
End Function'功能:音乐是否在播放
Public Function IsAudioPlaying(Buf As DirectMusicSegment8) As BooleanIsAudioPlaying = DAperformance.isPlaying(Buf, Nothing)
End Function
'功能:设定声音左右平衡度
'参数:范围(左)-10~10(右)
Public Sub SetAudioBalance(Lev As Integer)If Lev < -10 Or Lev > 10 Then Exit SubDim DSbuf As DirectSound3DBuffer8Set DSbuf = dmPath.GetObjectinPath(DMUS_PCHANNEL_ALL, DMUS_PATH_BUFFER, 0, vbNullString, 0, "IID_IDirectSound3DBuffer")DSbuf.SetPosition Lev / 5, 0, 0, DS3D_IMMEDIATESet DSbuf = Nothing
End Sub
'卸载DirectAudio
Public Sub UnloadDXAudio()On Error GoTo ErrHDim i As LongDAperformance.CloseDown '关闭DirectMusicPerformance8Set DAperformance = NothingSet DAloader = NothingSet DS = NothingExit Sub
ErrH:Debug.Print "Err [UnloadDXAudio] 卸载错误"
End Sub
'卸载DirectAudio
Public Sub UnloadDXSound()Set DS = Nothing
End SubPublic Sub ReleaseWav(Buf As DirectSoundSecondaryBuffer8)Set Buf = Nothing
End Sub
Public Sub ReleaseAudio(Buf As DirectMusicSegment8)Set Buf = Nothing
End Sub

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~2音效模块相关推荐

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~20开始游戏-对话处理
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析6:对话处理游戏的对话处理比较简单,仅仅是根据游戏流程提供简单的对话系统,没有涉及复杂的东西.下边是设计的窗体: Opt ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~1游戏引擎
魔塔之拯救白娘子完整工程下载地址: 前边学习了DX8的相关知识后,想做一个游戏试试看.这里我选取了魔塔这个比较大众化的小游戏.主要是魔塔的游戏画面比较固定,也很简单,似乎很容易做.下边就开始做吧. ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~24开始游戏-屏幕截图
魔塔之拯救白娘子完整工程下载地址: 魔塔之拯救白娘子>流程分析8:屏幕截图和通用申明有网友问我主窗口设计界面是什么样子?下图就是:frmMain.frm 设计界面非常清爽,只有一个tiemr ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~8地图编辑器-处理流程
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>处理流程: ①在主游戏窗口里添加一个timer控件,名称为:timerDraw 作用:根据running状态绘制不同的背景 Ena ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~18开始游戏-物体碰撞检测
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析4:物体碰撞检测处理方式分2步,第一步是游戏时主角显示处理:当主角移动时需要擦除上一个坐标位的主角,然后在新位置上放置主 ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~6地图编辑器-初始化
魔塔之拯救白娘子完整工程下载地址: 从今天开始我将写一下<魔塔之拯救白娘子>的游戏地图编辑器,俗话说,事半功倍.把地图编辑器搞好,基本一个游戏就写好了三分之一了.可以说,魔塔的地图是相对 ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~9地图编辑器-卡通选择
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>地图编辑器:流程控制-卡通选择本课主要讲一下,卡通图片的选择.如下图所示. 卡通图片由3种: ①基础类:25个,主要是路面.NP ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~16开始游戏-自动寻路（A星算法）
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析2: ⑤游戏界面鼠标点击判断以及自动寻路: 自动寻路的效果如下: 源码如下: Sub 游戏界面鼠标点击判断() Dim m ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~4读写ini文件
魔塔之拯救白娘子完整工程下载地址: 读写ini.bas 用来读写ini文件 Option Explicit '读写INI声明Dim TempBol Public iniFileName As Str ...

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~2音效模块

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~2音效模块相关推荐

最新文章

热门文章