Как нарисовать куб и закрутить его по вертикальной оси / Visual Basic - VB

Узнай цену своей работы

Формулировка задачи:

Вращающийся кубик. Изобразить в движении кубик заданного размера, равномерно вращающийся вокруг вертикальной оси. Развитие задачи, кубик, вращаясь удаляется в бесконечность. При помощи функциональных клавиш обеспечить смену цвета кубика.

Решение задачи: «Как нарисовать куб и закрутить его по вертикальной оси / Visual Basic»

textual
Листинг программы
  1. Option Explicit
  2. Private Type Vec: x As Single: y As Single: z As Single: End Type
  3. Private Type Face: V(3) As Vec: mz As Single:  End Type
  4. Private Type PointApi: x As Long: y As Long: End Type
  5. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As PointApi, ByVal nCount As Long) As Long
  6. Private Const DefOfst = 1
  7. Dim WithEvents tmrTimer As Timer, F(5) As Face, col As Long
  8. 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
  9. 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
  10. Private Function rot(pt As Vec, x As Single, y As Single, z As Single) As Vec
  11.     Dim cx As Single, sx As Single, cy As Single, sy As Single, cz As Single, sz As Single
  12.     sx = Sin(x): sy = Sin(y): sz = Sin(z): cx = Cos(x): cy = Cos(y): cz = Cos(z)
  13.     rot.x = pt.x * (cz * cy + sz * sx * sy) + pt.y * (-sz * cy + cz * sx * sy) + pt.z * (cx * sy)
  14.     rot.y = pt.x * (sz * cx) + pt.y * (cz * cx) - pt.z * sx
  15.     rot.z = pt.x * (-cz * sy + cy * sz * sx) + pt.y * (sz * sy + cz * sx * cy) + pt.z * (cx * cy)
  16. End Function
  17. Private Function tr(pt As Vec, x As Single, y As Single, z As Single) As Vec
  18.     tr.x = pt.x + x: tr.y = pt.y + y: tr.z = pt.z + z
  19. End Function
  20. Private Sub Create()
  21.     F(0) = fc(v3(-1, -1, -1), v3(-1, -1, 1), v3(1, -1, 1), v3(1, -1, -1))
  22.     F(1) = fc(v3(-1, -1, -1), v3(-1, -1, 1), v3(-1, 1, 1), v3(-1, 1, -1))
  23.     F(2) = fc(v3(-1, 1, -1), v3(-1, 1, 1), v3(1, 1, 1), v3(1, 1, -1))
  24.     F(3) = fc(v3(1, -1, -1), v3(1, -1, 1), v3(1, 1, 1), v3(1, 1, -1))
  25.     F(4) = fc(v3(-1, -1, -1), v3(-1, 1, -1), v3(1, 1, -1), v3(1, -1, -1))
  26.     F(5) = fc(v3(-1, -1, 1), v3(-1, 1, 1), v3(1, 1, 1), v3(1, -1, 1))
  27. End Sub
  28. Private Sub Sort(F() As Face)
  29.     Dim i1 As Long, i2 As Long, tmp As Face
  30.     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
  31.     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
  32.     Next: Next
  33. End Sub
  34. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  35.     If KeyCode > 47 And KeyCode < 58 Then col = QBColor(KeyCode - 47)
  36. End Sub
  37. Private Sub Form_Load()
  38.     Call Create: Me.FillStyle = vbSolid: Me.DrawStyle = 5: Me.AutoRedraw = True: Me.ScaleMode = 3: col = vbRed
  39.     Set tmrTimer = Me.Controls.Add("VB.Timer", "tmrTimer"): tmrTimer.Interval = 32: Me.Caption = "Cube by the trick"
  40.     Me.Move (Screen.Width - 8000) \ 2, (Screen.Height - 8000) \ 2, 8000, 8000
  41. End Sub
  42. Private Sub tmrTimer_Timer()
  43.     Dim i1 As Long, i2 As Long, dw As Long, dh As Long, pt(3) As PointApi, w(5) As Face, br As Single, _
  44.         a As Vec, o As Vec, n As Vec, s As Single, r As Long, g As Long, b As Long
  45.     Static rx As Single, ry As Single, rz As Single, oz As Single
  46.     Me.Cls: rx = rx + 0.01: ry = ry + 0.013: rz = rz + 0.12: oz = oz + 0.01
  47.     dw = Me.ScaleWidth \ 2: dh = Me.ScaleHeight \ 2
  48.     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()
  49.     For i1 = 0 To 5: With w(i1): For i2 = 0 To 3
  50.             pt(i2).x = .V(i2).x / (.V(i2).z + 1.5) * dw + dw
  51.             pt(i2).y = -.V(i2).y / (.V(i2).z + 1.5) * dh + dh
  52.         Next:
  53.         a = v3(.V(2).x - .V(0).x, .V(2).y - .V(0).y, .V(2).z - .V(0).z)
  54.         o = v3(.V(2).x - .V(1).x, .V(2).y - .V(1).y, .V(2).z - .V(1).z)
  55.         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)
  56.         s = Sqr(n.x * n.x + n.y * n.y + n.z * n.z): n.z = Abs(n.z / s)
  57.         r = (col And &HFF) * n.z: g = ((col And &HFF00&) \ &H100) * n.z: b = ((col And &HFF0000) \ &H10000) * n.z
  58.         Me.FillColor = RGB(r, g, b)
  59.         Polygon Me.hdc, pt(0), 4
  60.         End With
  61.     Next
  62.     Me.Refresh
  63. End Sub

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


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

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

12   голосов , оценка 4.167 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы