mapp.bas

游戏常见三为场景

                If G_dUser.LookV > 60 Then G_dUser.LookV = 60
            End If
            
            ' Look down
            If .MouseY < 240 Then
                G_dUser.LookV = G_dUser.LookV - 2
                If G_dUser.LookV < -60 Then G_dUser.LookV = -60
            End If
            
            ' Reset mouse position
            SetCursorPos 320, 240
            
        End With
        
        
    ' React to position changes ...
        
        ' Check altitude change
        L_nOldAlt = G_dScene.Terrain(Int(G_dUser.Position.X), Int(G_dUser.Position.z))
        L_nNewAlt = G_dScene.Terrain(Int(L_nNewX), Int(L_nNewZ))
        L_nAltitudeChange = Abs(L_nOldAlt - L_nNewAlt)
                
        ' Check for obstacle
        If L_nAltitudeChange > 1 Then
            If Int(G_dUser.Position.X) <> Int(L_nNewX) Then
                L_nNewX = G_dUser.Position.X
            End If
            If Int(G_dUser.Position.z) <> Int(L_nNewZ) Then
                L_nNewZ = G_dUser.Position.z
            End If
        End If
        
        ' Play sounds if necessary
        If (Int(G_dUser.Position.X) <> Int(L_nNewX) Or Int(G_dUser.Position.z) <> Int(L_nNewZ)) Then
        
            ' Play metallic step sound
            If L_nNewX >= 60 And L_nNewX <= 100 And L_nNewZ >= 40 And L_nNewZ <= 45 Then
                G_oDSBStepHard.Stop
                G_oDSBStepHard.Play ByVal 0&, ByVal 0&, 0
            ElseIf L_nNewX >= 110 And L_nNewX <= 115 And L_nNewZ >= 50 And L_nNewZ <= 80 Then
                G_oDSBStepHard.Stop
                G_oDSBStepHard.Play ByVal 0&, ByVal 0&, 0
                
            ' Play soft step sound
            Else
                G_oDSBStepSoft.Stop
                G_oDSBStepSoft.Play ByVal 0&, ByVal 0&, 0
            End If
            
        End If
        
        ' Set new position
        G_dUser.Position.X = L_nNewX
        G_dUser.Position.z = L_nNewZ
        
        ' Adjust altitude if necessary
        If L_nAltitudeChange = 1 Then
            G_dUser.Position.Y = 44 - G_dScene.Terrain(Int(G_dUser.Position.X), Int(G_dUser.Position.z))
        End If
        
    ' Error handling

        Exit Sub
    
E_AppInput:

        AppError 0, "General error", "AppInput"
    
End Sub

' APPERROR: Reports application errors and terminates application properly
Public Sub AppError(nNumber As Long, sText As String, sSource As String)

    ' Enable error handling
    On Error GoTo E_AppError
    
    ' Cleanup
    Call AppTerminate
    
    ' Display error
    fMsg.Hide
    fMsg.lblTitle = "EYE3D encountered an error!"
    fMsg.lblText = IIf(InStr(1, UCase(sText), "AUTOM") > 0, "DirectX reports '" & GetDXError(nNumber) & "'", " Application reports '" & sText & "'") & vbCrLf & "SOURCE: " & sSource
    fApp.Hide
    fMsg.Show 1
    
    ' Terminate program
    End
    
    ' Error handling ...
        
        Exit Sub
        
E_AppError:

        Resume Next
    
End Sub

