Faire un cube en 3d et le faire tourner sans utiliser directx

Soyez le premier à donner votre avis sur cette source.

Vue 5 990 fois - Téléchargée 796 fois

Description

voila tout un shema de calcul pour faire un cube grillager, et le faire pivoter autour de l'axe des Y

Source / Exemple :


Public Rayon, Rayon2, Rayon3 As Long, CentreX As Long, CentreY As Long
Public centreX2, centreY2, centreX3, centreY3 As Long
Public ComPte, Compte2, ComPte3 As Integer
Dim TaBl(50000, 2), TaBl2(50000, 2), TaBl3(50000, 2)
Public r, g, b, X, s, r1, g1, b1, r2, g2, b2 As Integer
Public a, c, d, ax, ay, bx, by, cx, cy, dx, dy As Integer
Public Ax1, Ay1, Bx1, By1, cx1, cy1, dx1, dy1, a1, bb, c1, d1 As Integer
Public Ex1, Ey1, Fx1, Fy1, Gx1, Gy1, Hx1, Hy1, e1, f1, gg, h1 As Integer
Public ZhaUt As Integer
Public at, bt, ct, dt As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
End
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Form_Load()
''''''''''''''

Call degradee
Call cercle
Call angulaire
Call cadre
Timer1.Enabled = True
ShowCursor = False
End Sub
Sub degradee()
Dim nombre, hauteur As Integer
r = 255
g = 255
b = 255
r2 = 0
g2 = 0
b2 = 0
Picture1.BackColor = RGB(r2, g2, b2)
nombre = 642
s = ScaleHeight / nombre
X = 0
For a = 0 To ScaleHeight
X = X + s
r1 = (r - r2) * (a / ScaleHeight)
g1 = (g - g2) * (a / ScaleHeight)
b1 = (b - b2) * (a / ScaleHeight)
r = r - r1
g = g - g1
b = b - b1
Line (0, X)-(ScaleWidth, X), RGB(r, g, b)
Next
'''''''''''''''
Rayon = Form2.Height / 2 - 1500
CentreX = Form2.Width / 2
CentreY = Form2.Height / 2 + 1000
End Sub
Sub cercle()
'------------------------------------------------------
pi = 3.14
ComPte = 0

angle = 0
Do While angle < pi * 2

  X = (Cos(angle) * Rayon) + CentreX
  Y = (Sin(angle) * Rayon) + CentreY
  DrawWidth = 1
  'Changer d'angle
  angle = angle + 0.005
  Picture1.PSet (X, Y), RGB(255, 255, 255)
  'enregistre dans le tableau les coordonnées du cercle parfait
'sans de pset pour le cercle
  TaBl(ComPte, 1) = X
  TaBl(ComPte, 2) = Y
  ComPte = ComPte + 1
Loop
ComPte = ComPte - 1
''------------------------------------------------------
a = 0
ax = TaBl(a, 1)
ay = TaBl(a, 2)
b = (ComPte / 4)
bx = TaBl(b, 1)
by = TaBl(b, 2)
c = b + b
cx = TaBl(c, 1)
cy = TaBl(c, 2)
d = 3 * b
dx = TaBl(d, 1)
dy = TaBl(d, 2)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Sub angulaire()

'tracée de cercle angulaire ''''''''
'----------------------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''centré sur dx et r=ad-->
'-----------------------------------------------------------------------------------------
Dim ConsTan As Integer
'''''''''''''''''''
ConsTan = 8000
'''''''''''''''''''''''
dy = dy - ConsTan
Dim ang1, ang2, ang3 As Single
pi = 3.14159265 'pi googlé
Dim AdJ1, AdJ2, AdJ3, Opp1, Opp2, Opp3 As Single
r = Sqr(CarrE(ax - dx) + CarrE(ay - dy)) 'racine pour la longueur du vecteur 'rayon'

La suite dans le zip ....

Codes Sources

A voir également

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.