soundengine.cls

一款飞机射击游戏的源代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SoundEngine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Const SM_CXBORDER = 5
Const SM_CYBORDER = 6
Const VK_SNAPSHOT As Byte = &H2C
Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Const MCI_SET = &H80D
Const MCI_SET_DOOR_OPEN = &H100&

Private Type WAVEMIXINFO
   wSize As Integer
   bVersionMajor As String * 1
   bVersionMinor As String * 1
   szDate(12) As String
   dwFormats As Long
End Type

Private Type MIXCONFIG
    wSize As Integer
    dwFlagsLo As Integer
    dwFlagsHi As Integer
    wChannels As Integer
    wSamplingRate As Integer
End Type

Private Type MIXPLAYPARAMS
    wSize         As Integer
    hMixSessionLo As Integer
    hMixSessionHi As Integer
    iChannelLo    As Integer
    iChannelHi    As Integer
    lpMixWaveLo   As Integer
    lpMixWaveHi   As Integer
    hWndNotifyLo  As Integer
    hWndNotifyHi  As Integer
    dwFlagsLo     As Integer
    dwFlagsHi     As Integer
    wLoops        As Integer
End Type

Private Declare Function WaveMixActivate Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, ByVal fActivate As Integer) As Long
Private Declare Function WaveMixCloseChannel Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, ByVal iChannel As Integer, ByVal dwFlags As Long) As Integer
Private Declare Function WaveMixCloseSession Lib "WAVMIX32.DLL" (ByVal hMixSession As Long) As Integer
Private Declare Function WaveMixConfigureInit Lib "WAVMIX32.DLL" (lpConfig As MIXCONFIG) As Long
Private Declare Function WaveMixFlushChannel Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, ByVal iChannel As Integer, ByVal dwFlags As Long) As Integer
Private Declare Function WaveMixFreeWave Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, ByVal lpMixWave As Long) As Integer
Private Declare Function WaveMixGetInfo Lib "WAVMIX32.DLL" (lpWaveMixInfo As WAVEMIXINFO) As Integer
Private Declare Function WaveMixInit Lib "WAVMIX32.DLL" () As Long
Private Declare Function WaveMixOpenChannel Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, ByVal iChannel As Long, ByVal dwFlags As Long) As Long
Private Declare Function WaveMixOpenWave Lib "WAVMIX32.DLL" (ByVal hMixSession As Long, szWaveFilename As Any, ByVal hInst As Long, ByVal dwFlags As Long) As Long
Private Declare Function WaveMixPlay Lib "WAVMIX32.DLL" (lpMixPlayParams As Any) As Integer
Private Declare Sub WaveMixPump Lib "WAVMIX32.DLL" ()

Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function midiOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function midiOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private hWaveMix As Long
Private lpWaveMix() As Long
Private WaveHandle As Long
Private Params As MIXPLAYPARAMS

Private CurChannel As Long
Private IsInited As Boolean
Private UseCh As Byte
Private SoundPath As String
Private MusicPath As String

''Public Event StateChange()
Public Function InitPlaySound(ByVal SoundChannel As Byte) As Boolean
If IsInited Then Exit Function
    UseCh = SoundChannel
    If UseCh = 0 Then
        UseCh = 1
    ElseIf UseCh > 6 Then
        UseCh = 6
    End If
    Call InitWavMix
    InitPlaySound = IsInited
End Function
Private Sub InitWavMix()
Dim wRtn As Long
Dim Config As MIXCONFIG

    WaveHandle = 0
    ReDim lpWaveMix(0)
    Config.wSize = Len(Config)
    Config.dwFlagsHi = 1
    Config.dwFlagsLo = 0
    Config.wChannels = UseCh '''多声道
    hWaveMix = WaveMixConfigureInit(Config)
    wRtn = WaveMixActivate(hWaveMix, True)

    If (wRtn <> 0) Then
        IsInited = False
        Call WaveMixCloseSession(hWaveMix)
        hWaveMix = 0
    Else
        IsInited = True
        ReDim Preserve lpWaveMix(0 To 7)
    End If
End Sub
'0:EX
'1.....7
Public Sub StopLoopZero()
    If lpWaveMix(0) <> 0 Then
        If hWaveMix Then WaveMixFlushChannel hWaveMix, 0, 0
        WaveMixFreeWave hWaveMix, lpWaveMix(0)
    End If
End Sub
Public Sub PlaySound(ByVal FileName As String, ByVal WhType As Byte, Optional ByVal IsLoop As Byte)
On Error Resume Next
Static LastCh As Byte

If Not IsInited Then Exit Sub
If FileName = "0" Then Exit Sub
    Select Case WhType
        Case 0
            CurChannel = 0
        Case Else
            LastCh = LastCh Mod 7 + 1
            CurChannel = LastCh
    End Select

    FileName = LCase(FileName)
    If lpWaveMix(CurChannel) <> 0 Then
        If hWaveMix Then WaveMixFlushChannel hWaveMix, CurChannel, 0
        WaveMixFreeWave hWaveMix, lpWaveMix(CurChannel)
    End If
    If Right(FileName, 4) <> ".wav" Then FileName = FileName & ".wav"
    lpWaveMix(CurChannel) = WaveMixOpenWave(hWaveMix, ByVal SoundPath & FileName, 0, 0)
    WaveMixOpenChannel hWaveMix, CurChannel, 0
    With Params
        .wSize = Len(Params)
        .hMixSessionLo = LoWord(hWaveMix)
        .hMixSessionHi = HiWord(hWaveMix)
        .iChannelLo = LoWord(CurChannel)
        .iChannelHi = HiWord(CurChannel)
        .lpMixWaveLo = LoWord(lpWaveMix(CurChannel))
        .lpMixWaveHi = HiWord(lpWaveMix(CurChannel))
        .hWndNotifyLo = 0
        .hWndNotifyHi = 0
        .dwFlagsHi = 5
        .dwFlagsLo = 0
        If CurChannel = 0 Then .wLoops = IsLoop Else .wLoops = 0
    End With
    
    WaveMixPlay Params
    
End Sub
Public Sub KillMe()
If Not IsInited Then Exit Sub
    IsInited = False
    Call WavMixClose
End Sub
Public Sub ResumeMe()
    If Not IsInited Then Call InitWavMix
End Sub

Public Sub PlayMusic(ByVal FileName As String)
    Call StopMusic
    FileName = LCase(FileName)
    If Right(FileName, 4) <> ".mid" Then FileName = FileName & ".mid"
    FileName = MusicPath & FileName
    mciSendString "open sequencer!" & FileName & " alias midi", vbNullString, 0, 0
    mciSendString "play midi", vbNullString, 0, 0
End Sub
Public Sub StopMusic()
    mciSendString "stop midi", vbNullString, 0, 0
    mciSendString "close midi", vbNullString, 0, 0

End Sub
Public Function GetMusicState() As Long
Dim StateStr As String * 12
Dim SaveLen As Long
    mciSendString "status midi length", StateStr, 12, 0
    SaveLen = Val(StateStr)
    If SaveLen = 0 Then GetMusicState = 0: Exit Function
    mciSendString "status midi position", StateStr, 12, 0
    If SaveLen = Val(StateStr) Then GetMusicState = 0: Exit Function
    GetMusicState = SaveLen
End Function

Private Function HiWord(ByVal L As Long) As Integer
    L = L \ &H10000
    
    HiWord = Val("&H" & Hex$(L))
End Function

Private Function LoWord(ByVal L As Long) As Integer
    L = L And &HFFFF&
    
    LoWord = Val("&H" & Hex$(L))
End Function


Public Property Get InitMusicDir() As String
    InitMusicDir = MusicPath
End Property

Public Property Let InitMusicDir(ByVal vNewValue As String)
    MusicPath = IIf(Right(vNewValue, 1) = "\", vNewValue, vNewValue & "\")
End Property

Public Property Get InitSoundDir() As String
    InitSoundDir = SoundPath
End Property

Public Property Let InitSoundDir(ByVal vNewValue As String)
    SoundPath = IIf(Right(vNewValue, 1) = "\", vNewValue, vNewValue & "\")
End Property


Private Sub Class_Terminate()
    Call WavMixClose
    Call StopMusic
End Sub
Private Sub WavMixClose()
On Error Resume Next
Dim N As Integer
    If (hWaveMix <> 0) Then
        For N = 0 To 7
            If lpWaveMix(N) <> 0 Then
                WaveMixFlushChannel hWaveMix, N, 0
                WaveMixFreeWave hWaveMix, lpWaveMix(N)
            End If
        Next
        WaveMixCloseSession hWaveMix
        hWaveMix = 0
    End If
End Sub