Exemple directx 3drm

Commenter

Contenu du snippet

DIRECT 3D AVEC VISUAL BASIC

Nous allons nous intéresser a DirectX et plus particuliérement à Direct3D.

Il faut savoir que Direct3D comporte 2 modes différents :

- Le mode imédiat (IM) : c'est le mode le plus compliqué. Il permet d'interagire avec le hardware.

- Le mode rentenu (RM) : celui là est trés simple ! Il convient plus a des développements d'application et non de jeux.

Pour le moment, nous allons nous concentrer sur le Retained Mode. Nous allons crée une application qui chargera un fichier X et permetra de ce déplacer dans ce "monde".

Premiérement nous allons crée un projet standart, avec un Form (Form1) un Picture Box (Picture 1), et 2 labels (label1.caption = 0; label2.caption = 0). ATTENTION : Pensez à rajouter Direct X dans les références !

La premiére étape obligatoire est de déclarer tous les objets (et oui...)

Source / Exemple : 


Option Explicit

' On init tout !
' Les touches
Dim upss As Boolean
Dim downss As Boolean
Dim leftss As Boolean
Dim rightss As Boolean

' DirectX
Dim dxxx As New DirectX7
Dim dd As DirectDraw7
Dim ddClipper As DirectDrawClipper
Dim rm As Direct3DRM3
Dim meshToX As Direct3DRMMeshBuilder3
Dim rmDevice As Direct3DRMDevice3
Dim rmViewport As Direct3DRMViewport2
Dim mainFrame As Direct3DRMFrame3
Dim lightFrames As Direct3DRMFrame3
Dim cameraFrames As Direct3DRMFrame3
Dim objectFrames As Direct3DRMFrame3
Dim widthss As Long
Dim heightss As Long
Dim CaRunOuPas As Boolean
Dim prs As Single

Private Sub Form_Load()
MsgBox "Example DirectXRM (c) Thibault Durand" , vbInformation, "Auteur"
MsgBox "Appuyez sur les fléches directionelles pour faire bouger la boule", vbInformation, "Infos"
Show 

' Crée l'objet DirectDraw
Set dd = dxxx.DirectDrawCreate("")

' Le clipper est la zone d'affichage, ici il est égale à picture1
Set ddClipper = dd.CreateClipper(0)
ddClipper.SetHWnd Picture1.hWnd

' On sauve les dimensions de picture1
widthss = Picture1.ScaleWidth
heightss = Picture1.ScaleHeight

' On crée l'objet 3DRM
Set rm = dxxx.Direct3DRMCreate()

' Et maintenant le Device
Set rmDevice = rm.CreateDeviceFromClipper(ddClipper, "", widthss, heightss)

' On choisi la qualité (ici, le mode GOURAUD gourmand, mais le meilleur)
rmDevice.SetQuality D3DRMRENDER_GOURAUD

' On crée les frames (parce que sinon c'est pas pratique)
Set mainFrame = rm.CreateFrame(Nothing)
Set cameraFrames = rm.CreateFrame(mainFrame)
Set lightFrames = rm.CreateFrame(mainFrame)
Set objectFrames = rm.CreateFrame(mainFrame)

' Place la frame caméra et crée le ViewPort
cameraFrames.SetPosition Nothing, 0, 0, -10
Set rmViewport = rm.CreateViewport(rmDevice, cameraFrames, 0, 0, widthss, heightss)

' Que la lumiére soit... On crée la lumiére et on l'ajoute a la frame 'lightFrames'
Set lightss = rm.CreateLight(D3DRMLIGHT_DIRECTIONAL, &HFFFF80)
lightFrames.AddLight lightss

' On crée un mesh a partir du fichier x "Obj1.x" dans le répertoire de l'application (vous pouvez crée des fichiers de ce type avec 3DSMAX)
Set meshToX = rm.CreateMeshBuilder()
meshToX.LoadFromFile "\obj1.x", 0, D3DRMLOAD_FROMFILE, Nothing, Nothing

CaRunOuPas = True
Do While CaRunOuPas = True

' Mouvement de la caméra...

' Si la touche gauche est appuyé, mouvement vers la gauche de la caméra(voir gestion des touches plus loin....)
If leftss = True Then
Label1.Caption = Label1.Caption + 1
cameraFrames.SetPosition Nothing, Label1.Caption / 30, 0, label2.Caption / 30
End If

' Pareille pour la touche droit
If rightss = True Then
Label1.Caption = Label1.Caption - 1
cameraFrames.SetPosition Nothing, Label.Caption / 30, 0, label2.Caption / 30
End If

' Pareille pour la touche Haut
If upss = True Then
label2.Caption = labe2.Caption + 1
cameraFrames.SetPosition Nothing, Label1.Caption / 30, 0, label2.Caption / 30
End If

' Pareille pour la touche Bas
If downss = True Then
label2.Caption = label2.Caption - 1
cameraFrames.SetPosition Nothing, Label1.Caption / 30, 0, label2.Caption / 30
End If

' Ont rend la scéne et on rafraichit
rmViewport.Clear D3DRMCLEAR_ALL
rmViewport.Render mainFrame
rmDevice.Update

' Le fameux DoEvents pour que ca plante pas (ou moins)
DoEvents

Loop

End Sub

Private Sub Picture1_Paint()
rmDevice.HandlePaint Picture1.hDC
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
' Gestion des touches

Select Case KeyCode

Case Is = vbKeyUp
upss = True
downss = False
leftss = False
rightss = False

Case Is = vbKeyDown

upss = False
downss = True
leftss = False
rightss = False

Case Is = vbKeyLeft

upss = False
downss = False
leftss = True
rightss = False

Case Is = vbKeyRight

upss = False
downss = False
leftss = False
rightss = True
End Sub

Conclusion :


Enfin ! J'éspere que ceux cette source vous auras bien aider car l'apprentissage par l'exemple est à mon avis le meilleur dans l'informatique. Ce code est trés basique ! Il aurait falus crée un fonction pour décgarger tout les objets avant de quitter et pleins d'autre encore. Mais je voulais réduire ce code à l'éssentiel. Si vous avez des questions, écrivez moi à :
nbtstat@voila.fr

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.