TV3D中文版 For VB6 代码风格欣赏

大兵潜水艇

Option Explicit

Private CC     As New CCEN引擎
Private Land   As New CCLA环境编辑器
Private Tex    As New CCTE纹理图片库
Private Sky    As New CCSK天空编辑器
Private Eff    As New CCEF特效画面
Private Scene  As New CCSC现场窗口
Private Inp    As New CCIN输入控制

Private PosX   As Single
Private PosY   As Single
Private PosZ   As Single
Private LookX  As Single
Private LookY  As Single
Private LookZ  As Single
Private AngX   As Single
Private AngY   As Single

Private Walk   As Single
Private Strafe As Single

Private WaterH As Single
_____________________________________________________________________________
Private Sub Form_Load()

   
    CC.Se_设置默认路径 App.Path & "\\..\\..\\Media"
    CC.Inw窗口模式 Me.hWnd
    CC.Dif显示FPS = True
   
    Tex.Lo_载入图片 "sky\\top.bmp", "SkyTop"
    Tex.Lo_载入图片 "sky\\bttom.bmp", "SkyBottom"
    Tex.Lo_载入图片 "sky\\left.bmp", "SkyLeft"  '3
    Tex.Lo_载入图片 "sky\\right.bmp", "SkyRight"  '1
    Tex.Lo_载入图片 "sky\\front.bmp", "SkyFront"  '2
    Tex.Lo_载入图片 "sky\\back.bmp", "SkyBack"  '4
   
    Sky.Crb_建造天空盒 GetTex("SkyFront"), GetTex("SkyBack"), GetTex("SkyLeft"), GetTex("SkyRight"), GetTex("SkyTop"), GetTex("SkyBottom")
    Sky.Onb_开启天空盒 True
   
    Set Land = New CCLA环境编辑器
   
  Land.Crt_生成地形 "heightmap.jpg", 平均精度, 8, 8, -700, -1024, True
   
    Tex.Lo_载入图片 "dirtandgrass.jpg", "LandTexture"
   
    Land.Sef_设置地面贴图 GetTex("LandTexture")
    Land.Sefu设置地面UV贴图缩放 3, 3
   
    Tex.Lo_载入图片 "sun.jpg", "Sun"
   
    Sky.Crs_建造太阳 GetTex("Sun")
    Sky.Sesz设置太阳缩放比 1
   
    Sky.Sesp设置太阳位置 -1000, 570, 0
    Sky.Ons_开启太阳 True
   
    Tex.Lo_载入图片 "flare1.jpg", "Flare1"
    Tex.Lo_载入图片 "flare2.jpg", "Flare2"
    Tex.Lo_载入图片 "flare3.jpg", "Flare3"
    Tex.Lo_载入图片 "flare4.jpg", "Flare4"
   
   
    Sky.Sesl设置太阳光环数 4
    Sky.Onsl开启太阳光环 True
    Sky.Crsl建造太阳光环 1, GetTex("Flare1"), 2 * 5, 40, RGBA(1, 1, 1, 0.5), RGBA(1, 1, 1, 0.5)
    Sky.Crsl建造太阳光环 2, GetTex("Flare2"), 2 * 1, 18, RGBA(1, 1, 1, 0.5), RGBA(1, 1, 1, 0.5)
    Sky.Crsl建造太阳光环 3, GetTex("Flare3"), 2 * 1.8, 15, RGBA(1, 1, 1, 0.5), RGBA(0.7, 1, 1, 0.5)
    Sky.Crsl建造太阳光环 4, GetTex("Flare4"), 2 * 1, 6, RGBA(1, 0.1, 0, 0.5), RGBA(0.5, 1, 1, 0.5)
   
    Tex.Lo_载入图片 "landscapewater.jpg", "Water"
   
    Land.Sew_设置水面贴图 GetTex("Water")
    Land.Sewe设置水面效果 True, 0.5, True, D3DBLEND_SRCALPHA, D3DBLEND_INVSRCALPHA, False, 0
    Land.Sewz设置水面贴图缩放 32
   
    WaterH = 100
    Land.Sewh设置水面高度 WaterH
   
    Land.Onw_开启水面 True
   
    Tex.Lo_载入图片 "clouds.dds", "Clouds", , , 黑色
   
    Land.Crc_创建云层 GetTex("Clouds"), 按层移动, 500, 1, 1, 2, 2, 1024
    Land.Secs设置云层速度 1, 0.01, 0.01
   
    PosX = 0
    PosY = 20
    PosZ = 0
    LookX = 0
    LookY = 20
    LookZ = 50
    AngX = 0
    AngY = 0
   
    Walk = 0
    Strafe = 0
   
    Form1.Show
   
    Scene.Sev设置透视参数 50, 4000
   
    Main_Loop
End Sub
_____________________________________________________________________________

Private Sub Main_Loop()
   
    Do
        DoEvents
        Check_Input
        Check_Movement
        
        CC.GO_开始渲染
           If PosY < WaterH Then
              Sky.Onf_开启雾 True
              Sky.Sefc设置雾颜色 0, 0.4, 0.5, 1
              Sky.Inf_初始化雾 0, 0, 0.01
              Sky.Sef_设置雾化方式 指数衰减, 范围雾化
              Sky.Onsl开启太阳光环 False
           Else
              Sky.Onsl开启太阳光环 True
              Sky.Onf_开启雾 False
           End If
        
           Sky.TO__呈递天空
           Land.TO__呈递环境 True, True
           Scene.TO_呈递全部物体
        CC.TO_结束渲染
   
    Loop Until Inp.Is_检测键盘输入(ESC)
   
    End

End Sub
_____________________________________________________________________________

Private Sub Check_Input()
        If Inp.Is_检测键盘输入(Up_) Then
            Walk = 1
        ElseIf Inp.Is_检测键盘输入(Down_) Then
            Walk = -1
        End If
        
        If Inp.Is_检测键盘输入(Left_) Then
            Strafe = 1
        ElseIf Inp.Is_检测键盘输入(Right_) Then
            Strafe = -1
        End If
        
        Dim MouseX As Long, MouseY As Long
        Dim MouseB1 As Integer, MouseB2 As Integer, MouseB3 As Integer
        Dim MouseOld As Long, MouseNew As Long

        MouseOld = MouseNew
        
        Inp.Re_返回鼠标消息 MouseX, MouseY, MouseB1, MouseB2, MouseB3, MouseNew
        
        AngX = AngX - (MouseY / 100)
        AngY = AngY - (MouseX / 100)

End Sub
_____________________________________________________________________________

Private Sub Check_Movement()
        Dim FPStime As Single
        FPStime = CC.Ge_获取FPS帧时间
        
        If AngX > 1.3 Then AngX = 1.3
        If AngX < -1.3 Then AngX = -1.3
      
        Select Case Walk
        Case Is > 0
            Walk = Walk - 0.005 * FPStime
            If Walk < 0 Then Walk = 0
        Case Is < 0
            Walk = Walk + 0.005 * FPStime
            If Walk > 0 Then Walk = 0
        End Select
        
        Select Case Strafe
        Case Is > 0
            Strafe = Strafe - 0.005 * FPStime
            If Strafe < 0 Then Strafe = 0
        Case Is < 0
            Strafe = Strafe + 0.005 * FPStime
            If Strafe > 0 Then Strafe = 0
        End Select
        
        PosX = PosX + (Cos(AngY) * Walk / 5 * FPStime) + (Cos(AngY + 3.141596 / 2) * Strafe / 5 * FPStime)
        PosZ = PosZ + (Sin(AngY) * Walk / 5 * FPStime) + (Sin(AngY + 3.141596 / 2) * Strafe / 5 * FPStime)
        
        PosY = Land.Gef_获取地面高度(PosX, PosZ) + 10
        
        LookX = PosX + Cos(AngY)
        LookY = PosY + Tan(AngX)
        LookZ = PosZ + Sin(AngY)

        Scene.Pu_调整摄像机 PosX, PosY, PosZ, LookX, LookY, LookZ

End Sub
_____________________________________________________________________________

Private Sub Form_Unload(Cancel As Integer)
    Main_Quit
End Sub
_____________________________________________________________________________

Private Sub Main_Quit()
    Set Tex = Nothing
    Set Eff = Nothing
    Set Land = Nothing
    Set Inp = Nothing
    Set Scene = Nothing
    Set CC = Nothing
End Sub

大兵潜水艇

Option Explicit
Private CC     As New CCEN引擎
Private Scene  As New CCSC现场窗口
Private Tex    As New CCTE纹理图片库
Private Inp    As New CCIN输入控制
Private Atmos  As New CCSK天空编辑器

Private Room   As CCMO模型

Private DoLoop As Boolean

Private PosX   As Single
Private PosY   As Single
Private PosZ   As Single
Private LookX  As Single
Private LookY  As Single
Private LookZ  As Single
Private AngleX As Single
Private AngleY As Single

Private Walk   As Single
Private Strafe As Single
Private Sub cmdQuit_Click()
  DoLoop = False
End Sub
_____________________________________________________________________________
Private Sub Form_Load()

    SetLicenseKey TrialOnly

    CC.Se_设置默认路径 App.Path & "\\..\\..\\Media"
   
    CC.Fs_全屏抗锯齿等级 = s4X
   
    CC.Inw窗口模式 Picture1.hWnd
    Form1.Show
   
    CC.Ona开启全屏抗锯齿 True
   
    CC.Dif显示FPS = True
   
    Tex.Lo_载入图片 "sky\\top.bmp", "SkyTop"
    Tex.Lo_载入图片 "sky\\bttom.bmp", "SkyBottom"
    Tex.Lo_载入图片 "sky\\left.bmp", "SkyLeft"  '3
    Tex.Lo_载入图片 "sky\\right.bmp", "SkyRight"  '1
    Tex.Lo_载入图片 "sky\\front.bmp", "SkyFront"  '2
    Tex.Lo_载入图片 "sky\\back.bmp", "SkyBack"  '4
   
   
    Atmos.Crb_建造天空盒 GetTex("SkyFront"), GetTex("SkyBack"), GetTex("SkyLeft"), GetTex("SkyRight"), GetTex("SkyTop"), GetTex("SkyBottom")
    Atmos.Onb_开启天空盒 True
   
    Tex.Lo_载入图片 "wall1.jpg", "WallTex"
    Tex.Lo_载入图片 "grass1.bmp", "FloorTex"
   
    Set Room = Scene.Cr_创建模型
   
    Room.Crp_建造面片墙壁 GetTex("WallTex"), 500, -500, -500, -500, 100, 0, 3, 1
    Room.Crp_建造面片墙壁 GetTex("WallTex"), -500, -500, -500, 500, 100, 0, 3, 1
    Room.Crp_建造面片墙壁 GetTex("WallTex"), -500, 500, 500, 500, 100, 0, 3, 1
    Room.Crp_建造面片墙壁 GetTex("WallTex"), 500, 500, 500, -500, 100, 0, 3, 1
   
    Room.Crf_建造地板 GetTex("FloorTex"), -500, -500, 500, 500, 0, 10, 10
   
    PosX = 0
    PosY = 20
    PosZ = 0
    LookX = 0
    LookY = 20
    LookZ = 50
    AngleX = 0
    AngleY = 0
   
    Walk = 0
    Strafe = 0
   
    Scene.Sev设置透视参数 60, 10000
   
    DoLoop = True
    Main_Loop
