mtools.bas

游戏常见三为场景

           .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
           .dwWidth = nWidth
           .dwHeight = nHeight
        End With
    
        ' Create surface
        L_dDXD.DDSCAPS.dwCaps = nAdditionalCaps Or IIf(G_dDXSelectedDriver.DriverType = EDXDTSoft Or bForceSystemMemory, DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY)
        On Error Resume Next
        G_oDDInstance.CreateSurface L_dDXD, CreateSurface, Nothing
        On Error GoTo E_CreateSurface
        If CreateSurface Is Nothing Then
            L_dDXD.DDSCAPS.dwCaps = nAdditionalCaps Or DDSCAPS_SYSTEMMEMORY
            G_oDDInstance.CreateSurface L_dDXD, CreateSurface, Nothing
        End If
    
        ' Check for existance of surface
        If CreateSurface Is Nothing Then
           AppError 0, "Surface could not be created", "CreateSurface "
           Exit Function
        End If
    
    ' Error handler ...
        Exit Function
        
E_CreateSurface:

        AppError Err.Number, Err.Description, "CreateSurface"
    
End Function

' CREATETEXTURE: Creates a texture of given size
Public Function CreateTexture(ByVal nSize As Integer, Optional ByVal bForceSystemMemory As Boolean) As IDirectDrawSurface4

    ' Enable error handling ...
        On Error GoTo E_CreateTexture
    
    ' Setup local variables ...
        
        Dim L_dDXD As DDSURFACEDESC2          ' Surface descriptor
        Dim L_oDDS As IDirectDrawSurface4     ' Local surface holding
        
    ' Create texure surface ...
        

' NOTE: THIS IS THE DIRECTX6 ALTERNATIVE TO TEXTURE HANDLES
' Use automatic texture management to tell DirectX to manage
' texture location for you. Note: You cannot use renderstate
' TEXTUREHANDLE for setting current texture any longer. Instead,
' you have to use SetTexture method with the texture object.

'        ' Set surface creation data
'        With L_dDXD
'           .dwSize = Len(L_dDXD)
'           .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
'           .DDSCAPS.dwCaps = DDSCAPS_TEXTURE
'           .DDSCAPS.dwCaps2 = DDSCAPS2_TEXTUREMANAGE
'           .dwWidth = nSize
'           .dwHeight = nSize
'        End With
    
        ' Set surface creation data
        With L_dDXD
           .dwSize = Len(L_dDXD)
           .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH Or IIf(G_dDXSelectedDriver.DriverType = EDXDTPlus, DDSD_TEXTURESTAGE, 0)
           .DDSCAPS.dwCaps = DDSCAPS_TEXTURE Or IIf(G_dDXSelectedDriver.DriverType = EDXDTSoft Or bForceSystemMemory, DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY)
           .dwWidth = nSize
           .dwHeight = nSize
           .dwTextureStage = 0
        End With
    
        ' Create surface
        G_oDDInstance.CreateSurface L_dDXD, L_oDDS, Nothing

        ' Check texture existance
        If L_oDDS Is Nothing Then
            AppError 0, "Could not create texture surface", "CreateTexture"
        End If
        
        ' Return created texture
        Set CreateTexture = L_oDDS
        
    ' Error handler ...
    
        Exit Function
    
E_CreateTexture:
    
        Set L_oDDS = Nothing
        AppError Err.Number, Err.Description, "CreateTexture"

End Function

