Как нарисовать куб и закрутить его по вертикальной оси / Visual Basic - VB
Формулировка задачи:
Вращающийся кубик. Изобразить в движении кубик заданного размера, равномерно вращающийся вокруг вертикальной оси. Развитие задачи, кубик, вращаясь удаляется в бесконечность. При помощи функциональных клавиш обеспечить смену цвета кубика.
Решение задачи: «Как нарисовать куб и закрутить его по вертикальной оси / Visual Basic»
textual
Листинг программы
- Option Explicit
- Private Type Vec: x As Single: y As Single: z As Single: End Type
- Private Type Face: V(3) As Vec: mz As Single: End Type
- Private Type PointApi: x As Long: y As Long: End Type
- Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As PointApi, ByVal nCount As Long) As Long
- Private Const DefOfst = 1
- Dim WithEvents tmrTimer As Timer, F(5) As Face, col As Long
- Private Function v3(x As Single, y As Single, z As Single) As Vec: v3.x = x: v3.y = y: v3.z = z: End Function
- Private Function fc(v1 As Vec, v2 As Vec, v3 As Vec, V4 As Vec) As Face: fc.V(0) = v1: fc.V(1) = v2: fc.V(2) = v3: fc.V(3) = V4: End Function
- Private Function rot(pt As Vec, x As Single, y As Single, z As Single) As Vec
- Dim cx As Single, sx As Single, cy As Single, sy As Single, cz As Single, sz As Single
- sx = Sin(x): sy = Sin(y): sz = Sin(z): cx = Cos(x): cy = Cos(y): cz = Cos(z)
- rot.x = pt.x * (cz * cy + sz * sx * sy) + pt.y * (-sz * cy + cz * sx * sy) + pt.z * (cx * sy)
- rot.y = pt.x * (sz * cx) + pt.y * (cz * cx) - pt.z * sx
- rot.z = pt.x * (-cz * sy + cy * sz * sx) + pt.y * (sz * sy + cz * sx * cy) + pt.z * (cx * cy)
- End Function
- Private Function tr(pt As Vec, x As Single, y As Single, z As Single) As Vec
- tr.x = pt.x + x: tr.y = pt.y + y: tr.z = pt.z + z
- End Function
- Private Sub Create()
- F(0) = fc(v3(-1, -1, -1), v3(-1, -1, 1), v3(1, -1, 1), v3(1, -1, -1))
- F(1) = fc(v3(-1, -1, -1), v3(-1, -1, 1), v3(-1, 1, 1), v3(-1, 1, -1))
- F(2) = fc(v3(-1, 1, -1), v3(-1, 1, 1), v3(1, 1, 1), v3(1, 1, -1))
- F(3) = fc(v3(1, -1, -1), v3(1, -1, 1), v3(1, 1, 1), v3(1, 1, -1))
- F(4) = fc(v3(-1, -1, -1), v3(-1, 1, -1), v3(1, 1, -1), v3(1, -1, -1))
- F(5) = fc(v3(-1, -1, 1), v3(-1, 1, 1), v3(1, 1, 1), v3(1, -1, 1))
- End Sub
- Private Sub Sort(F() As Face)
- Dim i1 As Long, i2 As Long, tmp As Face
- For i1 = 0 To 5: F(i1).mz = 0: For i2 = 0 To 3: F(i1).mz = F(i1).mz + F(i1).V(i2).z: Next: F(i1).mz = F(i1).mz / 3: Next
- For i1 = 0 To 4: For i2 = 0 To 4 - i1: If F(i2).mz < F(i2 + 1).mz Then tmp = F(i2): F(i2) = F(i2 + 1): F(i2 + 1) = tmp
- Next: Next
- End Sub
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
- If KeyCode > 47 And KeyCode < 58 Then col = QBColor(KeyCode - 47)
- End Sub
- Private Sub Form_Load()
- Call Create: Me.FillStyle = vbSolid: Me.DrawStyle = 5: Me.AutoRedraw = True: Me.ScaleMode = 3: col = vbRed
- Set tmrTimer = Me.Controls.Add("VB.Timer", "tmrTimer"): tmrTimer.Interval = 32: Me.Caption = "Cube by the trick"
- Me.Move (Screen.Width - 8000) \ 2, (Screen.Height - 8000) \ 2, 8000, 8000
- End Sub
- Private Sub tmrTimer_Timer()
- Dim i1 As Long, i2 As Long, dw As Long, dh As Long, pt(3) As PointApi, w(5) As Face, br As Single, _
- a As Vec, o As Vec, n As Vec, s As Single, r As Long, g As Long, b As Long
- Static rx As Single, ry As Single, rz As Single, oz As Single
- Me.Cls: rx = rx + 0.01: ry = ry + 0.013: rz = rz + 0.12: oz = oz + 0.01
- dw = Me.ScaleWidth \ 2: dh = Me.ScaleHeight \ 2
- For i1 = 0 To 5: For i2 = 0 To 3: w(i1).V(i2) = tr(rot(F(i1).V(i2), rx, ry, rz), 0, 0, oz + DefOfst): Next: Next: Sort w()
- For i1 = 0 To 5: With w(i1): For i2 = 0 To 3
- pt(i2).x = .V(i2).x / (.V(i2).z + 1.5) * dw + dw
- pt(i2).y = -.V(i2).y / (.V(i2).z + 1.5) * dh + dh
- Next:
- a = v3(.V(2).x - .V(0).x, .V(2).y - .V(0).y, .V(2).z - .V(0).z)
- o = v3(.V(2).x - .V(1).x, .V(2).y - .V(1).y, .V(2).z - .V(1).z)
- n = v3(a.y * o.z - a.z * o.y, a.x * o.z - a.z * o.x, a.x * o.y - a.y * o.x)
- s = Sqr(n.x * n.x + n.y * n.y + n.z * n.z): n.z = Abs(n.z / s)
- r = (col And &HFF) * n.z: g = ((col And &HFF00&) \ &H100) * n.z: b = ((col And &HFF0000) \ &H10000) * n.z
- Me.FillColor = RGB(r, g, b)
- Polygon Me.hdc, pt(0), 4
- End With
- Next
- Me.Refresh
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д