|
|
楼主 |
发表于 2005-9-15 17:48:00
|
显示全部楼层
Re:以前的问题，至今还没解决otz||
Dim dx As New DirectX8
Dim D3DDev As Direct3DDevice8
Dim D3DX As New D3DX8 '//A helper library
Dim w_main As New WDMain8
Dim w_Running As Boolean
Dim texture As Direct3DTexture8
Const FVF_TLVERTEX = (D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR)
Const FVF_LVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
Const FVF_VERTEX = (D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1)
'Dim testSprite As D3DXSprite '*
Dim w_2DTexture As New WDTexture8
Dim w_sprite As New WDSpriteBox
'Dim spriteREC As RECT
Dim w_text As New WDText8
Dim FpsFont As WDFPSChicker
Dim w_Rendering As New WDRender8
Dim XXWindow As D3DPRESENT_PARAMETERS
Private Sub Form_DblClick()
w_Running = False
End Sub
Private Sub Form_Load()
Me.Show
'If Form1.hWnd <> dx.isRunning(Form1.Caption) Then '不允许多个进程
' Set dx = Nothing
' End
'End If
'ReDim w_FontCSS(0)
'w_FontCSS.Name = "Verdana"
'w_FontCSS.SIZE = 9
w_main.AdapterIndex = 0
w_main.DeviceType = D3DDEVTYPE_HAL
w_main.WindowWidth = 1280
w_main.WindowHeight = 960
w_main.WindowBit = D3DFMT_X8R8G8B8
'w_main.WindowBit = D3DFMT_R5G6B5
'On Error Resume Next
w_Running = w_main.createDxMedia(dx, D3DDev, Form1.hWnd)
uploadSomething
Do While w_Running
FpsFont.AccountBook.DynamicText(0) = FpsFont.FramesCount
Render '//渲染
DoEvents '//释放线程loop...
Loop
Unload Me
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set dx = Nothing
End Sub
Public Sub Render()
Dim hr As Long
hr = D3DDev.TestCooperativeLevel
If hr = D3DERR_DEVICENOTRESET Then
XXWindow.BackBufferWidth = w_main.WindowWidth
XXWindow.BackBufferHeight = w_main.WindowHeight
XXWindow.BackBufferFormat = w_main.WindowBit
XXWindow.BackBufferCount = 1
XXWindow.hDeviceWindow = Form1.hWnd
XXWindow.SwapEffect = D3DSWAPEFFECT_FLIP
XXWindow.EnableAutoDepthStencil = 1
XXWindow.AutoDepthStencilFormat = D3DFMT_D16
'On Error Resume Next
D3DDev.Reset XXWindow
DoEvents
'uploadSomething
End If
'dont bother rendering if we are not ready yet
If hr <> 0 Then Exit Sub
w_Rendering.beginRender
'dx.Device.SetVertexShader FVF_TLVERTEX
w_Rendering.DrawText FpsFont.AccountBook
w_Rendering.drawSprite w_sprite
w_Rendering.endRender
w_text.GetFPS FpsFont
End Sub
Sub uploadSomething()
'********************************************************************************
'下面一大段定义文本的代码 ="=;;
Dim tttt As String
tttt = "wing Dream Engine" & vbCrLf
tttt = tttt & " " & w_main.WindowWidth & " × " & w_main.WindowHeight
If w_main.WindowBit = D3DFMT_R8G8B8 Or w_main.WindowBit = D3DFMT_X8R8G8B8 Or w_main.WindowBit = D3DFMT_A8R8G8B8 Then
tttt = tttt & " 32Bit" & vbCrLf
Else
tttt = tttt & " 16Bit" & vbCrLf
End If
tttt = tttt & " FPS "
Set FpsFont.AccountBook = New WDTextTable 'WDFPSChicker类型要先Set对象
w_text.createTable FpsFont.AccountBook, , , True, Form1, 100, 100, 10, 10, RGB(255, 255, 0), 255, tttt
FpsFont.AccountBook.takeInDynamicText , Len(tttt)
'定义文本到此结束!
'********************************************************************************
w_2DTexture.CreateSprite w_sprite, App.Path & "\forest2.bmp", , , , 200, 50
w_sprite.Zoom = 2
End Sub
'以上是测试用程序的一部分，注意 If hr = D3DERR_DEVICENOTRESET Then 一句后内的代码是后来加上的，实际使用时交由引擎处理 |
|
发表于 2005-9-12 21:00:00
