*AM@NDA*
29th March 2010, 12:11 PM
خب اول از منوي پروژه تو وي بي ريفرنس رو انتخاب كنيد در ليست باز شده تيكDirectX8 For VisoualBasic Librery رو بزنيد تا كتابخونش به پروژتون اضافهبشه .
بعد از منوي پروژه Add Module رو بزنيد تا يه انبار كد يا ماژول به پروژتون اضافه بشه از اين ماژولها برا اين استفاده مي كنن كه
اولآ متغير و يا تابعي كه داخل ماژول نوشته بشه از داخل همه ي فرمها قابلدسترسي و صدا زدنه چون متغيير هاي سطح ماژول بر خلاف فرم به صورت پيش فرضPublic هستند
خب داخل ماژول يه ديتا تايپ براي ذخيره سازي اطلاعات تك تك نقطه ها تعريف مي كنيم
Private Type LITVERTEX
x As Single
y As Single
z As Single
color As Long
specular As Long
tu As Single
tv As Single
End Type
سه تا متغيير آخر كه اسمشون عجيب قريبه هميشه با صفر مقدار دهي مي شن من هم نمي دونم برا چيه ان! سه تاي اول موقعيت نقطه و بعدي رنگ
بعد يه ثابت براي اعلان اين ديتا تايپ به دايركت ايكس تعريف مي كنيم اينثابت فرمت ديتا تايپي كه تعريف كرده ايم را در خود نگه مي دارد.
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
Global Const Pi = 3.14159265358979
ثابت پي هم كه براي محاسبه زاويه اي بكار مي رود –چرخش دوربين
بعد يه آرايه به تعداد نقطه هايي (ورتكس هايي)كه مي خوايم رسم كنيم تعريف مي كنيم
Public cube(35) As LITVERTEX
Public matworld As D3DMATRIX
Public matview As D3DMATRIX
Public matproj As D3DMATRIX
چون ما مي خوايم يه مكعب مربع رسم كنيم به 36 نقطه نياز داريم كه با آرايهبالا اونو تعريف مي كنيم در سه خط بعد سه تا ماتريس تعريف كرديم كه كلخصوصيات نقاط ما رو داخل خودشون نگه مي دارن كاربرد اونا اينه كه برايتابع چرخش فرستاده مي شن و كل اونا رو دايركت ايكس يه جا مي چرخونه و ديگهنياز به چرخش تك تك اونها نيست
ماتريس اول چگونگي قرار گرفتن نقطه ها در فضاي سه بعدي رو نشون مي دن
دومين ماتريس نشان مي دهد دور بين در كجا قرار دارد
وآخرين ماتريس نشان مي دهد كه دوربين چگونه به صحنه نگاه مي كند
بعد متغيير هاي سراسري سطح ماژول رو كد نويسي مي كنيم توجه كنيد تمام كدهاي بالا واين كدها داخل ماژول نوشته مي شن
Public Dx As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public DispMode As D3DDISPLAYMODE
Public InitG As Boolean
Public D3Dwindow As D3DPRESENT_PARAMETERS
Public D3DX As D3DX8
Public VBuffer As Direct3DVertexBuffer8
دي ايكس بزرگترين كلاس دايركت ايكس است كه كلاس هاي دايركت ايكس را مديريت مي كند.
كلاس دي تري دي براي ايجاد ابزار سه بعدي سازي استفاده مي شه.
كلاس D3dDevice براي مديريت ابزار ساخته شده و اجزاي آن استفاده مي شه.
كلاس DispMode براي گرفتن موقعيت و خصوصيات كنوني صفحه نمايش شما بكار مي رود.
متغير InitG براي گرفتن مقدار برگشتي تابع InitialiseGeometry كه بعدآ تعريف خواهد شد بكار مي رود.
كلاس D3Dwindow مستقيمآ با پنجره نمايش ما كار مي كند وبراي تظيم خصوصيات آن از اين كلاس استفاده مي شود.
كلاس D3DX براي ايجاد يك بافت و بارگزاري فايل دات ايكس كه فايل حاويمختصاي نقاط ومشخصات يك شي سه بعدي مي باشد(فايل هاي خروجي 3DSMAX با يكبرنامه به اين نوع فايل تبديل مي شوند و داخل دايركت ايكس باز ميشوند)بكار مي رود مثلآ اگر بخواهيد روي يك ديوار يك عكس بيندازيد بايد بااين كلاس آن را بارگذاري كنيد وبا كلاس D3DMaterial8 آن را به ديواربيندازيد. صرفآ در اين پروژه نيازي به اين كلاس نيست و من اون رو همينجوريتعريف كردم!.
كلاس vBuffer براي ايجاد بافر نگه دارنده كل نقاط و تصوير سه بعدي ما استفاده مي شود
حالا شروع به نوشتن تابع initialise مي كنيم اين تابع در اكثر پروژه هايسه بعدي هست و وظيفه اش بارگزاري و مقداردهي اوليه كلاسها و متغيير هاست .
Public Function initialise() As Boolean
Set Dx = New DirectX8 '— ايجاد دوباره كلاس دي ايكس
Set D3D = Dx.Direct3DCreate '— ايجاد كلاس دي تري دي از كلاس دي ايكس
'-- D3DDEVTYPE_REF= رسم نرم افزاري , D3DDEVTYPE_HAL= رسم سخت افزاري
'--ممكن است كارت گرافيك شما آن برد باشد كه بايد از هال استفاده كنيد
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3Dwindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer
Debug.Print "yes"
End If
'— بررسي اينكه آيا سخت افزار ما قادر به رسم نقاط سه بعدي هست يا نه
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
'— گرفتن خصوصيات كنوني تصوير و ريختن آن در ديتاتايپ ديسپ مود
D3Dwindow.Windowed = 1
'— 1 يعني برنامه ما بصورت پنجره ايجاد شود –2=تمام صفحه
D3Dwindow.BackBufferFormat = DispMode.Format
'— خصوصيات صفحه را كه گرفته ايم به دايركت ايكس مي دهيم
'— وبافرنگهدارنده تصوير رابا آن تنظيم مي كنيم
D3Dwindow.SwapEffect = D3DSWAPEFFECT_DISCARD
D3Dwindow.BackBufferCount = 1
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.BackBufferHeight = DispMode.Height
D3Dwindow.BackBufferWidth = DispMode.Width
D3Dwindow.hDeviceWindow = Form1.hWnd
'—D3D ايجاد ابزار سه بعدي سازي با مشخصات مقداردهي شده ي بالا از كلاس
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3Dwindow)
'— مشخص كردن پنجره رسم تصاوير در خط بالا
'— پاك كردن ابزار سه بعدي سازي با رنگ سياه (پارامتر آخر خط پايين)
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0
'— دادن ماتريس تعريف شده به دايركت ايكس
D3DXMatrixIdentity matworld
D3DDevice.SetTransform D3DTS_WORLD, matworld
'— تنظيم ماتريس بعدي تعريف شده براي استفاده در چرخش تصوير
D3DXMatrixLookAtLH matview, MakeV(0, 5, 9), MakeV(0, 0, 0), MakeV(0, 1, 0)
'— تنظيم نماي ديد اوليه به كمك تابع ميك وي كه بعدآ تعريف خواهد شد
D3DDevice.SetTransform D3DTS_VIEW, matview
'— دادن ماتريس سوم به دايركت ايكس براي تنظيم نماي ديد
D3DXMatrixPerspectiveFovLH matproj, Pi / 4, 1, 0.1, 500
'— تنظيم نماي پرسپكتيو با استفاده از عدد پي
D3DDevice.SetTransform D3DTS_PROJECTION, matproj
'— تنظيم نوع انتقال و جابجايي در محيط سه بعدي
D3DDevice.SetVertexShader Lit_FVF
'— تنظيم سيستم سايه زني با ديتا تايپي كه تعريف كرده ايم
D3DDevice.SetRenderState D3DRS_LIGHTING, False
'— سيستم نور پردازي را براي محاسبات راحت تر وساده تر غير فعال مي كنيم
InitG = InitialiseGeometry
'— تابع بالا را براي مقدار دهي نقطه ها صدا مي زنيم اگر نتيجه
'-- اين تابع نادرست باشد مقداردهي انجام نشده است
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(cube(0)) * 36, 0, Lit_FVF, D3DPOOL_DEFAULT)
'— ايجاد بافر با طول آرايه اي كه تعريف كرده ايم
D3DVertexBuffer8SetData VBuffer, 0, Len(cube(0)) * 36, 0, cube(0)
'— ريختن آرايه درون بافر
If initGt = True Then Initialize = True
'— درصورتي كه مقدار برگشتي تابع اي كه صدا زديم درست باشد خروجي اين تابع هم درست است
Debug.Print InitG
End Function
خب خسته نباشيد حالا دو تابعي كه در بالا صدا زديم و گفتيم بعدآ تعريف ميكنيم را مي نويسيم تابع MakV براي تبديل پامتر هاي عددي به ساختارD3DVECTOR كه ديتا تايپ استاندارد دايركت ايكس است
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR
MakeV.x = x
MakeV.y = y
MakeV.z = z
End Function
بعدي تابع رسم مقدار دهي نقطه ها در فضاي سه بعدي است يعني تابع InitialiseGeometry
Private Function InitialiseGeometry() As Boolean
On Error GoTo BOut:
Dim color&, DFC!
'— تنظيم رنگ نقاط در اينجا رنگ آبي
color = RGB(200, 100, 0): DFC = 1
'Front
cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0)
cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0)
cube(2) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0)
'Back
cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0)
cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0)
'Right
cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0)
cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0)
'Left
cube(1http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0)
cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0)
cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0)
'Top
cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0)
cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0)
cube(27) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0)
'Bottom
cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0)
cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0)
InitialiseGeometry = True
Exit Function
BOut:
InitialiseGeometry = False
End Function
تابعي كه داخل اين تابع صدا زده شده تابع CreateLitVertex هست كه مشخصاتنقطه رو به فرمت استاندارد LITVERTEX تبديل مي كنه .متن اين تابع:
Private Function CreateLitVertex(x As Single, y As Single, z As Single,color As Long, specular As Long, tu As Single, tv As Single) AsLITVERTEX
CreateLitVertex.x = x
CreateLitVertex.y = y
CreateLitVertex.z = z
CreateLitVertex.color = color
CreateLitVertex.specular = specular
CreateLitVertex.tu = tu
CreateLitVertex.tv = tv
End Function
و تابع اصلي رسم نقاط در فضاي سه بعدي كه در تمامي پروژه هاي سه بعدي اسم اون Render هست.
Public Sub Render()
'— پاك كردن تصوير قبلي رسم شده با رنگ سياه
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
'— شروع رسم تصوير سه بعدي
D3DDevice.BeginScene
'— دادن بافر حاوي نقطه هاي سه بعدي به تابع رسم كننده
D3DDevice.SetStreamSource 0, VBuffer, Len(cube(0))
'— رسم نقاط به صورت مثلثي
'-- D3DPT_LINELIST رسم خطي
'-- D3DPT_LINESTRIP رسم خط چسبيده
'-- D3DPT_POINTLIST رسم نقطه اي
'-- D3DPT_TRIANGLEFAN رسم مثلثي
'--D3DPT_TRIANGLELIST رسم مثلث چسبيده
'-- D3DPT_TRIANGLESTRIP رسم درهم بافته
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
'— پايان رسم تصوير سه بعدي
D3DDevice.EndScene
'-- تثبيت نقاطه رسم شده
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
خب كد نويسي بخش ماژول تموم شد حالا فرم رو بازكنيد و خط اول كد هاش متغيير زير رو تعريف كنيد
Dim Er As Boolean
بعد در كد Form_KeyDown كد زير را به اينصورت بنويسيد كه كل دستو به اين شكل مي باشد
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Er = True
End Sub
با اين دستور وقتي كاربر كليدي را يزند ير نامه تمام مي شود
حالا كد مربوط به فرم لود كه بايد توابعي را كه در ماژول تعريف كرديم راداخل يك حلقه بي پايان صدا بزنيم .روي فرم دابل كليك كرده كد زير رابنويسيد
Private Sub Form_Load()
Debug.Print "Start"
Me.Show
Dim RotateAngle As Single'— براي ذخيره ميزان چرخش
Dim matTemp As D3DMATRIX '//To hold temporary
Call initialise'— صدا زدن تابع براي مقدار دهي اوليه نقاط وايجاد وتنظيم پارامترها
While Er = False'— شروع حلقه بي پايان
RotateAngle = RotateAngle + 0.1'— يك درجه به چرخش اضافه كن
If RotateAngle >= 360 Then RotateAngle = RotateAngle – 360'— اگر يك دور كامل شد برگرد
D3DXMatrixIdentity matworld '//Reset our world matrix— تنظيم ماتريس نقاط با چرخش
D3DXMatrixIdentity matTemp'— تنظيم محل دوربين با چرخش
D3DXMatrixRotationX matTemp, RotateAngle * (Pi / 180)'— گردش افقي دوربين
D3DXMatrixMultiply matworld, matworld, matTemp '— دادن سه ماترس مزكور به دايركت ايكس
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (Pi / 180)'— گردش عمقي دوربين
D3DXMatrixMultiply matworld, matworld, matTemp'— دادن سه ماترس مزكور به دايركت ايكس
D3DDevice.SetTransform D3DTS_WORLD, matworld'— تنظيم محل ديد دوربين
Render'— صدا زدن تابع اصلي رسم
DoEvents'— همه دستورات را دوباره بررسي كن (داخل حلقه هنك نكن!!)
Wend'— پايان حلقه بي پايان
End'— بستن برنامه
End Sub
دستور End رو داخل Form_Unload هم مي نويسيم كه برنامه بازدن دكمه كلوز خطا نده
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
خب چيزي نموند كه توضيح نداده باشيم
براي اينكه برنامه شما رو كامل كرده باشم اگه جايي اشتباه تايپي باشه ياغيره كد كامل برنامه رو هم گزاشتم كه مي تونيد از داخل گوني زير برشداريد.!
كدماژول اول
'* CopyRight :تنها کاربران عضو سايت قادر به مشاهده لينک ها هستند.
عضويت در سايت (http://www.hotcloob.com/modules.php?name=Your_Account&op=new_user) / ورود به سايت (http://www.hotcloob.com/modules.php?name=Your_Account&redirect=index)
'* By:NasserNiazy 2008,Tel:09189151266
'Sabzha baraye 2body Hats!
'Const FVF = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
'Private Type TLVERTEX
' x As Single
' y As Single
' z As Single
' rhw As Single
' color As Long
' specular As Long
' tu As Single
' tv As Single
'End Type
'-------------
Private Type LITVERTEX
x As Single
y As Single
z As Single
color As Long
specular As Long
tu As Single
tv As Single
End Type
'----------
Global Const Pi = 3.14159265358979
Public matworld As D3DMATRIX
Public matview As D3DMATRIX
Public matproj As D3DMATRIX
'Public TriStrip(0 To 3) As TLVERTEX
Public cube(35) As LITVERTEX
Public Dx As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public DispMode As D3DDISPLAYMODE
Public InitG As Boolean
Public D3Dwindow As D3DPRESENT_PARAMETERS
Public D3DX As D3DX8
'Public Texture As Direct3DTexture8
Public VBuffer As Direct3DVertexBuffer8
'____________________
Public Function initialise() As Boolean
Set Dx = New DirectX8
Set D3D = Dx.Direct3DCreate
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3Dwindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer
Debug.Print "yes"
End If
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
D3Dwindow.Windowed = 1
'D3Dwindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.SwapEffect = D3DSWAPEFFECT_DISCARD
D3Dwindow.BackBufferCount = 1
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.BackBufferHeight = DispMode.Height
D3Dwindow.BackBufferWidth = DispMode.Width
D3Dwindow.hDeviceWindow = Form1.hWnd
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3Dwindow)
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0
D3DXMatrixIdentity matworld
D3DDevice.SetTransform D3DTS_WORLD, matworld
D3DXMatrixLookAtLH matview, MakeV(0, 5, 9), MakeV(0, 0, 0), MakeV(0, 1, 0)
D3DDevice.SetTransform D3DTS_VIEW, matview
D3DXMatrixPerspectiveFovLH matproj, Pi / 4, 1, 0.1, 500
D3DDevice.SetTransform D3DTS_PROJECTION, matproj
'Set Texture=D3DX8.CreateTextureFromFile(D3DDevice,app. path & yourfilename)
D3DDevice.SetVertexShader Lit_FVF
'D3DDevice.SetVertexShader FVF
D3DDevice.SetRenderState D3DRS_LIGHTING, False
InitG = InitialiseGeometry
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(cube(0)) _
* 36, 0, Lit_FVF, D3DPOOL_DEFAULT)
D3DVertexBuffer8SetData VBuffer, 0, Len(cube(0)) * 36, 0, cube(0)
If initGt = True Then Initialize = True
Debug.Print InitG
End Function
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR
MakeV.x = x
MakeV.y = y
MakeV.z = z
End Function
'____________________
Private Function InitialiseGeometry() As Boolean
On Error GoTo BOut:
Dim color&, DFC!
color = RGB(200, 100, 0): DFC = 1
'Front
cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0)
cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0)
cube(2) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0)
'Back
cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0)
cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0)
'Right
cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0)
cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0)
'Left
cube(1http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0)
cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0)
cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0)
'Top
cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0)
cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0)
cube(27) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0)
'Bottom
cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0)
cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0)
InitialiseGeometry = True
Exit Function
BOut:
InitialiseGeometry = False
End Function
'____________________
Private Function CreateLitVertex(x As Single, y As Single, z As Single, _
color As Long, specular As Long, tu As Single, tv As Single) As LITVERTEX
CreateLitVertex.x = x
CreateLitVertex.y = y
CreateLitVertex.z = z
CreateLitVertex.color = color
CreateLitVertex.specular = specular
CreateLitVertex.tu = tu
CreateLitVertex.tv = tv
End Function
'____________________
Public Sub Render()
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(cube(0))
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
'D3DDevice.SetTexture 0,Texture
'D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, TriStrip(0), Len(TriStrip(0))
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
کد فرم
Dim Er As Boolean
'____________________
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Er = True
End Sub
'____________________
Private Sub Form_Load()
Debug.Print "Start"
Me.Show
'While Er = False
'Render
'DoEvents
'Wend
Dim RotateAngle As Single
Dim matTemp As D3DMATRIX '//To hold temporary
Call initialise
While Er = False
RotateAngle = RotateAngle + 0.1
If RotateAngle >= 360 Then RotateAngle = RotateAngle - 360
D3DXMatrixIdentity matworld '//Reset our world matrix
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, RotateAngle * (Pi / 180)
D3DXMatrixMultiply matworld, matworld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (Pi / 180)
D3DXMatrixMultiply matworld, matworld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matworld
Render
DoEvents
Wend
End
End Sub
'____________________
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
بعد از منوي پروژه Add Module رو بزنيد تا يه انبار كد يا ماژول به پروژتون اضافه بشه از اين ماژولها برا اين استفاده مي كنن كه
اولآ متغير و يا تابعي كه داخل ماژول نوشته بشه از داخل همه ي فرمها قابلدسترسي و صدا زدنه چون متغيير هاي سطح ماژول بر خلاف فرم به صورت پيش فرضPublic هستند
خب داخل ماژول يه ديتا تايپ براي ذخيره سازي اطلاعات تك تك نقطه ها تعريف مي كنيم
Private Type LITVERTEX
x As Single
y As Single
z As Single
color As Long
specular As Long
tu As Single
tv As Single
End Type
سه تا متغيير آخر كه اسمشون عجيب قريبه هميشه با صفر مقدار دهي مي شن من هم نمي دونم برا چيه ان! سه تاي اول موقعيت نقطه و بعدي رنگ
بعد يه ثابت براي اعلان اين ديتا تايپ به دايركت ايكس تعريف مي كنيم اينثابت فرمت ديتا تايپي كه تعريف كرده ايم را در خود نگه مي دارد.
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
Global Const Pi = 3.14159265358979
ثابت پي هم كه براي محاسبه زاويه اي بكار مي رود –چرخش دوربين
بعد يه آرايه به تعداد نقطه هايي (ورتكس هايي)كه مي خوايم رسم كنيم تعريف مي كنيم
Public cube(35) As LITVERTEX
Public matworld As D3DMATRIX
Public matview As D3DMATRIX
Public matproj As D3DMATRIX
چون ما مي خوايم يه مكعب مربع رسم كنيم به 36 نقطه نياز داريم كه با آرايهبالا اونو تعريف مي كنيم در سه خط بعد سه تا ماتريس تعريف كرديم كه كلخصوصيات نقاط ما رو داخل خودشون نگه مي دارن كاربرد اونا اينه كه برايتابع چرخش فرستاده مي شن و كل اونا رو دايركت ايكس يه جا مي چرخونه و ديگهنياز به چرخش تك تك اونها نيست
ماتريس اول چگونگي قرار گرفتن نقطه ها در فضاي سه بعدي رو نشون مي دن
دومين ماتريس نشان مي دهد دور بين در كجا قرار دارد
وآخرين ماتريس نشان مي دهد كه دوربين چگونه به صحنه نگاه مي كند
بعد متغيير هاي سراسري سطح ماژول رو كد نويسي مي كنيم توجه كنيد تمام كدهاي بالا واين كدها داخل ماژول نوشته مي شن
Public Dx As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public DispMode As D3DDISPLAYMODE
Public InitG As Boolean
Public D3Dwindow As D3DPRESENT_PARAMETERS
Public D3DX As D3DX8
Public VBuffer As Direct3DVertexBuffer8
دي ايكس بزرگترين كلاس دايركت ايكس است كه كلاس هاي دايركت ايكس را مديريت مي كند.
كلاس دي تري دي براي ايجاد ابزار سه بعدي سازي استفاده مي شه.
كلاس D3dDevice براي مديريت ابزار ساخته شده و اجزاي آن استفاده مي شه.
كلاس DispMode براي گرفتن موقعيت و خصوصيات كنوني صفحه نمايش شما بكار مي رود.
متغير InitG براي گرفتن مقدار برگشتي تابع InitialiseGeometry كه بعدآ تعريف خواهد شد بكار مي رود.
كلاس D3Dwindow مستقيمآ با پنجره نمايش ما كار مي كند وبراي تظيم خصوصيات آن از اين كلاس استفاده مي شود.
كلاس D3DX براي ايجاد يك بافت و بارگزاري فايل دات ايكس كه فايل حاويمختصاي نقاط ومشخصات يك شي سه بعدي مي باشد(فايل هاي خروجي 3DSMAX با يكبرنامه به اين نوع فايل تبديل مي شوند و داخل دايركت ايكس باز ميشوند)بكار مي رود مثلآ اگر بخواهيد روي يك ديوار يك عكس بيندازيد بايد بااين كلاس آن را بارگذاري كنيد وبا كلاس D3DMaterial8 آن را به ديواربيندازيد. صرفآ در اين پروژه نيازي به اين كلاس نيست و من اون رو همينجوريتعريف كردم!.
كلاس vBuffer براي ايجاد بافر نگه دارنده كل نقاط و تصوير سه بعدي ما استفاده مي شود
حالا شروع به نوشتن تابع initialise مي كنيم اين تابع در اكثر پروژه هايسه بعدي هست و وظيفه اش بارگزاري و مقداردهي اوليه كلاسها و متغيير هاست .
Public Function initialise() As Boolean
Set Dx = New DirectX8 '— ايجاد دوباره كلاس دي ايكس
Set D3D = Dx.Direct3DCreate '— ايجاد كلاس دي تري دي از كلاس دي ايكس
'-- D3DDEVTYPE_REF= رسم نرم افزاري , D3DDEVTYPE_HAL= رسم سخت افزاري
'--ممكن است كارت گرافيك شما آن برد باشد كه بايد از هال استفاده كنيد
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3Dwindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer
Debug.Print "yes"
End If
'— بررسي اينكه آيا سخت افزار ما قادر به رسم نقاط سه بعدي هست يا نه
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
'— گرفتن خصوصيات كنوني تصوير و ريختن آن در ديتاتايپ ديسپ مود
D3Dwindow.Windowed = 1
'— 1 يعني برنامه ما بصورت پنجره ايجاد شود –2=تمام صفحه
D3Dwindow.BackBufferFormat = DispMode.Format
'— خصوصيات صفحه را كه گرفته ايم به دايركت ايكس مي دهيم
'— وبافرنگهدارنده تصوير رابا آن تنظيم مي كنيم
D3Dwindow.SwapEffect = D3DSWAPEFFECT_DISCARD
D3Dwindow.BackBufferCount = 1
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.BackBufferHeight = DispMode.Height
D3Dwindow.BackBufferWidth = DispMode.Width
D3Dwindow.hDeviceWindow = Form1.hWnd
'—D3D ايجاد ابزار سه بعدي سازي با مشخصات مقداردهي شده ي بالا از كلاس
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3Dwindow)
'— مشخص كردن پنجره رسم تصاوير در خط بالا
'— پاك كردن ابزار سه بعدي سازي با رنگ سياه (پارامتر آخر خط پايين)
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0
'— دادن ماتريس تعريف شده به دايركت ايكس
D3DXMatrixIdentity matworld
D3DDevice.SetTransform D3DTS_WORLD, matworld
'— تنظيم ماتريس بعدي تعريف شده براي استفاده در چرخش تصوير
D3DXMatrixLookAtLH matview, MakeV(0, 5, 9), MakeV(0, 0, 0), MakeV(0, 1, 0)
'— تنظيم نماي ديد اوليه به كمك تابع ميك وي كه بعدآ تعريف خواهد شد
D3DDevice.SetTransform D3DTS_VIEW, matview
'— دادن ماتريس سوم به دايركت ايكس براي تنظيم نماي ديد
D3DXMatrixPerspectiveFovLH matproj, Pi / 4, 1, 0.1, 500
'— تنظيم نماي پرسپكتيو با استفاده از عدد پي
D3DDevice.SetTransform D3DTS_PROJECTION, matproj
'— تنظيم نوع انتقال و جابجايي در محيط سه بعدي
D3DDevice.SetVertexShader Lit_FVF
'— تنظيم سيستم سايه زني با ديتا تايپي كه تعريف كرده ايم
D3DDevice.SetRenderState D3DRS_LIGHTING, False
'— سيستم نور پردازي را براي محاسبات راحت تر وساده تر غير فعال مي كنيم
InitG = InitialiseGeometry
'— تابع بالا را براي مقدار دهي نقطه ها صدا مي زنيم اگر نتيجه
'-- اين تابع نادرست باشد مقداردهي انجام نشده است
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(cube(0)) * 36, 0, Lit_FVF, D3DPOOL_DEFAULT)
'— ايجاد بافر با طول آرايه اي كه تعريف كرده ايم
D3DVertexBuffer8SetData VBuffer, 0, Len(cube(0)) * 36, 0, cube(0)
'— ريختن آرايه درون بافر
If initGt = True Then Initialize = True
'— درصورتي كه مقدار برگشتي تابع اي كه صدا زديم درست باشد خروجي اين تابع هم درست است
Debug.Print InitG
End Function
خب خسته نباشيد حالا دو تابعي كه در بالا صدا زديم و گفتيم بعدآ تعريف ميكنيم را مي نويسيم تابع MakV براي تبديل پامتر هاي عددي به ساختارD3DVECTOR كه ديتا تايپ استاندارد دايركت ايكس است
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR
MakeV.x = x
MakeV.y = y
MakeV.z = z
End Function
بعدي تابع رسم مقدار دهي نقطه ها در فضاي سه بعدي است يعني تابع InitialiseGeometry
Private Function InitialiseGeometry() As Boolean
On Error GoTo BOut:
Dim color&, DFC!
'— تنظيم رنگ نقاط در اينجا رنگ آبي
color = RGB(200, 100, 0): DFC = 1
'Front
cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0)
cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0)
cube(2) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0)
'Back
cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0)
cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0)
'Right
cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0)
cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0)
'Left
cube(1http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0)
cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0)
cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0)
'Top
cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0)
cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0)
cube(27) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0)
'Bottom
cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0)
cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0)
InitialiseGeometry = True
Exit Function
BOut:
InitialiseGeometry = False
End Function
تابعي كه داخل اين تابع صدا زده شده تابع CreateLitVertex هست كه مشخصاتنقطه رو به فرمت استاندارد LITVERTEX تبديل مي كنه .متن اين تابع:
Private Function CreateLitVertex(x As Single, y As Single, z As Single,color As Long, specular As Long, tu As Single, tv As Single) AsLITVERTEX
CreateLitVertex.x = x
CreateLitVertex.y = y
CreateLitVertex.z = z
CreateLitVertex.color = color
CreateLitVertex.specular = specular
CreateLitVertex.tu = tu
CreateLitVertex.tv = tv
End Function
و تابع اصلي رسم نقاط در فضاي سه بعدي كه در تمامي پروژه هاي سه بعدي اسم اون Render هست.
Public Sub Render()
'— پاك كردن تصوير قبلي رسم شده با رنگ سياه
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
'— شروع رسم تصوير سه بعدي
D3DDevice.BeginScene
'— دادن بافر حاوي نقطه هاي سه بعدي به تابع رسم كننده
D3DDevice.SetStreamSource 0, VBuffer, Len(cube(0))
'— رسم نقاط به صورت مثلثي
'-- D3DPT_LINELIST رسم خطي
'-- D3DPT_LINESTRIP رسم خط چسبيده
'-- D3DPT_POINTLIST رسم نقطه اي
'-- D3DPT_TRIANGLEFAN رسم مثلثي
'--D3DPT_TRIANGLELIST رسم مثلث چسبيده
'-- D3DPT_TRIANGLESTRIP رسم درهم بافته
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
'— پايان رسم تصوير سه بعدي
D3DDevice.EndScene
'-- تثبيت نقاطه رسم شده
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
خب كد نويسي بخش ماژول تموم شد حالا فرم رو بازكنيد و خط اول كد هاش متغيير زير رو تعريف كنيد
Dim Er As Boolean
بعد در كد Form_KeyDown كد زير را به اينصورت بنويسيد كه كل دستو به اين شكل مي باشد
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Er = True
End Sub
با اين دستور وقتي كاربر كليدي را يزند ير نامه تمام مي شود
حالا كد مربوط به فرم لود كه بايد توابعي را كه در ماژول تعريف كرديم راداخل يك حلقه بي پايان صدا بزنيم .روي فرم دابل كليك كرده كد زير رابنويسيد
Private Sub Form_Load()
Debug.Print "Start"
Me.Show
Dim RotateAngle As Single'— براي ذخيره ميزان چرخش
Dim matTemp As D3DMATRIX '//To hold temporary
Call initialise'— صدا زدن تابع براي مقدار دهي اوليه نقاط وايجاد وتنظيم پارامترها
While Er = False'— شروع حلقه بي پايان
RotateAngle = RotateAngle + 0.1'— يك درجه به چرخش اضافه كن
If RotateAngle >= 360 Then RotateAngle = RotateAngle – 360'— اگر يك دور كامل شد برگرد
D3DXMatrixIdentity matworld '//Reset our world matrix— تنظيم ماتريس نقاط با چرخش
D3DXMatrixIdentity matTemp'— تنظيم محل دوربين با چرخش
D3DXMatrixRotationX matTemp, RotateAngle * (Pi / 180)'— گردش افقي دوربين
D3DXMatrixMultiply matworld, matworld, matTemp '— دادن سه ماترس مزكور به دايركت ايكس
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (Pi / 180)'— گردش عمقي دوربين
D3DXMatrixMultiply matworld, matworld, matTemp'— دادن سه ماترس مزكور به دايركت ايكس
D3DDevice.SetTransform D3DTS_WORLD, matworld'— تنظيم محل ديد دوربين
Render'— صدا زدن تابع اصلي رسم
DoEvents'— همه دستورات را دوباره بررسي كن (داخل حلقه هنك نكن!!)
Wend'— پايان حلقه بي پايان
End'— بستن برنامه
End Sub
دستور End رو داخل Form_Unload هم مي نويسيم كه برنامه بازدن دكمه كلوز خطا نده
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
خب چيزي نموند كه توضيح نداده باشيم
براي اينكه برنامه شما رو كامل كرده باشم اگه جايي اشتباه تايپي باشه ياغيره كد كامل برنامه رو هم گزاشتم كه مي تونيد از داخل گوني زير برشداريد.!
كدماژول اول
'* CopyRight :تنها کاربران عضو سايت قادر به مشاهده لينک ها هستند.
عضويت در سايت (http://www.hotcloob.com/modules.php?name=Your_Account&op=new_user) / ورود به سايت (http://www.hotcloob.com/modules.php?name=Your_Account&redirect=index)
'* By:NasserNiazy 2008,Tel:09189151266
'Sabzha baraye 2body Hats!
'Const FVF = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
'Private Type TLVERTEX
' x As Single
' y As Single
' z As Single
' rhw As Single
' color As Long
' specular As Long
' tu As Single
' tv As Single
'End Type
'-------------
Private Type LITVERTEX
x As Single
y As Single
z As Single
color As Long
specular As Long
tu As Single
tv As Single
End Type
'----------
Global Const Pi = 3.14159265358979
Public matworld As D3DMATRIX
Public matview As D3DMATRIX
Public matproj As D3DMATRIX
'Public TriStrip(0 To 3) As TLVERTEX
Public cube(35) As LITVERTEX
Public Dx As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public DispMode As D3DDISPLAYMODE
Public InitG As Boolean
Public D3Dwindow As D3DPRESENT_PARAMETERS
Public D3DX As D3DX8
'Public Texture As Direct3DTexture8
Public VBuffer As Direct3DVertexBuffer8
'____________________
Public Function initialise() As Boolean
Set Dx = New DirectX8
Set D3D = Dx.Direct3DCreate
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3Dwindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer
Debug.Print "yes"
End If
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
D3Dwindow.Windowed = 1
'D3Dwindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.SwapEffect = D3DSWAPEFFECT_DISCARD
D3Dwindow.BackBufferCount = 1
D3Dwindow.BackBufferFormat = DispMode.Format
D3Dwindow.BackBufferHeight = DispMode.Height
D3Dwindow.BackBufferWidth = DispMode.Width
D3Dwindow.hDeviceWindow = Form1.hWnd
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _
Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3Dwindow)
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0
D3DXMatrixIdentity matworld
D3DDevice.SetTransform D3DTS_WORLD, matworld
D3DXMatrixLookAtLH matview, MakeV(0, 5, 9), MakeV(0, 0, 0), MakeV(0, 1, 0)
D3DDevice.SetTransform D3DTS_VIEW, matview
D3DXMatrixPerspectiveFovLH matproj, Pi / 4, 1, 0.1, 500
D3DDevice.SetTransform D3DTS_PROJECTION, matproj
'Set Texture=D3DX8.CreateTextureFromFile(D3DDevice,app. path & yourfilename)
D3DDevice.SetVertexShader Lit_FVF
'D3DDevice.SetVertexShader FVF
D3DDevice.SetRenderState D3DRS_LIGHTING, False
InitG = InitialiseGeometry
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(cube(0)) _
* 36, 0, Lit_FVF, D3DPOOL_DEFAULT)
D3DVertexBuffer8SetData VBuffer, 0, Len(cube(0)) * 36, 0, cube(0)
If initGt = True Then Initialize = True
Debug.Print InitG
End Function
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR
MakeV.x = x
MakeV.y = y
MakeV.z = z
End Function
'____________________
Private Function InitialiseGeometry() As Boolean
On Error GoTo BOut:
Dim color&, DFC!
color = RGB(200, 100, 0): DFC = 1
'Front
cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0)
cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0)
cube(2) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)
cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0)
'Back
cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0)
cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)
cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)
cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0)
'Right
cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0)
cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)
cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)
cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0)
'Left
cube(1http://www.hotcloob.com/modules/Forums/images/smiles/icon_cool.gif = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0)
cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0)
cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)
cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0)
'Top
cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0)
cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0)
cube(27) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)
cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0)
'Bottom
cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0)
cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)
cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)
cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0)
InitialiseGeometry = True
Exit Function
BOut:
InitialiseGeometry = False
End Function
'____________________
Private Function CreateLitVertex(x As Single, y As Single, z As Single, _
color As Long, specular As Long, tu As Single, tv As Single) As LITVERTEX
CreateLitVertex.x = x
CreateLitVertex.y = y
CreateLitVertex.z = z
CreateLitVertex.color = color
CreateLitVertex.specular = specular
CreateLitVertex.tu = tu
CreateLitVertex.tv = tv
End Function
'____________________
Public Sub Render()
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(cube(0))
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
'D3DDevice.SetTexture 0,Texture
'D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, TriStrip(0), Len(TriStrip(0))
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
کد فرم
Dim Er As Boolean
'____________________
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Er = True
End Sub
'____________________
Private Sub Form_Load()
Debug.Print "Start"
Me.Show
'While Er = False
'Render
'DoEvents
'Wend
Dim RotateAngle As Single
Dim matTemp As D3DMATRIX '//To hold temporary
Call initialise
While Er = False
RotateAngle = RotateAngle + 0.1
If RotateAngle >= 360 Then RotateAngle = RotateAngle - 360
D3DXMatrixIdentity matworld '//Reset our world matrix
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, RotateAngle * (Pi / 180)
D3DXMatrixMultiply matworld, matworld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (Pi / 180)
D3DXMatrixMultiply matworld, matworld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matworld
Render
DoEvents
Wend
End
End Sub
'____________________
Private Sub Form_Unload(Cancel As Integer)
End
End Sub