Постройте усеченный конус по размерам и рассчитайте его объем - VB

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

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

По заданным пользователем размерам постройте усеченный конус и рассчитайте его объем.
Все сделал сам, ни чего не надо)

Решение задачи: «Постройте усеченный конус по размерам и рассчитайте его объем»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Type vec: X As Double: Y As Double: z As Double: End Type
  4. Private Const seg = 64
  5.  
  6. Dim WithEvents picDisp As PictureBox, WithEvents hsbH As HScrollBar, _
  7.     WithEvents hsbr1 As HScrollBar, WithEvents hsbr2 As HScrollBar, WithEvents tmr As Timer
  8.  
  9. Dim buf() As vec, rx As Single, ry As Single, rz As Single
  10.  
  11. Private Function vec3(ByVal X As Double, ByVal Y As Double, ByVal z As Double) As vec
  12.     vec3.X = X: vec3.Y = Y: vec3.z = z
  13. End Function
  14. Private Function rot(Pt As vec, X As Single, Y As Single, z As Single) As vec
  15.     Dim cx As Single, sx As Single, cy As Single, sy As Single, cz As Single, sz As Single
  16.     sx = Sin(X): sy = Sin(Y): sz = Sin(z): cx = Cos(X): cy = Cos(Y): cz = Cos(z)
  17.     rot.X = Pt.X * (cz * cy + sz * sx * sy) + Pt.Y * (-sz * cy + cz * sx * sy) + Pt.z * (cx * sy)
  18.     rot.Y = Pt.X * (sz * cx) + Pt.Y * (cz * cx) - Pt.z * sx
  19.     rot.z = Pt.X * (-cz * sy + cy * sz * sx) + Pt.Y * (sz * sy + cz * sx * cy) + Pt.z * (cx * cy)
  20. End Function
  21. Private Sub Create()
  22.     Dim i As Long, p1 As Long, p2 As Long, d As Single, r1 As Double, r2 As Double, h As Double
  23.     r1 = hsbr1.Value / 1000: r2 = hsbr2.Value / 1000: h = hsbH.Value / 1000
  24.     d = 6.28318530717959 / seg: p2 = seg: ReDim buf(seg * 2 - 1)
  25.     For i = 0 To seg - 1
  26.         buf(p1) = vec3(Cos(i * d) * r1, -h / 2, Sin(i * d) * r1): buf(p2) = vec3(Cos(i * d) * r2, h / 2, Sin(i * d) * r2)
  27.         p1 = p1 + 1: p2 = p2 + 1
  28.     Next
  29. End Sub
  30. Private Sub Render()
  31.     Dim i As Long, Pt() As vec, prv(1) As vec
  32.     picDisp.Cls: ReDim Pt(UBound(buf))
  33.     For i = 0 To UBound(buf)
  34.         Pt(i) = rot(buf(i), rx, ry, rz): Pt(i).X = Pt(i).X / (Pt(i).z + 1.5): Pt(i).Y = -Pt(i).Y / (Pt(i).z + 1.5)
  35.     Next
  36.     prv(0) = Pt(seg - 1): prv(1) = Pt(seg * 2 - 1)
  37.     For i = 0 To seg - 1
  38.         picDisp.Line (Pt(i).X, Pt(i).Y)-(prv(0).X, prv(0).Y): picDisp.Line -(prv(1).X, prv(1).Y)
  39.         picDisp.Line -(Pt(i + seg).X, Pt(i + seg).Y): prv(0) = Pt(i): prv(1) = Pt(i + seg)
  40.     Next
  41.     picDisp.Refresh
  42. End Sub
  43. Private Sub Form_Load()
  44.     Set picDisp = Me.Controls.Add("VB.PictureBox", "picDisp"): Set hsbH = Me.Controls.Add("VB.HScrollBar", "hsbH")
  45.     Set hsbr1 = Me.Controls.Add("VB.HScrollBar", "hsbr1"): Set hsbr2 = Me.Controls.Add("VB.HScrollBar", "hsbr2")
  46.     Set tmr = Me.Controls.Add("VB.timer", "tmr"): tmr.Interval = 32
  47.     hsbr1 = 500: hsbr2 = 150: hsbH = 700: Move (Screen.Width - 5000) \ 2, (Screen.Height - 6000) \ 2, 5000, 6000
  48.     Caption = "CylByTheTrick": Create
  49. End Sub
  50. Private Sub Form_Resize()
  51.     hsbH.Move 100, ScaleHeight - hsbH.Height - 100, ScaleWidth - 200: hsbH.Visible = True: hsbH.Max = 2000
  52.     hsbr1.Move 100, hsbH.Top - hsbr1.Height - 100, ScaleWidth - 200: hsbr1.Visible = True: hsbr1.Max = 1000
  53.     hsbr2.Move 100, hsbr1.Top - hsbr2.Height - 100, ScaleWidth - 200: hsbr2.Visible = True: hsbr2.Max = 1000
  54.     picDisp.Move 100, 100, ScaleWidth - 200, hsbr2.Top - 200: picDisp.Visible = True
  55.     picDisp.Scale (-1, -1)-(1, 1): picDisp.AutoRedraw = True: Render
  56. End Sub
  57. Private Sub picDisp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  58.     Static ox As Single, oy As Single, dx As Single, dy As Single, i As Long
  59.     If Button = vbLeftButton Then dx = -(X - ox): dy = -(Y - oy): rx = rx + dy: ry = ry + dx: Render
  60.     ox = X: oy = Y
  61. End Sub
  62. Private Sub hsbH_Change(): Create: Render: End Sub
  63. Private Sub hsbr1_Change(): Create: Render: End Sub
  64. Private Sub hsbr2_Change(): Create: Render: End Sub
  65. Private Sub hsbH_Scroll(): Create: Render: End Sub
  66. Private Sub hsbr1_Scroll(): Create: Render: End Sub
  67. Private Sub hsbr2_Scroll(): Create: Render: End Sub
  68. Private Sub tmr_Timer(): rx = rx + 0.01: ry = ry + 0.013: rz = rz + 0.009: Render: End Sub

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


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

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

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

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

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

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