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

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

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

как эту программу сделать попроще без кода за 100 строчек ? Разработать приложение, позволяющее изображать на форме имитацию сферы (метод Circle в цикле), куба (метод Line в цикле), закрашенный эллипс. Ввести в интерфейс приложения следующие элементы управления: 1) созданные на основе объектов HScrollBar и VScrollBar, позволяющие изменять размеры сферы, куба, эллипса; 2) управляющие автоматическим сжатием/увеличением сферы и куба (пульсирующие сфера и куб).

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

textual
Листинг программы
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

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

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