'关于弹簧振子的动画
'━━━━━━━━━━━━━━━━━━━━━━
'关于弹簧振子的动画。改变振幅和周期可以改变动画中小球的运动。

Dim zf As Single, zq As Integer, ks As Boolean

Private Sub Form_Load()
    Dim a As Integer
    Me.Caption = "弹簧振子的运动展示"
    Text1.Text = CStr(Me.ScaleWidth * 0.2)
    Text2.Text = "3"
    Command1.Caption = "确定更改"
    'Me.BackColor = H0
    Me.FillStyle = 0
    Me.FillColor = HFF0000
    Me.AutoRedraw = True
    ks = False
    Me.ForeColor = HFFFFFF
    zf = Me.ScaleHeight * 0.2
    zq = 3
    Me.Print "双击窗体开始"
    Call zzyd
End Sub

Private Sub Form_DblClick()
    ks = True
    Call zzyd
End Sub

Private Sub zzyd()
    Dim a As Integer, w As Single, h As Single, d As Single, dy As Single, qwz As Single, jg As Single
    jg = 1
    on Error Resume Next
    Do While ks = True
        DoEvents
        jg = jg + 1
        qwz = Me.ScaleWidth * 0.5 + zf * Cos(jg / (2 * 3.1415926 * zq))
        w = Me.ScaleWidth
        h = Me.ScaleHeight
        Me.DrawWidth = w / 6000
        
        Me.Cls
        Me.Print "振幅的输入范围是" + CStr(1) + "---" + CStr(w * 0.3) + " " + vbCrLf + "双击窗体开始"
        Me.Line (w * 0.1, h * 0.1) - (w * 0.1, h * 0.6), HFFFFFF
        Me.Line (w * 0.9, h * 0.1) - (w * 0.9, h * 0.6), HFFFFFF
        Me.Line (w * 0.1, h * 0.35) - (w * 0.9, h * 0.35), HFFFFFF
        d = qwz - w * 0.1
        dy = Sqr((h * 0.04) ^ 2 - (d / 30) ^ 2)
        Me.Line (w * 0.1, h * 0.35) - (d / 30 + w * 0.1, h * 0.35 - dy), H80FFFF
        For a = 1 To 29
            If a Mod 2 <> 0 Then Me.Line (a * d / 30 + w * 0.1, h * 0.35 - dy) - ((a + 1) * d / 30 + w * 0.1, h * 0.35 + dy), H80FFFF Else Me.Line (a * d / 30 + w * 0.1, h * 0.35 + dy) - ((a + 1) * d / 30 + w * 0.1, h * 0.35 - dy), H80FFFF
        Next
        Me.Line (qwz, h * 0.35) - (qwz - d / 30, h * 0.35 + dy), H80FFFF
        Me.Circle (qwz, h * 0.35), w * 0.05, HFF
        Me.Line (Me.ScaleWidth / 2, h * 0.1) - (Me.ScaleWidth / 2, h * 0.6), H80FFFF
        If jg >= zq * 1000 Then jg = 0
    Loop
End Sub

Private Sub Command1_Click()
    on Error GoTo tc
    zf = CSng(Text1.Text)
    zq = CInt(Text2.Text)
tc:
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub