مرحبا هل هذا الكود صح؟؟(مساعدة) [الأرشيف]

هاني وميثم

12 / 07 / 2006, 02:19 AM

أريد أن أعرف اذا كان صح أم خطأ و اذا كان صح كيف يمكن جعله بين مجسمين و عند الاصطدام لا يدخل المجسمين مع بعضهما

موديل
Option Explicit

Public Dx As New DirectX7
Public Dd As DirectDraw7
Public Primary As DirectDrawSurface7
Public Back_Buffer As DirectDrawSurface7
Public Ddsd As DDSURFACEDESC2

Public D3d As Direct3D7
Public Device As Direct3DDevice7

Dim D3dEnum As Direct3DEnumDevices
Dim Guid As String

Public MatWorld As D3DMATRIX
Public MatView As D3DMATRIX
Public MatProj As D3DMATRIX

Public Const PI As Single = 22 / 7
Public Const Rad As Single = PI / 180

Dim Di As DirectInput
Public Didev As DirectInputDevice
Public DiKey As DIKEYBOARDSTATE
Sub Init_Direct3DIM(Height As Long, Width As Long, Bpp As Long)
Set Dd = Dx.DirectDrawCreate("")
Dd.SetCooperativeLevel Form1.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT
Dd.SetDisplayMode Width, Height, Bpp, 0, DDSDM_DEFAULT
Form1.Show
Ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
Ddsd.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_3DDEVICE Or DDSCAPS_PRIMARYSURFACE
Ddsd.lBackBufferCount = 1
Set Primary = Dd.CreateSurface(Ddsd)
Ddsd.ddsCaps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_3DDEVICE
Set Back_Buffer = Primary.GetAttachedSurface(Ddsd.ddsCaps)

Set D3d = Dd.GetDirect3D
Set D3dEnum = D3d.GetDevicesEnum
Guid = D3dEnum.GetGuid(D3dEnum.GetCount)

Set Device = D3d.CreateDevice(Guid, Back_Buffer)

Dim ViewPort As D3DVIEWPORT7
With ViewPort
.lHeight = Height
.lWidth = Width
.lX = 0
.lY = 0
.maxz = 1
.minz = 0
End With
Device.SetViewport ViewPort

Set Di = Dx.DirectInputCreate
Set Didev = Di.CreateDevice("GUID_SYSKEYBOARD")
Didev.SetCooperativeLevel Form1.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
Didev.SetCommonDataFormat DIFORMAT_KEYBOARD
Didev.Acquire
End Sub
Function MakeVector(X As Single, Y As Single, Z As Single) As D3DVECTOR
With MakeVector
.X = X
.Y = Y
.Z = Z
End With
End Function
Function Make3DRect(X1 As Single, X2 As Single, Y1 As Single, Y2 As Single) As D3DRECT
With Make3DRect
.X1 = X1
.X2 = X2
.Y1 = Y1
.Y2 = Y2
End With
End Function

هاني وميثم

12 / 07 / 2006, 02:21 AM

Form load

Option Explicit

Dim Wall(17, 3) As D3DVERTEX

Dim Land(3) As D3DVERTEX

Dim Box(23) As D3DVERTEX

Dim Texture1 As DirectDrawSurface7

Dim Texture2 As DirectDrawSurface7

Dim Texture3 As DirectDrawSurface7

Dim Ddsd2 As DDSURFACEDESC2

Dim Angel As Integer

Dim Pos As D3DVECTOR

Dim Rot As D3DVECTOR

Dim I As Long

Dim Light7 As D3DLIGHT7

Dim LastCheck As Single

Dim Frames As Long

Dim fChange As Long

Private Sub Form_Click()

On Error Resume Next

Set D3d = Nothing

Set Dx = Nothing

Set Device = Nothing

Set Dd = Nothing

Set Texture1 = Nothing

Set Texture2 = Nothing

End

End Sub

Private Sub Form_Load()

Init_Direct3DIM 600, 800, 16

Init_Vertex

CreateTexture

Angel = 270

Rot.X = Cos(Angel * Rad)

