mmain.bas

一个d3d实例程序

    
    ' Error handling ...
    
        Exit Sub

E_CreateGround:

        AppError Err.Number, Err.Description, "CreateGround"
        Exit Sub
    
End Sub

Private Sub CreateWindows()

    ' Enable error handling...
        On Error GoTo E_CreateWindows

    ' Setup local variables ...
    Dim L_dDDCK As DDCOLORKEY
    
    L_dDDCK.dwColorSpaceHighValue = 0
    L_dDDCK.dwColorSpaceLowValue = 0
    
    ' Initialize threed buffer surface ...
    
        With G_dDDWindow(0)
        
            ' Create surface capable of being a 3d device
            Set .oDDSurface = MakeDXSurface(280, 200, True)
   
             ' Set color key to enable transparent blits
            .oDDSurface.SetColorKey DDCKEY_SRCBLT, L_dDDCK
            
            ' Set render area
            .dRenderArea.Top = 0
            .dRenderArea.Left = 0
            .dRenderArea.Bottom = 200
            .dRenderArea.Right = 280
            
            ' Set initial position and motion
            .nX = 300
            .nY = 100
            .nDX = 2
            .nDY = -2
            
        End With
    
    ' Initialize window holding scrolling font (no surface, position data only) ...
    
        With G_dDDWindow(1)
        
            ' Set initial position and motion
            .nX = 60
            .nY = 400
            .nDX = 0
            .nDY = -1
            
            ' Set render area
            .dRenderArea.Top = 0
            .dRenderArea.Left = 0
            .dRenderArea.Bottom = 60
            .dRenderArea.Right = 500
            
        End With
        
                
    ' Initialize window holding bumping logo (surface is being loaded, not defined here) ...
         With G_dDDWindow(2)
         
            ' Load surface image
            Set .oDDSurface = LoadBitmapIntoDXS(App.Path + "\logo.bmp")
        
            ' Set color key to enable transparent blits
            .oDDSurface.SetColorKey DDCKEY_SRCBLT, L_dDDCK
         
            ' Set initial position and motion
            .nX = 100
            .nY = 100
            .nDY = 2
            .nDX = 2
            
            ' Set render area
            .dRenderArea.Top = 0
            .dRenderArea.Left = 0
            .dRenderArea.Bottom = 100
            .dRenderArea.Right = 200
            
        End With
    

    ' Error handling ...
    
        Exit Sub

E_CreateWindows:
    
    AppError Err.Number, Err.Description, "CreateWindows"
    
End Sub

Private Sub CreateChars()

    ' Enable error handling...
        On Error GoTo E_CreateChars

    ' Setup local variables ...
        
        Dim L_nRunChar As Integer         ' Variable to run through all chars to be created
        Dim L_sInfo As String             ' String holding first line of def, which assigns characters to charset positions
        Dim L_sLine(6) As String          ' Stings to hold character definition
        Dim L_nCharCount As Integer       ' Number of chars to be created
        Dim L_nRunColumn As Integer       ' Variable to run through the bits within a character
        Dim L_nRunRow As Integer          ' Variable to run through the bits within a character
        Dim L_dDDCK As DDCOLORKEY         ' Colorkey for enabling transparent blits from character surface
        
    ' Load character set from definition file ...
        
        ' Open definition file
        Open App.Path + "\font.def" For Input As #1
        
        ' Read first line, which defines which characters are present in the file
        Input #1, L_sInfo
        L_nCharCount = Len(L_sInfo)
        
        ' Read the seven (scan)lines defining the character set
        For L_nRunRow = 0 To 6
            Input #1, L_sLine(L_nRunRow)
        Next
        
        ' Close the definition file
        Close #1
            
    ' Create character array data from loaded data ...
        
        ' Run through all characters to be created
        For L_nRunChar = 1 To L_nCharCount
                
            ' Run through all bits within the definition of the current char
            For L_nRunColumn = 0 To 4
                For L_nRunRow = 0 To 6
                    ' Set element at current position
                    G_bFontData(Asc(Mid(L_sInfo, L_nRunChar, 1)), L_nRunRow * 5 + L_nRunColumn) = Not (Mid(L_sLine(L_nRunRow), 6 * (L_nRunChar - 1) + L_nRunColumn + 1, 1) = " ")
                Next
            Next
            
        Next
       
    ' Initialize character position
        G_nCharScrollPos = 59
    
    ' Initialize character surface...
        
            ' Create surface
            Set G_oDDSurfaceChars = MakeDXSurface(520, 47)
        
            ' Set color key to enable transparent blits
            L_dDDCK.dwColorSpaceLowValue = 0
            L_dDDCK.dwColorSpaceHighValue = 0
            G_oDDSurfaceChars.SetColorKey DDCKEY_SRCBLT, L_dDDCK
            
    ' Error handling ...
    
        Exit Sub

