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