Cube 3d dessiner avec souris (3dsmax) sans directx ni opengl

Soyez le premier à donner votre avis sur cette source.

Vue 18 660 fois - Téléchargée 652 fois

Télécharger le projet
Commenter

Description

Ce code dessine un cube en 3d dans un plan incliner (tt ds la photo). Le code peut etre largement optimiser et surtout améliorer (pas de temps ces jours :( ). C'etait juste pour dire "c'est faisable avec vb sans Directx pour qlq mecs qui programment en c/c++ :p ".
La meme méthode peut etre utilisee pour les autres formes (pyramide ...).
Pour la coloration des faces de tube (les faces de tubes dans tt les sens), j'ai presque rien fais (faute 2 temps), mais j'ai donne la méthode a utiliser, reste juste faire qlq conditions avec les autres sens 2 la souris etc.. ;).

Avant me penche sur la suite de cette source, j'aimerais savoir vos commentaires (des autres idees si possible), merci d'avance...

Source / Exemple : 


'code tres simple mais éfficace :p
'davidauche@icqmail.com

Private Type COORD
    X As Long
    Y As Long
End Type
    Dim poly(1 To 4) As COORD
    Dim poly1(1 To 4) As COORD
    Dim poly2(1 To 4) As COORD
    Dim poly3(1 To 4) As COORD
    Dim poly4(1 To 4) As COORD
    Dim Xdepart1, Ydepart1 As Integer
    Dim NumCoords As Long
    Dim value As Integer
    Dim hBrush As Long, hRgn As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const ALTERNATE = 1
Const WINDING = 2
Const BLACKBRUSH = 3

Private Sub CubeBase(ByVal Xdepart As Integer, ByVal Ydepart As Integer, ByVal Xfinal As Integer, ByVal Yfinal As Integer, ByVal AngleRot As Integer, Couleur As OLE_COLOR)
On Error Resume Next

pi = 4 * Atn(1)
NumCoords = 4

z = Sqr((Xfinal - Xdepart) ^ 2 + (Yfinal - Ydepart) ^ 2)

If Xfinal >= Xdepart Then
        cosA = (Yfinal - Ydepart) / z
        angle = Atn(Sqr(1 - cosA ^ 2) / cosA) * 180 / pi
    
    If Yfinal = Ydepart Then AngleA = AngleRot Else AngleA = 90 - AngleRot - angle
        longeur = z * Cos(AngleA * pi / 180)
        longeur2 = z * Sin(AngleA * pi / 180)
   
        Me.Cls
        X1 = longeur * Cos(AngleRot * pi / 180)
        Y1 = longeur * Sin(AngleRot * pi / 180)
        X2 = longeur2 * Sin(AngleRot * pi / 180)
        Y2 = longeur2 * Cos(AngleRot * pi / 180)
    
    If Yfinal > Ydepart Then
        poly(1).X = Xdepart: poly(1).Y = Ydepart
        poly(4).X = Xdepart + X1: poly(4).Y = Ydepart + Y1
        poly(3).X = Xfinal: poly(3).Y = Yfinal
        poly(2).X = Xdepart - X2: poly(2).Y = Ydepart + Y2
        
        Me.ForeColor = Couleur
        Polygon Me.hdc, poly(1), NumCoords
    Else
        If Yfinal < Ydepart Then
            poly(1).X = Xdepart: poly(1).Y = Ydepart
            poly(4).X = Xdepart - X1: poly(4).Y = Ydepart - Y1
            poly(3).X = Xfinal: poly(3).Y = Yfinal
            poly(2).X = Xdepart + X2: poly(2).Y = Ydepart - Y2
        
            Me.ForeColor = Couleur
            Polygon Me.hdc, poly(1), NumCoords
        Else
            poly(1).X = Xdepart: poly(1).Y = Ydepart
            poly(4).X = Xdepart + X1: poly(4).Y = Ydepart + Y1
            poly(3).X = Xfinal: poly(3).Y = Yfinal
            poly(2).X = Xdepart + X2: poly(2).Y = Ydepart - Y2
        
            Me.ForeColor = Couleur
            Polygon Me.hdc, poly(1), NumCoords
        End If
    End If
    
Else
    cosA = Abs(Xfinal - Xdepart) / z
    angle = Atn(Sqr(1 - cosA ^ 2) / cosA) * 180 / pi
    
    If Yfinal > Ydepart Then AngleA = AngleRot + angle Else AngleA = angle - AngleRot
        longeur = z * Cos(AngleA * pi / 180)
        longeur2 = z * Sin(AngleA * pi / 180)
        X1 = longeur * Cos(AngleRot * pi / 180)
        Y1 = longeur * Sin(AngleRot * pi / 180)
        X2 = longeur2 * Cos((90 - AngleRot) * pi / 180)
        Y2 = longeur2 * Sin((90 - AngleRot) * pi / 180)
        Me.Cls
    
    If Yfinal > Ydepart Then
        poly(1).X = Xdepart: poly(1).Y = Ydepart
        poly(4).X = Xdepart - X1: poly(4).Y = Ydepart - Y1
        poly(3).X = Xfinal: poly(3).Y = Yfinal
        poly(2).X = Xdepart - X2: poly(2).Y = Ydepart + Y2
        
        Me.ForeColor = Couleur
        Polygon Me.hdc, poly(1), NumCoords
    Else
        poly(1).X = Xdepart: poly(1).Y = Ydepart
        poly(4).X = Xdepart - X1: poly(4).Y = Ydepart - Y1
        poly(3).X = Xfinal: poly(3).Y = Yfinal
        poly(2).X = Xdepart + X2: poly(2).Y = Ydepart - Y2
        
        Me.ForeColor = Couleur
        Polygon Me.hdc, poly(1), NumCoords
    End If
End If
End Sub

Private Sub Command1_Click()
    value = 0
    Command1.Enabled = False: Command2.Enabled = True
End Sub

Private Sub Command2_Click()
    value = 0
    Command2.Enabled = False: Command1.Enabled = True
End Sub

Private Sub Form_Load()
CubeBase 240, 0, 440, 528, 30, &HC0C0C0
Me.AutoRedraw = True
    Polygon Me.hdc, poly(1), NumCoords
Me.AutoRedraw = False
Command1.Enabled = False
Me.Caption = "Plan avec 30°"
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If value = 2 Then
    Me.AutoRedraw = True
        Polygon Me.hdc, poly1(1), 4
        Polygon Me.hdc, poly2(1), 4
        Polygon Me.hdc, poly3(1), 4
    Me.AutoRedraw = False
    
   If Command2.Enabled = False Then value = 0 Else value = 3
End If

If Button = 1 And value = 0 Then
    value = 1
    Xdepart1 = X: Ydepart1 = Y
End If

If Button = 2 Then value = 3: Command2.Enabled = True: Command1.Enabled = True

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If value = 3 Then Exit Sub

If Button = 1 And value = 1 Then
    CubeBase Xdepart1, Ydepart1, X, Y, 30, vbRed
End If

If value = 2 Then
    CubeFin Y, vbRed
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If value = 3 Then Exit Sub

Me.AutoRedraw = True
    Polygon Me.hdc, poly(1), NumCoords
    value = 2
Me.AutoRedraw = False

Command1.Enabled = True
End Sub
Private Sub CubeFin(ByVal Yfinal As Integer, Couleur As OLE_COLOR)
Dim hauteur As Integer

hauteur = poly(3).Y - Yfinal

poly1(1).X = poly(1).X
poly1(1).Y = poly(1).Y - hauteur
poly1(2).X = poly(2).X
poly1(2).Y = poly(2).Y - hauteur
poly1(3).X = poly(3).X
poly1(3).Y = poly(3).Y - hauteur
poly1(4).X = poly(4).X
poly1(4).Y = poly(4).Y - hauteur

poly2(1) = poly(1)
poly2(2) = poly(2)
poly2(3) = poly1(2)
poly2(4) = poly1(1)

poly3(1) = poly(4)
poly3(2) = poly(3)
poly3(3) = poly1(3)
poly3(4) = poly1(4)

poly4(1) = poly(2)
poly4(2) = poly(3)
poly4(3) = poly1(3)
poly4(4) = poly1(2)

Me.Cls
    
    
        hBrush = GetStockObject(BLACKBRUSH)
    hRgn = CreatePolygonRgn(poly3(1), NumCoords, ALTERNATE)
    If hRgn Then FillRgn Me.hdc, hRgn, hBrush
    DeleteObject hRgn
    
        hRgn = CreatePolygonRgn(poly1(1), NumCoords, ALTERNATE)
    If hRgn Then FillRgn Me.hdc, hRgn, hBrush
    DeleteObject hRgn
    
        hRgn = CreatePolygonRgn(poly4(1), NumCoords, ALTERNATE)
    If hRgn Then FillRgn Me.hdc, hRgn, hBrush
    DeleteObject hRgn
    
    Polygon Me.hdc, poly1(1), 4
    Polygon Me.hdc, poly4(1), 4
    Polygon Me.hdc, poly3(1), 4

End Sub

Conclusion :


j'ai bien amuse avec les calculs math pour dessiner des rectangles avec un plan incliner :-).
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
davidauche Messages postés 150 Date d'inscription jeudi 20 mars 2003 Statut Membre Dernière intervention 8 janvier 2008
26 févr. 2005 à 16:14
l'avantage de cette source, c'est que on peut dessiner a la main (souris)...
je sais qu'il y a mieu, c'etait juste un simple exemple. la méthode est pratique et plus simple qu'utiliser line pour dessiner...
merci ;)
a++
unhabitue Messages postés 1 Date d'inscription jeudi 24 février 2005 Statut Membre Dernière intervention 24 février 2005
24 févr. 2005 à 13:38
bonjour
moi j'aimerai tout simplement essayer ce module sur mon pc
je l'ai introdui dans une feuille excell avec succes mais je n'arrive pas à m'en servir
dessiner un cube en 3D
faut dire que je n'ai pas de notion de vb
ça s'arrette à mettre un module dans une page
cs_EBArtSoft Messages postés 4525 Date d'inscription dimanche 29 septembre 2002 Statut Modérateur Dernière intervention 22 avril 2019 9
23 févr. 2005 à 18:28
davidauche> maaaaa naaan c'est pas nule c'est juste... trop peu ;) il y a deja plein de source qui fond la meme chose en mieu. Mais on ne te demande pas de faire mieu on te demande surtout de faire different. Aller, courage

:p
davidauche Messages postés 150 Date d'inscription jeudi 20 mars 2003 Statut Membre Dernière intervention 8 janvier 2008
22 févr. 2005 à 23:57
non 4 lignes :p
bon okay! la source est null, je laisse tombe...
je m'occupe de Java et c/c++ c'est largement mieux.. aller bn courage
cs_EBArtSoft Messages postés 4525 Date d'inscription dimanche 29 septembre 2002 Statut Modérateur Dernière intervention 22 avril 2019 9
22 févr. 2005 à 19:05
Je savais pas qu'on avais besoin de directx pour faire 3 lignes de couleur...
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.

Du même auteur (davidauche)