📄 大摆角有阻尼的摆.frm
字号:
Caption = "0.1"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 315
Left = 1410
TabIndex = 7
Top = 2220
Width = 645
End
End
Begin VB.Line Line4
BorderColor = &H0000FF00&
X1 = 6450
X2 = 6450
Y1 = 30
Y2 = 3230
End
Begin VB.Line Line3
BorderColor = &H0000FF00&
X1 = 6450
X2 = 12000
Y1 = 1590
Y2 = 1590
End
Begin VB.Line Line2
BorderColor = &H0080FFFF&
BorderStyle = 3 'Dot
X1 = 2940
X2 = 2940
Y1 = 2340
Y2 = 840
End
Begin VB.Image Image1
Appearance = 0 'Flat
Height = 540
Left = 2790
Picture = "大摆角有阻尼的摆.frx":002B
Top = 7260
Width = 540
End
Begin VB.Menu showMnu
Caption = "showMnu"
Visible = 0 'False
Begin VB.Menu readMe
Caption = "课件说明…"
End
Begin VB.Menu about
Caption = "关于本课件…"
End
Begin VB.Menu k1
Caption = "-"
End
Begin VB.Menu showLine
Caption = "显示振动图线"
Checked = -1 'True
End
Begin VB.Menu change
Caption = "显示参数与命令对话框"
Checked = -1 'True
End
Begin VB.Menu k2
Caption = "-"
End
Begin VB.Menu exitThis
Caption = "退出程序"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const PI As Single = 3.1415926
Const g As Single = 9.8 '重力加速度，单位：米/秒/秒
Const k As Single = 3000 '摆长的换算系数，将缇换算为米，3000缇代表一米
Const x00 As Single = 6450, y00 As Single = 1590 '图线坐标原点
Const h As Single = 1590, w As Single = 5550 '图线高和宽
Const s As Single = 150, f As Single = 1600 '图线的疏密度与幅度
Public noStart As Boolean '运动未开始标记
Public x000 As Single, y000 As Single '图线绘图坐标
Public flage As Integer '初始位置，=1在右，=-1在左
Public x0 As Integer, y0 As Integer '坐标原点
Public xx As Integer, yy As Integer '保存鼠标坐标
Public t As Double '时间计数器
Public b As Single '阻尼系数
Public l As Single, l0 As Single '以米为单位的摆长和以缇为单位的摆长
Public p As Single '判别式
Public p1 As Single, p2 As Single '中间变量
Public r1 As Single, r2 As Single '中间变量
Public j0 As Single, j As Single '最大摆幅角和摆角
Public x1 As Single, y1 As Single '绘图用
Sub compute() '计算绘图程序
t = t + Timer1.Interval / 1000 '以秒为单位
l = l0 / k '摆长，以米为单位
b = HScroll1.Value / 100 '取得阻尼系数
'b= Sqr(g * l) / 5 '若用此行，强制成临界阻尼
p = 100 * b * b / l / l - 4 * g / l '判别式
p2 = -5 * b / l '根的一部分
If p < 0 Then '虚根，振动解
p1 = Sqr(-p) / 2
j = flage * j0 * Exp(p2 * t) * Cos(p1 * t) '摆角
ElseIf p = 0 Then '二重根
j = flage * j0 * Exp(-p2 * t) * (1 + p2 * t) '摆角
Else '两个不相等的实根
p1 = Sqr(p)
r1 = p2 + p1 / 2 '两个特征根
r2 = p2 - p1 / 2
j = flage * j0 * ((1 - r1 / p1) * Exp(r1 * t) + _
r1 / p1 * Exp(r2 * t)) '摆角
End If
Form1.Line (x0, y0)-(x1, y1), Form1.BackColor '擦除原来的摆线
x1 = x0 + l0 * Sin(j) '新摆线坐标
y1 = y0 + l0 * Cos(j)
Image1.Left = x1 - Image1.Width / 2 '移动摆球
Image1.Top = y1 - Image1.Height / 2
Form1.Line (x0, y0)-(x1, y1), vbRed '画新摆线
If t = Timer1.Interval / 1000 Then '第一个线段，特殊处理
CurrentX = x00 '起点坐标
CurrentY = y00 - f
Else
CurrentX = x000
CurrentY = y000
End If
'绘制振动图线
If showLine.Checked Then '只有允许画图线时才画
Form1.Line -(x00 + s * t, y00 - f * j / j0), vbYellow '画图线
End If
x000 = x00 + s * t '保存终点坐标
y000 = y00 - f * j / j0
Label5.Caption = CStr(j * 180 / PI) '显示摆角（度）
End Sub
Private Sub about_Click()
Dim say As String
say = say + "“大摆角有阻尼的摆”课件" + Chr(13) + Chr(13)
say = say + "制作：毕广吉" + Chr(13)
say = say + "天津师范大学物理与电子信息学院" + Chr(13)
say = say + "2001年7月" + Chr(13)
say = MsgBox(say, vbOKOnly, "关于“大摆角有阻尼的摆”课件")
End Sub
Private Sub Check1_Click() '强制
If Check1.Value = 1 Then
HScroll1.Enabled = True '滚动条可用
HScroll1.Value = 100 * Sqr(g * l) / 5 '设定滚动条为临界阻尼的值
Label1.Caption = HScroll1.Value / 100 '显示
Check1.Enabled = False '本复选钮不可用
HScroll1.Enabled = False '滚动条不可用
Else
HScroll1.Enabled = True '滚动条可用
End If
End Sub
Private Sub change_Click() '显示/隐去修改参数对话框
change.Checked = Not change.Checked '对钩取反
Frame1.Visible = change.Checked '是否显示修改参数对话框
End Sub
Private Sub Command1_Click() '“开始”按钮处理
j0 = Atn(Abs((x1 - x0) / (y1 - y0))) '摆角最大值
If showLine.Checked Then '如果显示振动图线
Line3.x1 = x00 '各坐标轴位置
Line3.X2 = x00 + w
Line3.y1 = h
Line3.Y2 = h
Line4.x1 = x00
Line4.X2 = x00
Line4.y1 = 0
Line4.Y2 = h * 2
End If
x000 = x00 '绘图始点
y000 = y00
Timer1.Enabled = True '打开定时器
Command1.Enabled = False '“开始”按钮不可用
Command2.Enabled = True '“单步”按钮可用
Command3.Enabled = True '“暂停”按钮可用
Check1.Enabled = False '强制临界阻尼不可用
noStart = False '运动已开始
t = 0 '时间初值，以秒为单位
End Sub
Private Sub Command2_Click() '“单步”按钮处理
Timer1.Enabled = False '关闭定时器
Command3.Caption = "继续" '改变“暂停”按钮标题
Call compute '计算，绘图
End Sub
Private Sub Command3_Click() '“暂停”按钮处理
Timer1.Enabled = Not Timer1.Enabled '定时器可用性取反
Command3.Caption = IIf(Timer1.Enabled, "暂停", "继续") '改变“暂停”按钮标题
End Sub
Private Sub Command4_Click() '“退出”按钮处理
End
End Sub
Private Sub exitThis_Click() '“退出”菜单处理
End
End Sub
Private Sub Form_Load()
Timer1.Interval = 50 '此参数影响刷新曲线的时间间隔，单位：毫秒
Form1.Left = 0 '以下四行决定窗体位置和大小
Form1.Top = 0
Form1.Width = Screen.Width
Form1.Height = Screen.Height
x0 = Frame2.Left + Frame2.Width / 2 '计算坐标原点
y0 = Frame2.Top + Line1.y1
Image1.Left = x0 - Image1.Width / 2 '安放摆球
Image1.Top = 7600
Line2.x1 = x0 '安放法线
Line2.X2 = x0
Form1.DrawWidth = 2 '画线宽度
Form1.Line (x0, y0)-(Image1.Left + Image1.Width / 2, _
Image1.Top + Image1.Height / 2), vbRed '画初始摆线
HScroll1.Value = 0 '阻尼初始值
Label1.Caption = HScroll1.Value / 100 '显示阻尼值
Frame1.Visible = change.Checked '修改参数面板的可见性
l0 = Image1.Top + Image1.Height '以缇为单位的摆长
l = l0 / k '以米为单位的摆长
Label3.Caption = CStr(l) '显示摆长
Label4.Caption = CStr(2 * PI * Sqr(l / g)) '显示周期
Label5.Caption = "0" '显示摆角
Timer1.Enabled = False '关闭定时器
Check1.Enabled = False '强制临界阻尼不可用
noStart = True '运动未开始标记
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then '如果右击
Form1.PopupMenu showMnu '弹出快捷菜单
End If
End Sub
Private Sub Frame1_Click() '单击修改参数面板，隐去
change.Checked = False
Frame1.Visible = False
End Sub
Private Sub HScroll1_Change() '水平滚动条改变处理
Label1.Caption = HScroll1.Value / 100 '显示值
End Sub
Private Sub HScroll1_Scroll() '滚动条滚蛋处理
Label1.Caption = HScroll1.Value / 100
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And noStart Then '拖动摆球处理
x1 = Image1.Left + Image1.Width / 2
y1 = Image1.Top + Image1.Height / 2
Image1.Left = Image1.Left + X - Image1.Width / 2 '拖动后摆球位置
Image1.Top = Image1.Top + Y - Image1.Height / 2
If Image1.Top < y0 - Image1.Height / 2 Then '限制摆球位置范围
Image1.Top = y0 - Image1.Height / 2
End If
Form1.Line (x0, y0)-(x1, y1), Form1.BackColor '擦掉原来的摆线
x1 = Image1.Left + Image1.Width / 2 '摆球新坐标
y1 = Image1.Top + Image1.Height / 2
Form1.Line (x0, y0)-(x1, y1), vbRed '画摆线
flage = IIf(x1 > x0, 1, -1) '标记摆球的初始位置，=1在右，=-1在左
l0 = Sqr((x1 - x0) * (x1 - x0) + (y1 - y0) * (y1 - y0)) '新摆长
l = l0 / k '以米为单位的摆长
Label3.Caption = CStr(l0 / k) '显示摆长
Label4.Caption = CStr(2 * PI * Sqr(l0 / k / g)) '显示周期
Label5.Caption = Atn((x1 - x0) / (y1 - y0)) * 180 / PI '显示初始摆角
Command1.Enabled = True '“开始”按钮可用
Check1.Enabled = True '强制临界阻尼可用
End If
End Sub
Private Sub readMe_Click()
Dim say As String
say = say + "1.从快捷菜单中选择是否显示振动图线。" + Chr(13)
say = say + "2.从快捷菜单中选择是否显示“参数与命令”对话框。" + Chr(13)
say = say + "3.拖动摆球至初始位置，此时“开始”按钮可用。" + Chr(13)
say = say + "4.通过滑动条调整阻尼的大小。" + Chr(13)
say = say + "5.单击“开始”按钮，摆开始振动。此时仍可通过滑" + Chr(13)
say = say + " 动条调整阻尼的大小。 " + Chr(13)
say = say + "6.单击“单步”按钮以后，每一次单击前进一步。若" + Chr(13)
say = say + " 要继续，应单击“继续”按钮" + Chr(13)
say = say + "7.单击“暂停”按钮后程序暂停，若要继续，应单击" + Chr(13)
say = say + " “继续”按钮。" + Chr(13)
say = say + "8.调整参数和摆球运动时，在“参数与命令”对话框" + Chr(13)
say = say + " 中动态显示各参数。" + Chr(13)
say = MsgBox(say, vbOKOnly, "“大摆角有阻尼的摆”课件使用说明：")
End Sub
Private Sub showLine_Click() '显示图线菜单处理
showLine.Checked = Not showLine.Checked '显示图线标记取反
Line3.Visible = showLine.Checked '图线坐标轴的可见性
Line4.Visible = showLine.Checked
If Not showLine.Checked Then '如果隐去绘图区
Form1.Line (x00 - 10, 0)-(x00 + w + 10, h * 2), 0, BF '遮盖绘图区
End If
End Sub
Private Sub Timer1_Timer() '定时器处理
Call compute '计算绘图
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -