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 :-).
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.