Chinaunix首页 | 论坛 | 博客
  • 博客访问: 8700393
  • 博文数量: 1413
  • 博客积分: 11128
  • 博客等级: 上将
  • 技术积分: 14685
  • 用 户 组: 普通用户
  • 注册时间: 2006-03-13 10:03
个人简介

follow my heart...

文章分类

全部博文(1413)

文章存档

2013年(1)

2012年(5)

2011年(45)

2010年(176)

2009年(148)

2008年(190)

2007年(293)

2006年(555)

分类:

2006-11-26 19:51:19

' 在地形中包括地面天空水云彩________________________________________________________________________
' TrueVision3D (web: http://www.truevision3d.com)
' ????????????????????????????????????
' Tutorial 8 : A complete landscape.
' ?????
' Description : In this 8th tutorial, we take the last tutorial but
' ?????? we add everything we can to make this world the most
' impressive we can with effects like : water, clouds,
' a sun with lens flare and some underwater fog.

' Force explicit declarations
Option Explicit

' We declare TrueVision3D.
Private TV3D As TVEngine

' We declare the landscape
Private Land As TVLandscape

' New : the texture factory. To apply a texture to the land, we have
' to use and other object that will hold all the textures needed
' in our project.
Private TextureFactory As TVTextureFactory

' New : to enable fog in our project, we have to use the TVAtmosphere object like
' the sky. The TVGraphicEffect class let us to make some interesting screen
'effects like fade in and fade out.
Private Atmos As TVAtmosphere
Private GraphicFX As TVGraphicEffect

' We the declare the scene
Private Scene As TVScene

' We declare the input engine.
Private InputEngine As TVInputEngine

' The loop.
Private DoLoop As Boolean

' We are going to use camera (point of view) angles, as well as the
' camera position and look at vectors.
Private sngPositionX As Single
Private sngPositionY As Single
Private sngPositionZ As Single
Private snglookatX As Single
Private snglookatY As Single
Private snglookatZ As Single
Private sngAngleX As Single
Private sngAngleY As Single

' We could have done this in many ways, but we added some smoothing to
' the movement se we need to declare two additional variables.
Private sngWalk As Single
Private sngStrafe As Single

' We declare a variable which will hold the water height.
Private sngWaterHeight As Single

Private Sub cmdQuit_Click()

    ' We have clicked on the "Quit" button, so we change the DoLoop.
    DoLoop = False

End Sub

Private Sub Form_Load()

    ' We have to create the TV3D object before anything else.
    Set TV3D = New TVEngine

    ' We put the debug file in the app directory
    
    TV3D.SetDebugFile App.Path + "\debug.txt"
    TV3D.SetSearchDirectory App.Path
    
    ' We initialize TV3D in the picture box of the form.
    TV3D.Init3DWindowedMode Picture1.hWnd

    ' We want to see the FPS.
    TV3D.DisplayFPS = True

    ' We create the input object.
    Set InputEngine = New TVInputEngine

    ' We create the scene (the world).
    Set Scene = New TVScene

    ' We create the atmosphere class
    Set Atmos = New TVAtmosphere

    ' We create the texture factory
    Set TextureFactory = New TVTextureFactory

    ' We load the sky textures into the tex factory..
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\up.jpg", "SkyTop"
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\down.jpg", "SkyBottom"
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\left.jpg", "SkyLeft"
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\right.jpg", "SkyRight"
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\front.jpg", "SkyFront"
    TextureFactory.LoadTexture "..\..\..\Media\sky\sunset\back.jpg", "SkyBack"
    
    ' We set the sky textures.
    Atmos.SkyBox_SetTexture GetTex("SkyFront"), GetTex("SkyBack"), GetTex("SkyLeft"), GetTex("SkyRight"), GetTex("SkyTop"), GetTex("SkyBottom")
    Atmos.SkyBox_Enable True

    ' New : the land generation. This is so much fun because it's
    ' so You load a texture as a height map, the engine
    ' does the rest. But before this, we create the land object.
    Set Land = New TVLandscape
        
    
    ' SetFactorY must be applied BEFORE generating the terrain
    ' If you want to change dynamically the scaling of terrain afterwars
    ' use Land.SetTerrainScale method.
        
    ' Generate the height of the land from the grayscale of the image.
    Land.GenerateHugeTerrain "..\..\..\Media\heightmap.jpg", TV_PRECISION_LOW, 8, 8, -700, -1024, True
    

    ' Then, we load the land texture.
    TextureFactory.LoadTexture "..\..\..\Media\dirtandgrass.jpg", "LandTexture"
    
    ' We assign a texture to that land.
    Land.SetTexture GetTex("LandTexture")
    Land.SetTextureScale 3, 3
    
    ' New : the sun. We have to place the sun in the world. Just like the
    ' sky box, the sun is attached to the camera position vector. You will
    ' never notice it until you start playing really badly with the
    ' properties of the sun. Let's start by loading a texture for it.
    TextureFactory.LoadTexture "..\..\..\Media\sun.jpg", "Sun"
    
    ' Then, initialize it by placing it via a vector
    ' using the atmosphere sun feature
    '设置大气中太阳的材质
    Atmos.Sun_SetTexture GetTex("Sun")
    '设置太阳大小
    Atmos.Sun_SetBillboardSize 1
    ' this is the relative position of the sun from the player camera.
    '设置太阳位置
    Atmos.Sun_SetPosition -1000, 570, 0
    Atmos.Sun_Enable True
    
    ' New : To add extra visual effects, we add a lens flare effect. For
    ' this, we have to load some cirles that will be used to simulate
    ' the flare effect.
    TextureFactory.LoadTexture "..\..\..\Media\flare1.jpg", "Flare1"
    TextureFactory.LoadTexture "..\..\..\Media\flare2.jpg", "Flare2"
    TextureFactory.LoadTexture "..\..\..\Media\flare3.jpg", "Flare3"
    TextureFactory.LoadTexture "..\..\..\Media\flare4.jpg", "Flare4"
    
    ' Initialize the lens flares.
    '初始化光晕
    Atmos.LensFlare_SetLensNumber 4
    Atmos.LensFlare_Enable True
    Atmos.LensFlare_SetLensParams 1, GetTex("Flare1"), 2 * 5, 40, RGBA(1, 1, 1, 0.5), RGBA(1, 1, 1, 0.5)
    Atmos.LensFlare_SetLensParams 2, GetTex("Flare2"), 2 * 1, 18, RGBA(1, 1, 1, 0.5), RGBA(1, 1, 1, 0.5)
    Atmos.LensFlare_SetLensParams 3, GetTex("Flare3"), 2 * 1.8, 15, RGBA(1, 1, 1, 0.5), RGBA(0.7, 1, 1, 0.5)
    Atmos.LensFlare_SetLensParams 4, GetTex("Flare4"), 2 * 1, 6, RGBA(1, 0.1, 0, 0.5), RGBA(0.5, 1, 1, 0.5)

    ' New : also for fun, we add animated water. We start by loading the
    ' water teture...
    '在材质库中加载水的材质
    TextureFactory.LoadTexture "..\..\..\Media\water.bmp", "Water"
    
    ' Then, we set everything we can for this water.
    ' This for example, setup a transparent water (50%)
    '陆地中水的材质的水的效果
    Land.SetWaterTexture GetTex("Water")
    Land.SetWaterEffect True, 0.5, True, D3DBLEND_SRCALPHA, D3DBLEND_INVSRCALPHA, False, 0
    Land.SetWaterTextureScale 32
    
    ' We set the water height via a variable. We need this variable
    ' to be able to add an extra underwater fog effect later, at the
    ' rendering.
    sngWaterHeight = 100
    Land.SetWaterAltitude sngWaterHeight
    
    ' And we finish by enabling the water.
    Land.SetWaterEnable True
    
    ' New : for fun, we will also add some clouds, just over the water
    ' to give a creepy fog effect. Let's start by loading the clouds textures.
    '加载云的材质
    TextureFactory.LoadTexture "..\..\..\Media\clouds.dds", "Clouds", , , TV_COLORKEY_BLACK

    ' Then, set the land's clouds.
