Как нарисовать куб и закрутить его по вертикальной оси / 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д