End Sub
_____________________________________________________________________________
Private Sub Main_Loop()
    Do
        DoEvents
        If Inp.Is_检测键盘输入(Up_) Then
            Walk = 0.5
        ElseIf Inp.Is_检测键盘输入(Down_) Then
            Walk = -0.5
        End If
        If Inp.Is_检测键盘输入(Left_) Then
            Strafe = 0.5
        ElseIf Inp.Is_检测键盘输入(Right_) Then
            Strafe = -0.5
        End If
        
        Dim MouseX As Long, MouseY As Long
        Dim MouseB1 As Integer, MouseB2 As Integer, MouseB3 As Integer
        Dim MouseScrollOld As Long, MouseScrollNew As Long
        
        MouseScrollOld = MouseScrollNew
        Inp.Re_返回鼠标消息 MouseX, MouseY, MouseB1, MouseB2, MouseB3, MouseScrollNew

        AngleX = AngleX - (MouseY / 100)
        AngleY = AngleY - (MouseX / 100)

        If AngleX > 1.3 Then AngleX = 1.3
        If AngleX < -1.3 Then AngleX = -1.3
        
        Select Case Walk
        Case Is > 0
            Walk = Walk - 0.05
            If Walk < 0 Then Walk = 0
        Case Is < 0
            Walk = Walk + 0.05
            If Walk > 0 Then Walk = 0
        End Select
        
        Select Case Strafe
        Case Is > 0
            Strafe = Strafe - 0.05
            If Strafe < 0 Then Strafe = 0
        Case Is < 0
            Strafe = Strafe + 0.05
            If Strafe > 0 Then Strafe = 0
        End Select
        
        PosX = PosX + (Cos(AngleY) * Walk * CC.Gej获取FPS精确时间) + (Cos(AngleY + 3.141596 / 2) * Strafe * CC.Gej获取FPS精确时间)
        PosZ = PosZ + (Sin(AngleY) * Walk * CC.Gej获取FPS精确时间) + (Sin(AngleY + 3.141596 / 2) * Strafe * CC.Gej获取FPS精确时间)
        LookX = PosX + Cos(AngleY)
        LookY = PosY + Tan(AngleX)
        LookZ = PosZ + Sin(AngleY)
        
        Scene.DV_摄像机.Pu_调整摄象机 PosX, PosY, PosZ, LookX, LookY, LookZ
        
        CC.GO_开始渲染
           Atmos.TOb_呈递天空盒
           Scene.TO_呈递全部物体
        CC.TO_结束渲染
   
    Loop Until DoLoop = False Or Inp.Is_检测键盘输入(ESC)
   
    Call Quit
End Sub
_____________________________________________________________________________
Private Sub Quit()
    Set Room = Nothing
    Set Inp = Nothing
    Set Scene = Nothing
    Set CC = Nothing
    End
End Sub
_____________________________________________________________________________
Private Sub Form_Unload(Cancel As Integer)
    DoLoop = False
    Call Quit
End Sub

大兵潜水艇

Option Explicit
Public CC      As New CCEN引擎
Public Scene   As New CCSC现场窗口
Public Inp     As New CCIN输入控制
Public Camera  As New CCDV摄像机
Public Mat     As New CCME材质编辑器

Public Light   As CCLI灯光
Public Mesh    As CCMO模型
Public Blended As CCMO模型

