Soyez le premier à donner votre avis sur cette source.
Snippet vu 9 623 fois - Téléchargée 72 fois
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
28 déc. 2004 à 18:33
Faut etre fort quand meme.
26 avril 2004 à 19:45
en gros faut faire tout ce qui a ete dit dans les commentaires plus haut
+
- mettre un end select a la fin du fichier (encore un oubli)
- mettre les valeur de picture1.height .width .scalewidth et .scaleheight a la meme valeur et en multiple de 2 (chez moi ca marche comme ca)
et la normalement ca passe :)
2 févr. 2004 à 20:58
10 nov. 2003 à 22:21
C'est une attitude que je ne comprend vraiment pas et que je trouve intollérable sur un tel site
23 sept. 2003 à 11:14
1/ j'ai créé une picturebox
2/ 3 labels de nom label - label1 - label2
3/ j'ai mis directx7 dans les réferences
j'ai ajouté la ligne de code "Dim lightss As Direct3DRMLight" dans Option Explicit
je te rappelle que je ne suis qu'un amateur... et j'ai deja réussi a corriger ton prog.... maintenant..... ca me dit "Erreur d'automation", et ca pour plusieurs sources directx........ la, je seche...KE FAIRE....????
merci davance
vins
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.