- 注册时间
- 2007-6-2
- 最后登录
- 2019-7-20
版主
- 积分
- 750
|
楼主 |
发表于 2007-6-25 00:36:20
|
显示全部楼层
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 |
|