魔塔之拯救白娘子 完整工程下載地址：
繼續上一文，游戲引擎相關源碼。
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音效模块的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。