' APPDRIVERDETECT: Detects best DD driver, fills array of possible D3D drivers
Public Function AppDriverDetect()

    ' Enable error handling...
        On Error GoTo E_AppDriverDetect
    
    ' Setup local variables...
        Dim L_oDDInstance As IDirectDraw4   ' DD Instance for checking
        Dim L_oD3DInstance As IDirect3D3    ' D3D Instance for checking
        
    ' Detect DD driver ...
    
        ' Error handling during enumeration
        On Error Resume Next
            
        ' Enumerate directdraw drivers
        G_bPrimaryDisplayAlreadyDetected = False
        DirectDrawEnumerate AddressOf EnumDDDeviceCallback, 0
    
        ' Initialize driver types
        G_dDXDriverSoft.DriverType = EDXDTSoft
        G_dDXDriverHard.DriverType = EDXDTHard
        G_dDXDriverPlus.DriverType = EDXDTPlus
        
        ' Fetch enumeration errors
        If Err.Number > 0 Then
            AppError 0, "Error during detection of DirectDraw drivers", "AppDriverDetect"
            Exit Function
        End If
        
        ' Reset error handling
        On Error GoTo E_AppDriverDetect
        
        ' Check if at least primary driver found
        If Not G_bPrimaryDisplayAlreadyDetected Then
            AppError 0, "No valid DirectDraw driver found", "AppDriverDetect"
            Exit Function
        End If
            
    ' Detect D3D drivers ...
        
        ' Detect software driver on primary display device ...
        
            ' Create instance of DirectDraw using driver found
            DirectDrawCreate G_dDXDriverSoft.GUID, L_oDDInstance, Nothing
            
            ' Check instance existance, terminate if missing
            If L_oDDInstance Is Nothing Then
                AppError 0, "Unable to create DirectDraw instance using detected driver", "AppDriverDetect"
                Exit Function
            End If
            
            ' Look for software 3D driver
            G_dDXSelectedDriver.DriverType = EDXDTSoft
            
            ' Query DirectDraw for D3D interface
            Set L_oD3DInstance = L_oDDInstance
        
            ' Check instance existance, terminate if missing
            If L_oD3DInstance Is Nothing Then
               AppError 0, "DirectDraw interface did not return valid Direct3D interface", "AppDriverDetect"
               Exit Function
            End If

            ' Error handling during enumeration
            On Error Resume Next
            
            ' Enumerate Direct3D drivers
            L_oD3DInstance.EnumDevices AddressOf EnumD3DDeviceCallback, 0
        
            ' Catch any error resulting from the enumeration and terminate
            If Err.Number > 0 Then
                AppError 0, "Error during detection of Direct3D drivers", "AppDriverDetect"
                Exit Function
            End If
            
            ' Reset error handling
            On Error GoTo E_AppDriverDetect
        
            ' Cleanup
            Set L_oD3DInstance = Nothing
            Set L_oDDInstance = Nothing
            
            
        ' Detect hardware driver on primary display device ...
            
            ' Create instance of DirectDraw using driver found
            DirectDrawCreate G_dDXDriverSoft.GUID, L_oDDInstance, Nothing
            
            ' Check instance existance, terminate if missing
            If L_oDDInstance Is Nothing Then
                AppError 0, "Unable to create DirectDraw instance using detected driver", "AppDriverDetect"
                Exit Function
            End If
            
            ' Look for software 3D driver
            G_dDXSelectedDriver.DriverType = EDXDTHard
            
            ' Query DirectDraw for D3D interface
            Set L_oD3DInstance = L_oDDInstance
        
            ' Check instance existance, terminate if missing
            If L_oD3DInstance Is Nothing Then
               AppError 0, "DirectDraw interface did not return valid Direct3D interface", "AppDriverDetect"
               Exit Function
            End If

            ' Error handling during enumeration
            On Error Resume Next
            
            ' Enumerate Direct3D drivers
            L_oD3DInstance.EnumDevices AddressOf EnumD3DDeviceCallback, 0
        
            ' Catch any error resulting from the enumeration and terminate
            If Err.Number > 0 Then
                AppError 0, "Error during detection of Direct3D drivers", "AppDriverDetect"
                Exit Function
            End If
            
            ' Reset error handling
            On Error GoTo E_AppDriverDetect
        
            ' Cleanup
            Set L_oD3DInstance = Nothing
            Set L_oDDInstance = Nothing
            
        ' Detect hardware driver on addon board ...
        
            If G_dDXDriverPlus.Found Then
            
                ' Okay, DD driver found, but now we have to look for a D3D driver (perhaps not installed properly)!
                G_dDXDriverPlus.Found = True
            
                ' Create instance of DirectDraw using driver found
                DirectDrawCreate G_dDXDriverPlus.GUID, L_oDDInstance, Nothing
                
                ' Check instance existance, terminate if missing
                If L_oDDInstance Is Nothing Then
                    AppError 0, "Unable to create DirectDraw instance using detected driver", "AppDriverDetect"
                    Exit Function
                End If
                
                ' Look for software 3D driver
                G_dDXSelectedDriver.DriverType = EDXDTPlus
                
                ' Query DirectDraw for D3D interface
                Set L_oD3DInstance = L_oDDInstance
            
                ' Check instance existance, terminate if missing
                If L_oD3DInstance Is Nothing Then
                   AppError 0, "DirectDraw interface did not return valid Direct3D interface", "AppDriverDetect"
                   Exit Function
                End If
    
                ' Error handling during enumeration
                On Error Resume Next
                
                ' Enumerate Direct3D drivers
                L_oD3DInstance.EnumDevices AddressOf EnumD3DDeviceCallback, 0
            
                ' Catch any error resulting from the enumeration and terminate
                If Err.Number > 0 Then
                    AppError 0, "Error during detection of Direct3D drivers", "AppDriverDetect"
                    Exit Function
                End If
                
                ' Reset error handling
                On Error GoTo E_AppDriverDetect
            
                ' Cleanup
                Set L_oD3DInstance = Nothing
                Set L_oDDInstance = Nothing
                
            End If
                
    ' Set selected driver
        If G_dDXDriverPlus.Found Then
            G_dDXSelectedDriver = G_dDXDriverPlus
        ElseIf G_dDXDriverHard.Found Then
            G_dDXSelectedDriver = G_dDXDriverHard
        Else
            G_dDXSelectedDriver = G_dDXDriverSoft
        End If
        
    ' Error handling
        Exit Function
        
E_AppDriverDetect:
        
    ' Cleanup...
            
        On Error Resume Next
        
        ' Release interfaces
        Set L_oD3DInstance = Nothing
        Set L_oDDInstance = Nothing
    
    ' Error report
    
        AppError 0, "General error during driver detection", "AppDriverDetect"
    
End Function

' VIEWPORTINITIALIZE: Initializes a given D3DIM viewport to passed size
Public Sub ViewportInitialize(nWidth As Integer, nHeight As Integer)

    ' Enable error handling ...
    On Error GoTo E_ViewportInitialize
    
    ' Setup local variables ...
        
        Dim L_dD3DViewportDesc As D3DVIEWPORT2      ' Description of viewport object for generation of viewport
        Dim L_dDDBLTFX As DDBLTFX                   ' FX Blit descriptor
        Dim L_dRenderArea As RECT                   ' Rectangle for clearing whole backbuffer
        
    ' Setup viewport ...
    
        ' Fill viewport description
        With L_dD3DViewportDesc
            .dwSize = Len(L_dD3DViewportDesc)
            .dwX = (G_nDisplayWidth - nWidth) / 2
            .dwY = (G_nDisplayHeight - nHeight) / 2
            .dwWidth = nWidth
            .dwHeight = nHeight
            .dvClipX = -1
            .dvClipY = 1
            .dvClipHeight = 2
            .dvClipWidth = 2
            .dvMinZ = 0
            .dvMaxZ = 1
        End With