E_CreateChars:
    
        AppError Err.Number, Err.Description, "CreateChars"
    
End Sub
    
Private Sub CreateFlames()


    ' Enable error handling...
        On Error GoTo E_CreateFlames

    ' Setup local variables ...
    
    ' Create flame decals ...
        
        ' Load image resource
        Set G_oDDResourceFlame = LoadBitmapIntoDXS(App.Path + "\flame.bmp")
        
        ' Flame #1 ...
        
            ' Create frame to contain decal and lighting, position frame
            G_oD3DInstance.CreateFrame G_oD3DMasterFrame, G_oD3DFrameFlame1
            G_oD3DFrameFlame1.SetPosition Nothing, 12.45, 9.5, 1.5
            
            ' Create surface to contain current animation
            Set G_oDDSurfaceFlame1 = MakeDXSurface(32, 32)
            
            ' Create decal texture from surface
            G_oD3DInstance.CreateTextureFromSurface G_oDDSurfaceFlame1, G_oD3DTextureFlame1
            
            ' Set decal texture properties
            With G_oD3DTextureFlame1
                .SetDecalOrigin 16, 8
                .SetDecalScale 1
                .SetDecalSize 0.5, 0.75
                .SetDecalTransparency 1
                .SetDecalTransparentColor 0
            End With
            
            ' Add decal to frame
            G_oD3DFrameFlame1.AddVisual G_oD3DTextureFlame1
            
        ' Flame #2 ...
        
            ' Create frame to contain decal and lighting, position frame
            G_oD3DInstance.CreateFrame G_oD3DMasterFrame, G_oD3DFrameFlame2
            G_oD3DFrameFlame2.SetPosition Nothing, 9.5, 9.5, 1.5

            ' Create surface to contain current animation
            Set G_oDDSurfaceFlame2 = MakeDXSurface(32, 32)
            
            ' Create decal texture from surface
            G_oD3DInstance.CreateTextureFromSurface G_oDDSurfaceFlame2, G_oD3DTextureFlame2
            
            ' Set decal texture properties
            With G_oD3DTextureFlame2
                .SetDecalOrigin 16, 8
                .SetDecalScale 1
                .SetDecalSize 0.5, 0.75
                .SetDecalTransparency 1
                .SetDecalTransparentColor 0
            End With
            
            ' Add decal to frame
            G_oD3DFrameFlame2.AddVisual G_oD3DTextureFlame2
        
    ' Create lighting for flames ...
        
        ' Lighting #1 ...
        
            ' Create light and set its propertys
            G_oD3DInstance.CreateLightRGB D3DRMLIGHT_POINT, 0.4, 0.3, 0.6, G_oD3DLightFlame1
            G_oD3DLightFlame1.SetConstantAttenuation 1
            
            ' Add light to frame
            G_oD3DFrameFlame1.AddLight G_oD3DLightFlame1
        
        ' Lighting #2 ...
        
            ' Create light and set its propertys
            G_oD3DInstance.CreateLightRGB D3DRMLIGHT_POINT, 0.4, 0.3, 0.6, G_oD3DLightFlame2
            G_oD3DLightFlame2.SetConstantAttenuation 1
            
            ' Add light to frame
            G_oD3DFrameFlame2.AddLight G_oD3DLightFlame2
    
    ' Error handling ...
    
        Exit Sub

E_CreateFlames:

        AppError Err.Number, Err.Description, "CreateFlames"
    
End Sub
    