' LOADWAVEAUDIO: Loads a wave file into a DirectSound buffer
Public Function LoadWaveAudio(ByVal sFileName As String, Optional ByVal bIs3D As Boolean) As IDirectSoundBuffer
        
    ' Enable error handling ...
        
        On Error GoTo E_LoadWaveAudio
    
    ' Setup local variables ...
    
        Dim L_dWFX As WAVEFORMATEX      ' Structure holding wave format description
        Dim L_nDataSize As Long         ' Size of audio data
        Dim L_nPosition As Long         ' Current position within wave file
        Dim L_nWaveBytes() As Byte      ' Array holding wave file data
        Dim L_dDSBD As DSBUFFERDESC     ' Structure holding description of DirectSound buffer
        
        Dim L_nPointer1 As Long      ' Pointer to left track data
        Dim L_nLength1 As Long       ' Length of left track data
        
        Dim L_nPointer2 As Long     ' Pointer to right track data
        Dim L_nLength2 As Long      ' Length of right track data
        
    ' Read wave file data into local array ...
        
        ' Set array size to file size
        ReDim L_nWaveBytes(1 To FileLen(sFileName))
        
        ' Load data into array
        Open sFileName For Binary As #1
        Get #1, , L_nWaveBytes
        Close #1
        
    ' Search for format data position ...
                
        ' Start at position 1
        L_nPosition = 1
        
        ' Look for format expression
        Do While Not (Chr(L_nWaveBytes(L_nPosition)) + Chr(L_nWaveBytes(L_nPosition + 1)) + Chr(L_nWaveBytes(L_nPosition + 2)) = "fmt")
            
            L_nPosition = L_nPosition + 1
            
            ' Cancel if no format expression found
            If L_nPosition > UBound(L_nWaveBytes) - 3 Then
                AppError 0, "Invalid file format", "LoadWaveAudio"
            End If
            
        Loop
        
    ' Copy format data to local structure ...
        CopyMemory VarPtr(L_dWFX), VarPtr(L_nWaveBytes(L_nPosition + 8)), Len(L_dWFX)
            
    ' Search for audio data position ...
            
        ' Look for data expression
        Do While Not (Chr(L_nWaveBytes(L_nPosition)) + Chr(L_nWaveBytes(L_nPosition + 1)) + Chr(L_nWaveBytes(L_nPosition + 2)) + Chr(L_nWaveBytes(L_nPosition + 3)) = "data")
            
            L_nPosition = L_nPosition + 1
            
            ' Cancel if no data expression found
            If L_nPosition > UBound(L_nWaveBytes) - 4 Then
                AppError 0, "Invalid file format", "LoadWaveAudio"
            End If
            
        Loop
        
        ' Copy data size to local variable
        CopyMemory VarPtr(L_nDataSize), VarPtr(L_nWaveBytes(L_nPosition + 4)), 4
            
    ' Create and fill DirectSound buffer ...
    
        ' Fill description structure to create buffer from
        With L_dDSBD
            .dwSize = Len(L_dDSBD)
            .dwFlags = IIf(bIs3D, DSBCAPS_CTRL3D, DSBCAPS_CTRLDEFAULT)
            .dwBufferBytes = L_nDataSize
            .lpwfxFormat = VarPtr(L_dWFX)
        End With
        
        ' Create buffer from structure
        G_oDSInstance.CreateSoundBuffer L_dDSBD, LoadWaveAudio, Nothing
        
        ' Check for existance of buffer
        If LoadWaveAudio Is Nothing Then
           AppError 0, "Buffer could not be created", "LoadWaveAudio"
           Exit Function
        End If
        
        ' Lock buffer to access its data
        LoadWaveAudio.Lock 0&, L_nDataSize, L_nPointer1, L_nLength1, L_nPointer2, L_nLength2, 0&
        
        ' Copy left (or only, if mono wave file) track to DirectSound buffer
        CopyMemory L_nPointer1, VarPtr(L_nWaveBytes(L_nPosition + 8)), L_nLength1
        
        ' Copy right track to DirectSound buffer, if exists
        If L_nLength2 <> 0 Then
            CopyMemory L_nPointer2, VarPtr(L_nWaveBytes(L_nPosition + 8 + L_nLength1)), L_nLength2
        End If
        
        ' Unlock buffer
        LoadWaveAudio.Unlock L_nPointer1, L_nLength1, L_nPointer2, L_nLength2
        
    ' Error handler ...
        Exit Function
    
E_LoadWaveAudio:
        
        Set LoadWaveAudio = Nothing
        AppError Err.Number, Err.Description, "LoadWaveAudio"
    
End Function

' CREATEPRIMARYAUDIO: Uses a wave file as a template for the primary audio buffer
Public Function CreatePrimaryAudio() As IDirectSoundBuffer
        
    ' Enable error handling ...
        On Error GoTo E_CreatePrimaryAudio
        
    ' Setup local variables ...
        Dim L_dDSBDESC As DSBUFFERDESC  ' Sound buffer description
        Dim L_dDSBCAPS As DSBCAPS       ' Sound buffer caps
        Dim L_dWFMT As WAVEFORMATEX     ' Wave format
            
    ' Create primary sound buffer ...
        
        ' Setup wave format structure
        With L_dWFMT
            .cbSize = Len(L_dWFMT)
            .wFormatTag = 1
            .nChannels = 2
            .nSamplesPerSec = 22050
            .nBlockAlign = 4
            .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
            .wBitsPerSample = 16
        End With
        
        ' Setup buffer description
        With L_dDSBDESC
            .dwSize = Len(L_dDSBDESC)
            .dwFlags = DSBCAPS_PRIMARYBUFFER Or DSBCAPS_CTRL3D
            .dwBufferBytes = 0