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

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

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

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

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

textual
Листинг программы
Option Explicit
 
Private Type vec: X As Double: Y As Double: z As Double: End Type
Private Const seg = 64
 
Dim WithEvents picDisp As PictureBox, WithEvents hsbH As HScrollBar, _
    WithEvents hsbr1 As HScrollBar, WithEvents hsbr2 As HScrollBar, WithEvents tmr As Timer
 
Dim buf() As vec, rx As Single, ry As Single, rz As Single
 
Private Function vec3(ByVal X As Double, ByVal Y As Double, ByVal z As Double) As vec
    vec3.X = X: vec3.Y = Y: vec3.z = z
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 Sub Create()
    Dim i As Long, p1 As Long, p2 As Long, d As Single, r1 As Double, r2 As Double, h As Double
    r1 = hsbr1.Value / 1000: r2 = hsbr2.Value / 1000: h = hsbH.Value / 1000
    d = 6.28318530717959 / seg: p2 = seg: ReDim buf(seg * 2 - 1)
    For i = 0 To seg - 1
        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)
        p1 = p1 + 1: p2 = p2 + 1
    Next
End Sub
Private Sub Render()
    Dim i As Long, Pt() As vec, prv(1) As vec
    picDisp.Cls: ReDim Pt(UBound(buf))
    For i = 0 To UBound(buf)
        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)
    Next
    prv(0) = Pt(seg - 1): prv(1) = Pt(seg * 2 - 1)
    For i = 0 To seg - 1
        picDisp.Line (Pt(i).X, Pt(i).Y)-(prv(0).X, prv(0).Y): picDisp.Line -(prv(1).X, prv(1).Y)
        picDisp.Line -(Pt(i + seg).X, Pt(i + seg).Y): prv(0) = Pt(i): prv(1) = Pt(i + seg)
    Next
    picDisp.Refresh
End Sub
Private Sub Form_Load()
    Set picDisp = Me.Controls.Add("VB.PictureBox", "picDisp"): Set hsbH = Me.Controls.Add("VB.HScrollBar", "hsbH")
    Set hsbr1 = Me.Controls.Add("VB.HScrollBar", "hsbr1"): Set hsbr2 = Me.Controls.Add("VB.HScrollBar", "hsbr2")
    Set tmr = Me.Controls.Add("VB.timer", "tmr"): tmr.Interval = 32
    hsbr1 = 500: hsbr2 = 150: hsbH = 700: Move (Screen.Width - 5000) \ 2, (Screen.Height - 6000) \ 2, 5000, 6000
    Caption = "CylByTheTrick": Create
End Sub
Private Sub Form_Resize()
    hsbH.Move 100, ScaleHeight - hsbH.Height - 100, ScaleWidth - 200: hsbH.Visible = True: hsbH.Max = 2000
    hsbr1.Move 100, hsbH.Top - hsbr1.Height - 100, ScaleWidth - 200: hsbr1.Visible = True: hsbr1.Max = 1000
    hsbr2.Move 100, hsbr1.Top - hsbr2.Height - 100, ScaleWidth - 200: hsbr2.Visible = True: hsbr2.Max = 1000
    picDisp.Move 100, 100, ScaleWidth - 200, hsbr2.Top - 200: picDisp.Visible = True
    picDisp.Scale (-1, -1)-(1, 1): picDisp.AutoRedraw = True: Render
End Sub
Private Sub picDisp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static ox As Single, oy As Single, dx As Single, dy As Single, i As Long
    If Button = vbLeftButton Then dx = -(X - ox): dy = -(Y - oy): rx = rx + dy: ry = ry + dx: Render
    ox = X: oy = Y
End Sub
Private Sub hsbH_Change(): Create: Render: End Sub
Private Sub hsbr1_Change(): Create: Render: End Sub
Private Sub hsbr2_Change(): Create: Render: End Sub
Private Sub hsbH_Scroll(): Create: Render: End Sub
Private Sub hsbr1_Scroll(): Create: Render: End Sub
Private Sub hsbr2_Scroll(): Create: Render: End Sub
Private Sub tmr_Timer(): rx = rx + 0.01: ry = ry + 0.013: rz = rz + 0.009: Render: End Sub

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


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

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

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