|
PrivateSub Form_Load()
Me.Show
InitDDraw
InitD3D
Dim rd As Single
MaxPolys = 300
For n = 0 To MaxPolys - 3 Step 3
rd = rd + PI * 2 / (MaxPolys / 3)
DX.CreateD3DVertex 0, 0, 10, 0, 0, 0, 0, 0, Vertex(n)
DX.CreateD3DVertex Sin(rd) * 10, Cos(rd) * 10 _
, 0, 0, 0, 0, 0, 0, Vertex(n + 1)
DX.CreateD3DVertex Sin(rd + PI * 2 / (MaxPolys / 3)) * 10 _
, Cos(rd + PI * 2 / (MaxPolys / 3)) * 10 _
, 0, 0, 0, 0, 0, 0, Vertex(n + 2)
Next n
Do
Paintgame
DoEvents
Loop Until Quit = True
DD.SetCooperativeLevel Form1.hWnd, DDSCL_NORMAL
DD.RestoreDisplayMode
Set DD = Nothing
Set D3DDevice = Nothing
Set DX = Nothing
End
End Sub
Private Sub InitDDraw()
Set DX = New DirectX7
Set DD = DX.DirectDrawCreate("")
DD.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or _
DDSCL_EXCLUSIVE
DD.SetDisplayMode 1024, 768, 16, 0, DDSDM_DEFAULT
PrimaryBuffer.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
PrimaryBuffer.ddsCaps.lCaps = DDSCAPS_COMPLEX Or _
DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or _
DDSCAPS_VIDEOMEMORY Or DDSCAPS_3DDEVICE
PrimaryBuffer.lBackBufferCount = 1
Set Primary = DD.CreateSurface(PrimaryBuffer)
Dim Caps As DDSCAPS2
Caps.lCaps = DDSCAPS_BACKBUFFER
Set BackBuffer = Primary.GetAttachedSurface(Caps)
BackBuffer.SetForeColor RGB(255, 255, 255)
End Sub
Private Sub InitD3D()
Set D3D = DD.GetDirect3D
Set D3DDevice = D3D.CreateDevice("IID_IDirect3DHALDevice", _
BackBuffer)
Set GetZBuffer = D3D.GetEnumZBufferFormats _
("IID_IDirect3DHALDevice")
For i = 1 To GetZBuffer.GetCount()
Call GetZBuffer.GetItem(i, PixFMTZBuffer)
If PixFMTZBuffer.lFlags = DDPF_ZBUFFER Then Exit For
Next
PrimaryZBuffer.lFlags = DDSD_CAPS Or DDSD_WIDTH Or _
DDSD_HEIGHT Or DDSD_PIXELFORMAT
PrimaryZBuffer.ddsCaps.lCaps = DDSCAPS_ZBUFFER
PrimaryZBuffer.lWidth = 1024
PrimaryZBuffer.lHeight = 768
PrimaryZBuffer.ddpfPixelFormat = PixFMTZBuffer
Set ZBuffer = DD.CreateSurface(PrimaryZBuffer)
BackBuffer.AddAttachedSurface ZBuffer
D3DDevice.SetRenderState D3DRENDERSTATE_ZENABLE, 2
ViewPort.lX = 0
ViewPort.lY = 0
ViewPort.lWidth = 1024
ViewPort.lHeight = 768
D3DDevice.SetViewport ViewPort
With RectViewport(0)
.X1 = 0
.Y1 = 0
.X2 = 1024
.Y2 = 768
End With
DX.IdentityMatrix matView
Call DX.ViewMatrix(matView, Vector(0, 0, -15), Vector(0, 0, 0), _
Vector(0, 1, 0), 0)
D3DDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matView
DX.IdentityMatrix matProj
Call DX.ProjectionMatrix(matProj, 1, 1000, PI / 2)
D3DDevice.SetTransform D3DTRANSFORMSTATE_PROJECTION, matProj
D3DDevice.SetRenderTarget BackBuffer
D3DDevice.SetRenderState D3DRENDERSTATE_CULLMODE, D3DCULL_NONE
D3DDevice.SetRenderState D3DRENDERSTATE_FILLMODE, 3
Material.diffuse.r = 1
Material.diffuse.g = 1
Material.diffuse.b = 1
Material.diffuse.a = 1
Material.Ambient.r = 1
Material.Ambient.g = 1
Material.Ambient.b = 1
Material.Ambient.a = 1
Material.specular.r = 1
Material.specular.g = 1
Material.specular.b = 1
Material.specular.a = 1
Material.power = 0
D3DDevice.SetMaterial Material
D3DDevice.SetRenderState D3DRENDERSTATE_AMBIENT, RGB(0, 0, 0)
LightColor.r = 1
LightColor.g = 1
LightColor.b = 1
Light.diffuse = LightColor
Light.specular = LightColor
Light.Ambient = LightColor
Light.attenuation1 = 0.3
Light.dltType = D3DLIGHT_POINT
Light.position = Vector(0, 0, -5)
Light.range = 30
D3DDevice.SetLight 0, Light
D3DDevice.LightEnable 0, True
YA = True
PointLight = True
Speed = 0.01
DrawModus = 3
End Sub
Private Function Vector(ByVal a As Double, ByVal b As Double, _
ByVal c As Double) As D3DVECTOR
Dim VecOut As D3DVECTOR
With VecOut
.x = a
.y = b
.z = c
End With
Vector = VecOut
End Function
Public Sub Paintgame()
CalcFPS
Paint3D
BackBuffer.DrawText 10, 10, "FPS: " & FPS, False
BackBuffer.DrawText 10, 30, "Direct 3D", False
BackBuffer.DrawText 10, 60, "Speed (+/-): " & _
Round(1000 * Speed) / 1000, False
BackBuffer.DrawText 10, 80, "DrawModus (SPACE): " & _
DrawModus, False
If PointLight Then BackBuffer.DrawText 10, 100, _
"LichtModus (L): PointLight", False
If Not PointLight Then BackBuffer.DrawText 10, 100, _
"LichtModus (L): AmbientLight", False
BackBuffer.DrawText 10, 720, "Tasten 'x','y','z'", False
BackBuffer.DrawText 10, 740, _
"Rotation um Achse: , ,", False
If XA Then BackBuffer.DrawText 145, 740, "X", False
If YA Then BackBuffer.DrawText 170, 740, "Y", False
If ZA Then BackBuffer.DrawText 195, 740, "Z", False
Primary.Flip Nothing, DDFLIP_WAIT
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Quit = True
If KeyCode = vbKeyX Then XA = Not XA
If KeyCode = vbKeyY Then YA = Not YA
If KeyCode = vbKeyZ Then ZA = Not ZA
If KeyCode = vbKeyL Then PointLight = Not PointLight
If KeyCode = vbKeyAdd Then Speed = Speed + 0.001
If KeyCode = vbKeySubtract Then Speed = Speed - 0.001
If KeyCode = vbKeySpace Then DrawModus = DrawModus + 1
If DrawModus = 4 Then DrawModus = 2
End Sub
|
|