Как нарисовать куб и закрутить его по вертикальной оси / 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 4.167 из 5
Похожие ответы