Private Sub CreateMirror()


    ' Enable error handling...
        On Error GoTo E_CreateMirror

    ' Setup local variables ...
        Dim L_oD3DFace As IDirect3DRMFace                   ' Face to be added to meshbuilder
        Dim L_oD3DMeshbuilder As IDirect3DRMMeshBuilder2    ' Meshbuilder to hold created face
        
    ' Create mirror surface, texture and material ...
        
        ' Create surface to hold mirror
        Set G_oDDSurfaceMirror = MakeDXSurface(64, 64, True)
        
        ' Create mirror texture from surface
        G_oD3DInstance.CreateTextureFromSurface G_oDDSurfaceMirror, G_oD3DTextureMirror
        
        ' Create mirror material
        G_oD3DInstance.CreateMaterial 1, G_oD3DMaterialMirror
        G_oD3DMaterialMirror.SetEmissive 0.4, 0.4, 0.4
        
    ' Initialize mirror display system
    
        ' Create a D3DRM device from the mirror surface
        G_oD3DInstance.CreateDeviceFromSurface G_dD3DDriver.GUID, G_oDDInstance, G_oDDSurfaceMirror, G_oD3DDeviceMirror
    
        ' Check device existance, terminate if missing
        If G_oD3DDeviceMirror Is Nothing Then
           AppError 0, "Could not create D3DRM device", "CreateMirror"
           Exit Sub
        End If
    
        ' Set D3DRM device quality
        G_oD3DDeviceMirror.SetQuality D3DRMLIGHT_ON Or D3DRMFILL_SOLID Or D3DRMSHADE_GOURAUD
        
        ' Create the camera frame containing the mirror camera
        G_oD3DInstance.CreateFrame G_oD3DMasterFrame, G_oD3DFrameMirror
        
        ' Create a D3D viewport from the device, using the camera frame for output
        G_oD3DInstance.CreateViewport G_oD3DDeviceMirror, G_oD3DFrameMirror, 0, 0, 64, 64, G_oD3DViewportMirror
            
        ' Check viewport existance, terminate if missing
        If G_oD3DViewportMirror Is Nothing Then
           AppError 0, "Could not create D3DRM viewport", "CreateMirror"
           Exit Sub
        End If
        
        ' Set the projection model and properties for the viewport
        With G_oD3DViewportMirror
            .SetProjection D3DRMPROJECT_PERSPECTIVE
            .SetBack 10
            .SetFront 1
        End With
        
        ' Set initial mirror camera orientation and position
        G_oD3DFrameMirror.SetPosition Nothing, 11, 13, 2
        G_oD3DFrameMirror.SetOrientation Nothing, 0, -1, -0.2, 0, 0, 1
        
    ' Create faces holding mirror ...
    
        ' Initialize meshbuilder
        G_oD3DInstance.CreateMeshBuilder L_oD3DMeshbuilder

        ' Create mirror surrounding (forward looking) ...
        
            ' Create face
            G_oD3DInstance.CreateFace L_oD3DFace
            With L_oD3DFace
                .AddVertex 9.9, 12.5, 1
                .AddVertex 12.1, 12.5, 1
                .AddVertex 12.1, 12.5, 3.2
                .AddVertex 9.9, 12.5, 3.2
                .SetTextureCoordinates 0, 11, 2
                .SetTextureCoordinates 1, 10, 2
                .SetTextureCoordinates 2, 10, 1
                .SetTextureCoordinates 3, 11, 1
            End With
                    
            ' Set mirror face texture and material
            L_oD3DFace.SetColorRGB 0.1, 0.1, 0.1
            
            ' Add face data to meshbuilder
            L_oD3DMeshbuilder.AddFace L_oD3DFace
            
            ' Release face
            Set L_oD3DFace = Nothing
        
        ' Create mirror surrounding (backward looking) ...
        
            ' Create face
            G_oD3DInstance.CreateFace L_oD3DFace
            With L_oD3DFace
                .AddVertex 9.9, 12.5, 3.2
                .AddVertex 12.1, 12.5, 3.2
                .AddVertex 12.1, 12.5, 1
                .AddVertex 9.9, 12.5, 1
            End With
                    
            ' Set mirror face texture and material
            L_oD3DFace.SetColorRGB 0.1, 0.1, 0.1
            
            ' Add face data to meshbuilder
            L_oD3DMeshbuilder.AddFace L_oD3DFace
            
            ' Release face
            Set L_oD3DFace = Nothing
        
        ' Create mirror surface ...
        
            ' Create face holding mirror
            G_oD3DInstance.CreateFace L_oD3DFace
            With L_oD3DFace
                .AddVertex 10, 12.45, 1.1
                .AddVertex 12, 12.45, 1.1
                .AddVertex 12, 12.45, 3.1
                .AddVertex 10, 12.45, 3.1
                .SetTextureCoordinates 0, 10, 2
                .SetTextureCoordinates 1, 11, 2
                .SetTextureCoordinates 2, 11, 1
                .SetTextureCoordinates 3, 10, 1
            End With
                    
            ' Set mirror face texture and material
            L_oD3DFace.SetTexture G_oD3DTextureMirror
            L_oD3DFace.SetMaterial G_oD3DMaterialMirror
            
            ' Add face data to meshbuilder
            L_oD3DMeshbuilder.AddFace L_oD3DFace
                
            ' Reset face
            Set L_oD3DFace = Nothing
        
        ' Generate lighting normals
        L_oD3DMeshbuilder.GenerateNormals
        
        ' Add created mesh to frame
        G_oD3DMasterFrame.AddVisual L_oD3DMeshbuilder