Разработать приложение, позволяющее изображать на форме имитацию сферы , куба

Option Explicit
Dim k As Single, R As Single
Dim i As Single
 
Private Sub Command1_Click()
    Pic1.Scale (-200, 200)-(200, -200)
    Pic1.DrawWidth = 3
    R = 150
    For i = 0 To 1.5708 Step 0.261
        k = Cos(i)
        Pic1.Circle (0, 0), R, , , , k
        Pic1.Circle (0, 0), R, , , , 1 / k
    Next
End Sub

Option Explicit
Dim i As Single
 
Private Sub Command1_Click()
    Const a = 70.71
    Const b = 200
    Pic1.Scale (-50, 350)-(350, -50)
    Pic1.DrawWidth = 3
    Pic1.Line (0, 0)-(b, b), , B
    Pic1.Line (0, b)-(a, b + a)
    Pic1.Line (b, 0)-(b + a, a)
    Pic1.Line (b, b)-(b + a, b + a)
    Pic1.Line (a, b + a)-(b + a, b + a)
    Pic1.Line (b + a, a)-(b + a, b + a)
    
    Pic1.DrawWidth = 1
 
    For i = 20 To 200 Step 20
        Pic1.Line (0, i)-(b, i)
    Next
 
    For i = 20 To 200 Step 20
        Pic1.Line (b, i)-(b + a, i + a)
    Next
 
    For i = 20 To 200 Step 20
        Pic1.Line (i, b)-(a + i, b + a)
    Next
End Sub

Pic1.Scale (-200, 200)-(200, -200)

Pic1.Circle (0, 0), R, , , , k 
Pic1.Circle (0, 0), R, , , , 1 / k

Option Explicit
Dim x As Single, y As Single, y2 As Single
Dim R As Single, n As Single
Dim c1&, c2&, c3&, C&
 
Private Sub Command1_Click()
    R = 200
    Pic1.DrawWidth = 3
    Pic1.Scale (-R, R)-(R, -R)
    Pic1.Circle (0, 0), 150, , , , 0.7
    Do
        n = n + 1
        x = 300 * Rnd - 150
        y2 = 105 * Sqr(1 - (x / 150) ^ 2)
        y = y2 * Rnd
        c1 = 255 * Rnd
        c2 = 255 * Rnd
        c3 = 255 * Rnd
        C = RGB(c1, c2, c3)
        Pic1.PSet (x, y), C
        Pic1.PSet (x, -y), C
    Loop Until n > 5000
End Sub

Option Explicit
Dim WithEvents picDisp As PictureBox, _
    WithEvents hsbSize As HScrollBar, _
    WithEvents hsbZoom As HScrollBar, _
    WithEvents tmrTime As Timer, _
    WithEvents cboType As48span> ComboBox
 
Private Sub Form_Resize()
    On Error Resume Next
    If ScaleHeight <= 1000 Or ScaleWidth <= 2000 Then Exit Sub
    picDisp.Move 100, 100, ScaleWidth - 200, ScaleHeight - 1000
    hsbSize.Move 100, ScaleHeight - 800, ScaleWidth - 200
    hsbZoom.Move 100, ScaleHeight - 400, ScaleWidth - 2000
    cboType.Move ScaleWidth - 1800, ScaleHeight - 400, 1700
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo 1
    Cancel = 1: Set picDisp = Controls.Add("VB.PictureBox", "picDisp")
    Set hsbSize = Controls.Add("VB.HScrollBar", "hsbSize")
    Set hsbZoom = Controls.Add("VB.HScrollBar", "hsbZoom")
    Set tmrTime = Controls.Add("VB.Timer", "tmrTime")
    Set cboType = Controls.Add("VB.Combobox", "cboType")
    picDisp.ScaleMode = vbPixels: picDisp.FillStyle = vbSolid: picDisp.AutoRedraw = True
    hsbSize.Max = 100: hsbSize.Min = 0: hsbSize.Value = 50
    hsbZoom.Max = 100: hsbZoom.Min = 0: hsbZoom.Value = 50
    picDisp.Visible = True: hsbSize.Visible = True: hsbZoom.Visible = True
    tmrTime.Interval = 32
    cboType.AddItem "Сфера": cboType.AddItem "Куб": cboType.AddItem "Эллипс"
    cboType.ListIndex = 1: cboType.Visible = True: Form_Resize
    Exit Sub
1
End Sub
 
Private Sub tmrTime_Timer()
    Static ph As Single, cz As Single, x As Single, y As Single, d As Single, _
           p As Single, s As Long, l As Long, q As Single
           
    q = (hsbZoom.Value / 100)
    cz = Sin(ph) * q
    ph = ph + 0.03: picDisp.Cls
    s = IIf(ScaleWidth > ScaleHeight, picDisp.ScaleHeight / 4, picDisp.ScaleWidth / 4) * (hsbSize.Value / 100)
    s = s + s * cz: If s = 0 Then Exit Sub
    Select Case cboType.ListIndex
    Case 0
        picDisp.DrawStyle = 5
        d = 1.5707963267949 / s: p = 0: x = picDisp.ScaleWidth / 2: y = picDisp.ScaleHeight / 2
        For l = 0 To s - 1
            q = Exp(p - 1.5707963267949) * 255
            picDisp.FillColor = RGB(Sin(p) * 255, q, q)
            picDisp.Circle (x, y), s
            s = s - 1: p = p + d: x = x - 0.4: y = y - 0.4
        Next
    Case 1
        picDisp.DrawStyle = 0
        x = picDisp.ScaleWidth / 2 - s: y = Int(picDisp.ScaleHeight / 2 - s)
        picDisp.Line (x, y)-Step(s * 2, s * 2), &HA0A0FF, BF
        x = x + 1: y = y - 1: q = s / 2.5
        For l = 0 To q - 1
            picDisp.Line (x, y)-Step(s * 2, 0), &H323280
            picDisp.Line (Int(x + s * 2), y)-Step(0, s * 2), &H5252A0
            x = x + 1: y = y - 1
        Next
    Case Else
        picDisp.DrawStyle = 5
        x = picDisp.ScaleWidth / 2: y = picDisp.ScaleHeight / 2
        picDisp.FillColor = vbRed
        picDisp.Circle (x, y), s * 2, , , , 0.5
    End Select
End Sub