Rot.Z = Sin(Angel * Rad)

Pos.X = -4

DrawWall 0, 0, 10, 30, 0, 10, 0, 0, 0, 30, 0, 0, 0, 1

DrawWall 1, 20, 10, 30, 0, 10, 30, 20, 0, 30, 0, 0, 30, 1

DrawWall 2, 20, 10, 180, 20, 10, 30, 20, 0, 180, 20, 0, 30, 2

DrawWall 3, 10, 10, 180, 20, 10, 180, 10, 0, 180, 20, 0, 180, 0.5

DrawWall 4, 10, 10, 110, 10, 10, 180, 10, 0, 110, 10, 0, 180, 1

DrawWall 5, -50, 10, 110, 10, 10, 110, -50, 0, 110, 10, 0, 110, 1

DrawWall 6, -50, 10, 160, -50, 10, 110, -50, 0, 160, -50, 0, 110, 1

DrawWall 7, -120, 10, 160, -50, 10, 160, -120, 0, 160, -50, 0, 160, 1

DrawWall 8, -120, 10, 80, -120, 10, 160, -120, 0, 80, -120, 0, 160, 2

DrawWall 9, -100, 10, 80, -120, 10, 80, -100, 0, 80, -120, 0, 80, 1

DrawWall 10, -100, 10, 20, -100, 10, 80, -100, 0, 20, -100, 0, 80, 1

DrawWall 11, -120, 10, 20, -100, 10, 20, -120, 0, 20, -100, 0, 20, 1

DrawWall 12, -120, 10, 0, -120, 10, 20, -120, 0, 0, -120, 0, 20, 1

DrawWall 13, -50, 10, 0, -120, 10, 0, -50, 0, 0, -120, 0, 0, 1

DrawWall 14, -50, 10, 20, -50, 10, 0, -50, 0, 20, -50, 0, 0, 1

DrawWall 15, -20, 10, 20, -50, 10, 20, -20, 0, 20, -50, 0, 20, 1

DrawWall 16, -20, 10, 0, -20, 10, 20, -20, 0, 0, -20, 0, 20, 1

DrawWall 17, 0, 10, 0, -20, 10, 0, 0, 0, 0, -20, 0, 0, 1

Dx.IdentityMatrix MatWorld

Device.SetTransform D3DTRANSFORMSTATE_WORLD, MatWorld

Dx.ProjectionMatrix MatProj, 1, 150, PI / 2

Device.SetTransform D3DTRANSFORMSTATE_PROJECTION, MatProj

Dx.ViewMatrix MatView, MakeVector(-2, 0, 0), Pos, MakeVector(0, 1, 0), 0

Device.SetTransform D3DTRANSFORMSTATE_VIEW, MatView

Dim Mat7 As D3DMATERIAL7

With Mat7

.Ambient.b = 1: .Ambient.g = 1: .Ambient.r = 1

.diffuse.b = 1: .diffuse.g = 1: .diffuse.r = 1

End With

Device.SetMaterial Mat7

Device.SetRenderState D3DRENDERSTATE_AMBIENT, Dx.CreateColorRGBA(1, 1, 1, 0)

With Light7

.dltType = D3DLIGHT_SPOT

.position = MakeVector(0, 50, 0)

.direction = MakeVector(0, 1, 0)

.attenuation1 = 1

.diffuse.a = 1

.diffuse.r = 1

.diffuse.b = 1

.diffuse.g = 1

.range = 1

End With

'Device.SetLight 0, Light7

'Device.LightEnable 0, True

Device.SetRenderState D3DRENDERSTATE_LIGHTING, 1

Device.SetRenderState D3DRENDERSTATE_SHADEMODE, D3DSHADE_GOURAUD

Dim ClearRect(0 To 0) As D3DRECT

ClearRect(0).X2 = 800

ClearRect(0).Y2 = 600

Back_Buffer.SetForeColor Dx.CreateColorRGB(1, 1, 1)

Dim BoxMat As D3DMATRIX

Dx.IdentityMatrix BoxMat

Dim TempMat As D3DMATRIX

TempMat.rc41 = -50

TempMat.rc42 = 4

TempMat.rc43 = 60

Dim Ang As Integer

Device.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTFG_LINEAR

Device.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTFN_LINEAR

Device.SetRenderState D3DRENDERSTATE_DESTBLEND, D3DBLEND_SRCCOLOR

Device.SetRenderState D3DRENDERSTATE_SRCBLEND, D3DBLEND_ONE

Do

DoEvents

Device.Clear 1, ClearRect, D3DCLEAR_TARGET, 0, 0, 0

Ang = Ang + 1

If Ang = 360 Then Ang = 0

Dx.RotateYMatrix BoxMat, Ang * Rad

Dx.RotateZMatrix TempMat, Ang * Rad

Dx.MatrixMultiply BoxMat, BoxMat, TempMat

BoxMat.rc41 = -50

BoxMat.rc42 = 4

BoxMat.rc43 = 60

Device.BeginScene

Device.SetTransform D3DTRANSFORMSTATE_WORLD, MatWorld

Device.SetTexture 0, Texture1

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Land(0), 4, D3DDP_WAIT

Device.SetTexture 0, Texture2

For I = 0 To 17

DrawVertex I

Next

Device.SetTransform D3DTRANSFORMSTATE_WORLD, BoxMat

Device.SetTexture 0, Texture3

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(0), 4, D3DDP_WAIT

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(4), 4, D3DDP_WAIT

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(8), 4, D3DDP_WAIT

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(12), 4, D3DDP_WAIT

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(16), 4, D3DDP_WAIT

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, Box(20), 4, D3DDP_WAIT

Device.EndScene

Frames = Frames + 1

If Dx.TickCount > LastCheck + 1000 Then

fChange = Frames

LastCheck = Dx.TickCount

Frames = 1

End If

Back_Buffer.DrawText 20, 20, CStr(fChange), False

Primary.Flip Nothing, DDFLIP_WAIT

GetKeys

StopBehindWalls

Loop

End Sub

Sub Init_Vertex()

Dx.CreateD3DVertex -120, 0, 180, 0, 0, -3, 0, 0, Land(0)

Dx.CreateD3DVertex 20, 0, 180, 0, 0, -3, 1, 0, Land(1)

Dx.CreateD3DVertex -120, 0, 0, 0, 0, -3, 0, 1, Land(2)

Dx.CreateD3DVertex 20, 0, 0, 0, 0, -3, 1, 1, Land(3)

Dx.CreateD3DVertex 2, -2, 0, 0, 0, -1, 0, 0, Box(0)

Dx.CreateD3DVertex -2, -2, 0, 0, 0, -1, 1, 0, Box(1)

Dx.CreateD3DVertex 2, 2, 0, 0, 0, -1, 0, 1, Box(2)

Dx.CreateD3DVertex -2, 2, 0, 0, 0, 1, 1, 1, Box(3)

Dx.CreateD3DVertex -2, 2, 5, 0, 0, -1, 0, 0, Box(4)

Dx.CreateD3DVertex 2, 2, 5, 0, 0, -1, 1, 0, Box(5)

Dx.CreateD3DVertex -2, 2, 0, 0, 0, -1, 0, 1, Box(6)

Dx.CreateD3DVertex 2, 2, 0, 0, 0, 1, 1, 1, Box(7)

Dx.CreateD3DVertex 2, 2, 0, 0, 0, -1, 0, 0, Box(8)

Dx.CreateD3DVertex 2, 2, 5, 0, 0, -1, 1, 0, Box(9)

Dx.CreateD3DVertex 2, -2, 0, 0, 0, -1, 0, 1, Box(10)

Dx.CreateD3DVertex 2, -2, 5, 0, 0, 1, 1, 1, Box(11)

Dx.CreateD3DVertex 2, 2, 5, 0, 0, -1, 0, 0, Box(12)

Dx.CreateD3DVertex -2, 2, 5, 0, 0, -1, 1, 0, Box(13)

Dx.CreateD3DVertex 2, -2, 5, 0, 0, -1, 0, 1, Box(14)

Dx.CreateD3DVertex -2, -2, 5, 0, 0, 1, 1, 1, Box(15)

Dx.CreateD3DVertex -2, 2, 5, 0, 0, -1, 0, 0, Box(16)

Dx.CreateD3DVertex -2, 2, 0, 0, 0, -1, 1, 0, Box(17)

Dx.CreateD3DVertex -2, -2, 5, 0, 0, -1, 0, 1, Box(18)

Dx.CreateD3DVertex -2, -2, 0, 0, 0, 1, 1, 1, Box(19)

Dx.CreateD3DVertex -2, -2, 0, 0, 0, -1, 0, 0, Box(20)

Dx.CreateD3DVertex 2, -2, 0, 0, 0, -1, 1, 0, Box(21)

Dx.CreateD3DVertex -2, -2, 5, 0, 0, -1, 0, 1, Box(22)

Dx.CreateD3DVertex 2, -2, 5, 0, 0, 1, 1, 1, Box(23)

End Sub

Sub CreateTexture()

Dim tEnum As Direct3DEnumPixelFormats

Ddsd2.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_PIXELFORMAT Or DDSD_TEXTURESTAGE

Set tEnum = Device.GetTextureFormatsEnum

For I = 1 To tEnum.GetCount

tEnum.GetItem I, Ddsd2.ddpfPixelFormat

If Ddsd2.ddpfPixelFormat.lRGBBitCount = 16 Then Exit For

Next

If Ddsd2.ddpfPixelFormat.lRGBBitCount <> 16 Then End

Ddsd2.ddsCaps.lCaps = DDSCAPS_TEXTURE

Ddsd2.ddsCaps.lCaps2 = DDSCAPS2_TEXTUREMANAGE

Ddsd2.lTextureStage = 0

Set Texture1 = Dd.CreateSurfaceFromFile(App.Path & "\Texture.bmp", Ddsd2)

Set Texture2 = Dd.CreateSurfaceFromFile(App.Path & "\texture1.bmp", Ddsd2)

Set Texture3 = Dd.CreateSurfaceFromFile(App.Path & "\texture3.bmp", Ddsd2)

End Sub

Sub DrawVertex(Index As Long)

Dim TempVertex(3) As D3DVERTEX

TempVertex(0).X = Wall(Index, 0).X

TempVertex(0).Y = Wall(Index, 0).Y

TempVertex(0).Z = Wall(Index, 0).Z

TempVertex(0).nz = Wall(Index, 0).nz

TempVertex(1).X = Wall(Index, 1).X

TempVertex(1).Y = Wall(Index, 1).Y

TempVertex(1).Z = Wall(Index, 1).Z

TempVertex(1).nz = Wall(Index, 1).nz

TempVertex(1).tu = Wall(Index, 1).tu

TempVertex(2).X = Wall(Index, 2).X

TempVertex(2).Y = Wall(Index, 2).Y

TempVertex(2).Z = Wall(Index, 2).Z

TempVertex(2).nz = Wall(Index, 2).nz

TempVertex(2).tv = Wall(Index, 2).tv

TempVertex(3).X = Wall(Index, 3).X

TempVertex(3).Y = Wall(Index, 3).Y

TempVertex(3).Z = Wall(Index, 3).Z

TempVertex(3).nz = Wall(Index, 3).nz

TempVertex(3).tu = Wall(Index, 3).tu

TempVertex(3).tv = Wall(Index, 3).tv

Device.DrawPrimitive D3DPT_TRIANGLESTRIP, D3DFVF_VERTEX, TempVertex(0), 4, D3DDP_WAIT

End Sub

Sub DrawWall(Index As Integer, X1 As Single, Y1 As Single, Z1 As Single, X2 As Single, Y2 As Single, _

Z2 As Single, X3 As Single, Y3 As Single, Z3 As Single, X4 As Single, Y4 As Single, Z4 As Single, C As Single)

Dx.CreateD3DVertex X1, Y1, Z1, 0, 0, -C, 0, 0, Wall(Index, 0)

Dx.CreateD3DVertex X2, Y2, Z2, 0, 0, -C, C, 0, Wall(Index, 1)

Dx.CreateD3DVertex X3, Y3, Z3, 0, 0, -C, 0, C, Wall(Index, 2)

Dx.CreateD3DVertex X4, Y4, Z4, 0, 0, -C, C, C, Wall(Index, 3)

End Sub

Sub GetKeys()

Didev.GetDeviceStateKeyboard DiKey

If DiKey.Key(DIK_LEFT) Then

Angel = Angel + 1

If Angel > 360 Then Angel = 1

Rot.X = Cos(Angel * Rad)

Rot.Z = Sin(Angel * Rad)

End If

If DiKey.Key(DIK_RIGHT) Then

Angel = Angel - 1

If Angel < 0 Then Angel = 359

Rot.X = Cos(Angel * Rad)

Rot.Z = Sin(Angel * Rad)

End If

If DiKey.Key(DIK_UP) Then

Pos.X = Pos.X - (Rot.X * 0.2)

Pos.Z = Pos.Z - (Rot.Z * 0.2)

End If

If DiKey.Key(DIK_DOWN) Then

Pos.X = Pos.X + (Rot.X * 0.2)

Pos.Z = Pos.Z + (Rot.Z * 0.2)

End If

If Not Rot.X = 0 And Not Rot.Z = 0 Then

Dx.ViewMatrix MatView, MakeVector(Pos.X + Rot.X * 2, 2, Pos.Z + Rot.Z * 2), MakeVector(Pos.X, Pos.Y + 2, Pos.Z), MakeVector(0, 1, 0), 0

End If

Light7.dltType = D3DLIGHT_POINT

Light7.position = MakeVector(-50, 5, 100)

Device.SetLight 0, Light7

Device.LightEnable 0, True

Device.SetTransform D3DTRANSFORMSTATE_VIEW, MatView

End Sub

Sub StopBehindWalls()

Dim Place As Long

With Pos

If .X < 0 And .X >= -20 And .Z < 20 And .Z >= 0 Then Place = 1

If .X < -50 And .X >= -120 And .Z < 20 And .Z >= 0 Then Place = 2

If .X < 0 And .X >= -100 And .Z < 30 And .Z >= 20 Then Place = 3

If .X < 20 And .X >= -100 And .Z < 80 And .Z >= 30 Then Place = 4

If .X < 20 And .X >= -120 And .Z < 110 And .Z >= 80 Then Place = 5

If .X < -50 And .X >= -120 And .Z < 160 And .Z >= 110 Then Place = 6

If .X < 20 And .X >= 10 And .Z < 180 And .Z >= 110 Then Place = 7

Select Case Place

Case Is = 1:

If .X > -2 Then .X = -2

If .X < -18 Then .X = -18

If .Z < 2 Then .Z = 2

Case Is = 2:

If .X > -52 Then .X = -52

If .X < -118 Then .X = -118

If .Z < 2 Then .Z = 2

If .X <= -100 And .X >= -120 And .Z > 18 Then .Z = 18

Case Is = 3:

If .X > -2 Then .X = -2

If .X < -98 Then .X = -98

If .X <= -20 And .X >= -50 And .Z <= 22 Then .Z = 22

Case Is = 4:

If .X > 18 Then .X = 18

If .X < -98 Then .X = -98

If .X <= 20 And .X >= 0 And .Z < 32 Then .Z = 32

Case Is = 5

If .X > 18 Then .X = 18

If .X < -118 Then .X = -118

If .X <= -100 And .X >= -120 And .Z < 82 Then .Z = 82

Case Is = 6

If .X > -52 Then .X = -52

If .X < -118 Then .X = -118

If .Z > 158 Then .Z = 158

Case Is = 7

If .X > 18 Then .X = 18

If .X < 12 Then .X = 12

If .Z > 178 Then .Z = 178

End Select

End With

End Sub

هذه الفكرة ابسط من ناحية التصادم