' Land.SetCloudTexture GetTex("Clouds")
  '初始化云彩
    Land.InitClouds GetTex("Clouds"), TV_CLOUD_MOVE, 500, 1, 1, 2, 2, 1024
    '设置云的速度
    Land.SetCloudVelocity 1, 0.01, 0.01
    

    ' We set the camera vectors (position and look at) and angles.
    sngPositionX = 0
    sngPositionY = 20
    sngPositionZ = 0
    snglookatX = 0
    snglookatY = 20
    snglookatZ = 50
    sngAngleX = 0
    sngAngleY = 0
    
    ' We set the initial values of movement
    sngWalk = 0
    sngStrafe = 0
    
    ' We pop the form over everything else.
    Form1.Show
        
    'Set the viewing distance
    Scene.SetViewFrustum 90, 4000
        
    ' We start the main loop.
    DoLoop = True
    Main_Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)

    ' The user asked to quit but clicked on the 'X' button at up right.
    DoLoop = False
    
    ' And ask to quit.
    Main_Quit

End Sub

Private Sub Main_Loop()
   ' The main loop
    Do
        ' Let us the capacity to use buttons of the form.
        DoEvents
        
        ' New : We moved the movement code in an other sub to make
        ' the code clearer.
        Check_Input
        
        ' New : We moved the checking of maximum camera "look at" and
        ' also the camera movement smoothing in an other sub too.
        Check_Movement

        ' Clear the the last frame.
        TV3D.Clear
        
        ' New : if we are below the waterheight, this means the we are
        ' underwater. To give a cool underwater effect, we will add fog.
        ' If we are over the ground, then don't add the fog but render
        ' the lens flare.
        '如果y坐标小于水的高度时
        If sngPositionY < sngWaterHeight Then
            
            ' Render a blue fog to simulate under water.
            '给大气中设置蓝色的雾效果
              Atmos.Fog_Enable True
              Atmos.Fog_SetColor 0, 0.4, 0.5, 1
              Atmos.Fog_SetParameters 0, 0, 0.01
              Atmos.Fog_SetType TV_FOG_EXP, TV_FOGTYPE_RANGE
            Atmos.LensFlare_Enable False
            
        Else
            
    ' ' New : we have to render the lens flare.
            Atmos.LensFlare_Enable True
            Atmos.Fog_Enable False
        End If

        ' New have to render the sky, the sun and lens flares
        Atmos.Atmosphere_Render

        ' New : we have to render the landscape.
        Land.Render True, True
        'Land.RenderWater
                
        ' We render all the 3D objects contained in the scene.
        Scene.RenderAllMeshes
                
        ' We display everything that we have rendered
        TV3D.RenderToScreen
    
    'We loop all of this until the DoLoop isn't True.
    Loop Until DoLoop = False
    
    ' We ask to quit.
    Main_Quit

End Sub

Private Sub Check_Input()
        
        ' Check if we pressed the UP arrow key, if so, then we are
        ' walking forward.
        If InputEngine.IsKeyPressed(TV_KEY_UP) = True Then
            
            sngWalk = 1
            
        ' If we are not walking forward, maybe we are walking backward
        ' by using the DOWN arrow? If so, set walk speed to negative.
        ElseIf InputEngine.IsKeyPressed(TV_KEY_DOWN) = True Then
            
            sngWalk = -1
        
        End If

        ' Check if we pressed the LEFT arrow key, if so, then strafe
        ' on the left.
        If InputEngine.IsKeyPressed(TV_KEY_LEFT) = True Then
            
            sngStrafe = 1
                
        ' If we are not strafing left, maybe we want to strafe to the
        ' right, using the RIGHT arrow? If so, set strafe to negative.
        ElseIf InputEngine.IsKeyPressed(TV_KEY_RIGHT) = True Then
        
            sngStrafe = -1
        
        End If

        ' Now, for the mouse input...
        Dim tmpMouseX As Long, tmpMouseY As Long
        Dim tmpMouseB1 As Integer, tmpMouseB2 As Integer, tmpMouseB3 As Integer
        Dim tmpMouseScrollOld As Long, tmpMouseScrollNew As Long

        ' Actual value to old mouse scroller value.
        tmpMouseScrollOld = tmpMouseScrollNew

        ' Get the movement of the mouse.
        InputEngine.GetMouseState tmpMouseX, tmpMouseY, tmpMouseB1, tmpMouseB2, tmpMouseB3, tmpMouseScrollNew

        ' Update the camera angles.
        sngAngleX = sngAngleX - (tmpMouseY / 100)
        sngAngleY = sngAngleY - (tmpMouseX / 100)

End Sub

Private Sub Check_Movement()
        
        ' Simple check of the mouse.
        If sngAngleX > 1.3 Then sngAngleX = 1.3
        If sngAngleX < -1.3 Then sngAngleX = -1.3

        ' Okay, now for the smothing of the movement... Update
        ' the forward and backward (walk) movement.
        Select Case sngWalk
        Case Is > 0
            sngWalk = sngWalk - 0.005 * TV3D.TimeElapsed
            If sngWalk < 0 Then sngWalk = 0
        Case Is < 0
            sngWalk = sngWalk + 0.005 * TV3D.TimeElapsed
            If sngWalk > 0 Then sngWalk = 0
        End Select
        
        ' Now, we update the left and right (strafe) movement.
        Select Case sngStrafe
        Case Is > 0
            sngStrafe = sngStrafe - 0.005 * TV3D.TimeElapsed
            If sngStrafe < 0 Then sngStrafe = 0
        Case Is < 0
            sngStrafe = sngStrafe + 0.005 * TV3D.TimeElapsed
            If sngStrafe > 0 Then sngStrafe = 0
        End Select
        
        ' Update the vectors using the angles and positions.
        sngPositionX = sngPositionX + (Cos(sngAngleY) * sngWalk / 5 * TV3D.TimeElapsed) + (Cos(sngAngleY + 3.141596 / 2) * sngStrafe / 5 * TV3D.TimeElapsed)
        sngPositionZ = sngPositionZ + (Sin(sngAngleY) * sngWalk / 5 * TV3D.TimeElapsed) + (Sin(sngAngleY + 3.141596 / 2) * sngStrafe / 5 * TV3D.TimeElapsed)
        
        ' New : because we are using a landscape with up and down, we
        ' can't let the camera at the same height. We want the camera to
        ' follow the height of the map, so we use the "get height". Also,
        ' because we want to have the effect that we are not a mouse,
        ' we will add some height to the height returned...
        sngPositionY = Land.GetHeight(sngPositionX, sngPositionZ) + 10
        
        ' We update the look at position.
        snglookatX = sngPositionX + Cos(sngAngleY)
        snglookatY = sngPositionY + Tan(sngAngleX)
        snglookatZ = sngPositionZ + Sin(sngAngleY)

        ' With the new values of the camera vectors (position and
        ' look at), we update the scene's camera.
        Scene.SetCamera sngPositionX, sngPositionY, sngPositionZ, snglookatX, snglookatY, snglookatZ

End Sub

Private Sub Main_Quit()
        
    ' We want to quit the project, so we start by desroyng
    ' the texture factory.
    Set TextureFactory = Nothing
    
    ' We destroy the graphic effects object
    Set GraphicFX = Nothing
    
    ' We destroy the land object.
    Set Land = Nothing
    
    ' Don't forget to destroy the inputengine object...
    Set InputEngine = Nothing
    
    ' Then, we destroy the scene object.
    Set Scene = Nothing
    
    ' We finish the frenetic destroy with the TV3D object.
    Set TV3D = Nothing
    
    ' We end the application.
    End

End Sub

阅读(2570) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~