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