Public LightID As Integer
_____________________________________________________________________________
Private Sub Form_Load()


    CC.Dif显示FPS = True
   
    CC.Ini初始化窗口 Form1.hWnd
    Form1.Show
   
    CC.Se_设置默认路径 App.Path & "\\..\\..\\Media"
   
    Set Mesh = Scene.Cr_创建模型("Room")
   
    Dim i As Long
    For i = 0 To 19
     Mesh.Crp_建造面片墙壁 0, -10, i * 5, -10, i * 5 + 5, 20
     Mesh.Crp_建造面片墙壁 0, 10, i * 5 + 5, 10, i * 5, 20
     Mesh.Crf_建造地板 0, -10, i * 5, 10, i * 5 + 5, 0
     Mesh.Crf_建造地板 0, -10, i * 5, 10, i * 5 + 5, 20
    Next i
     
     Mesh.Crp_建造面片墙壁 0, -10, 100, 10, 100, 20
     Mesh.Crp_建造面片墙壁 0, -10, 0, 10, 0, 20
   
    Scene.Lo_载入图片 "brick1.bmp", , , "BrickTexture"
   
    Mesh.Set_设置贴图 GetTex("BrickTexture")
   
    Camera.Pu_调整摄象机 0, 10, 0, 0, 10, 1
   
    Mat.Cr_快速创建材质 0.2, 0.2, 0.2, 1, "Mat"
   
    Mat.Sed设置漫反射光参数 GetMat("Mat"), 1, 1, 1, 1
   
    Mesh.Apm_应用材质 GetMat("Mat")
   
    Mesh.Com_计算动态光影
   
    Set Light = New CCLI灯光
   
    Dim LightD As D3DLIGHT8
   
    LightD.Type = D3DLIGHT_POINT
    LightD.Position = Vector(0, 10, 10)
    LightD.Range = 130
    LightD.Ambient = DXColor(300, 300, 300, 1)
    LightD.diffuse = DXColor(300, 300, 300, 1)
   
    LightD.Attenuation0 = 1
    LightD.Attenuation1 = 1
    LightD.Attenuation2 = 1
   
    Light.Crl创建灯光 LightD
   
    Set Blended = Scene.Cr_创建模型("Blended")
   
    Blended.Seb_设置贴图混合方式 透明方式
   
    Blended.Crp_建造面片墙壁 0, -10, 50, 10, 50, 20
   
    Blended.Sec_设置颜色 RGBA(1, 0, 0, 0.2)
   
    Dim a As Single
    Do
      DoEvents
      
      CC.GO_开始渲染
         Scene.TO_呈递全部物体
      CC.TO_结束渲染
      
      a = a + CC.Ge_获取FPS帧时间 * 0.001
      LightD.Position = Vector(0, 10, Sin(a) * 50 + 50)
      Light.Up_更新灯光 1, LightD
      
      If Inp.Is_检测键盘输入(Up_) Then Camera.Mo_移动相对位置 1, 0, 0
      If Inp.Is_检测键盘输入(Down_) Then Camera.Mo_移动相对位置 -1, 0, 0
      If Inp.Is_检测键盘输入(Right_) Then Camera.Y轴旋转 Deg2Rad(1)
      If Inp.Is_检测键盘输入(Left_) Then Camera.Y轴旋转 Deg2Rad(-1)
   
    Loop Until Inp.Is_检测键盘输入(ESC)
   
    End
   
End Sub
_____________________________________________________________________________
Private Sub Form_Unload(Cancel As Integer)
Set CC = Nothing
Set Scene = Nothing
Set Inp = Nothing
Set Camera = Nothing
Set Mat = Nothing

Set Light = Nothing
Set Mesh = Nothing
Set Blended = Nothing
End Sub

FantasyDR

sorry，说得貌似太直接了。VB对COM支持的蛮好，智能感知的确很方便的。

但这样写太不习惯，个人持保留意见了，况且我自己也想不出什么方法可以更好的照顾不愿意看英文的朋友，因此再说下去就没有必要了^_^bb

大兵潜水艇

呵呵，楼上不必客气。

中文函数都是自动列举出来的，所以不需要可以打中文字。每个函数参数都是中文名，所以使用起来非常方便。

如果不习惯看中文代码也可以把程序做好后转换为英文代码。只不过最后编译出来都是一样的。

goldloong

[s:1]  [s:1]  好好  可惜我看不懂啊  分段讲解下把  藕菜鸟 嘻嘻 [s:2]

公爵つ。

哈哈,我晕..完全看不懂!