📄 form3.frm
字号:
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const PI = 3.14159
Dim L0 As Double 'L0为游动尾部长
Dim L1 As Double '三角形
Dim h As Double
Dim X As Double
Dim M1 As Double
Dim M0 As Double
Dim V1 As Double
Dim k As Double
Dim λ As Double
Dim α As Double
Dim ρ As Double
Dim T As Double
Dim Cn As Double
Dim o As Integer
Public Function tu()
Pic1.Scale (-1, 20)-(9, -2)
Pic1.Line (-0.5, 0)-(8, 0)
Pic1.Line (0, -1)-(0, 19)
Pic1.Line (7.6, -0.4)-(8, 0)
Pic1.Line (7.6, 0.4)-(8, 0)
Pic1.Line (-0.15, 18)-(0, 19)
Pic1.Line (0.15, 18)-(0, 19)
Pic1.CurrentX = 8
Pic1.CurrentY = -0.5
Pic1.Print "f(Hz)"
Pic1.CurrentX = 0.2
Pic1.CurrentY = 19
Pic1.Print "F(E-4N)"
Pic1.DrawStyle = 2
For i = 1 To 8
Pic1.CurrentY = -0.5
Pic1.CurrentX = i - 1
Pic1.Print i - 1
Pic1.Line (i - 1, 0)-(i - 1, 18)
Pic1.Line (i - 1, 0)-(i - 1, 0.3)
Next
For i = 1 To 9
Pic1.CurrentX = -0.5
Pic1.CurrentY = 2 * i
Pic1.Print 2 * i
Pic1.Line (0, 2 * i)-(7, 2 * i)
Next
Pic1.DrawStyle = 0
End Function
Private Sub Combo1_Click()
If Combo1.Text = "矩形" Then
o = 1 '矩形
ElseIf Combo1.Text = "三角形" Then
o = 2 '三角形
Else
o = 3 '抛物线
End If
End Sub
Private Sub Command1_Click()
Unload Form3
Load formain
formain.Show
End Sub
Private Sub Command2_Click()
Unload Form3
Load Form1
Form1.Show
End Sub
Public Function Romberg(problem As Long, a As Double, b As Double, tol As Double) As Double
Dim i As Long, j As Long, T() As Double, L As Long
Dim X As Double, dx As Double, n As Long, sum As Double
ReDim T(1 To 3)
T(1) = (b - a) * (fx(problem, a) + fx(problem, b)) / 2
T(2) = T(1) / 2 + (b - a) * (fx(problem, (a + b) / 2)) / 2
T(3) = (4 * T(2) - T(1)) / 3
j = 3
Do While Abs(T(UBound(T)) - T(UBound(T) - 2)) > tol
dx = (b - a) / (2 ^ (j - 1))
X = a - dx
n = 2 ^ (j - 2)
sum = 0
For i = 1 To n
X = X + 2 * dx
sum = sum + fx(problem, X)
Next
For i = 2 To UBound(T) Step 2
T(i - 1) = T(i)
Next
T(2) = T(1) / 2 + dx * sum
ReDim Preserve T(1 To UBound(T) + 2)
For L = 2 To j
If L <> j Then
T(L * 2) = ((4 ^ (L - 1)) * T(L * 2 - 2) - T(L * 2 - 3)) / ((4 ^ (L - 1)) - 1)
Else
T(UBound(T)) = ((4 ^ (L - 1)) * T(UBound(T) - 1) - _
T(UBound(T) - 2)) / ((4 ^ (L - 1)) - 1)
End If
Next
j = j + 1
Loop
Romberg = T(UBound(T))
End Function
Public Function fx(problem As Long, X As Double) As Double
Select Case problem
Case 0 '矩形
h = Text1.Text
fx = h * Tan(α) * X * Sin(2 * PI * X / λ)
Case 1 '三角形
L1 = Text2.Text
fx = L1 / L0 * (L0 - X) * Tan(α) * X * Sin(2 * PI * X / λ)
Case 2 '抛物线
a1 = Text7.Text
c = Text8.Text
fx = 2 * (a1 * X ^ 2 + b1 * X + c) * Tan(α) * X * Sin(2 * PI * X / λ)
Case 3 '矩形力1
L1 = Text2.Text
fx = -h * (-V1 * Sin(α) - X * Tan(α) * Cos(2 * PI * X / λ) / T) ^ 2
Case 4 '三角形力1
fx = -L1 / L0 * (L0 - X) * (-V1 * Sin(α) - X * Tan(α) * Cos(2 * PI * X / λ) / T) ^ 2
Case 5 '抛物线力1
a1 = Text7.Text
c = Text8.Text
fx = 2 * (a1 * X ^ 2 + c) * (-V1 * Sin(α) - X * Sin(α) * Cos(2 * PI * X / λ) / T) ^ 2
End Select
End Function
Private Sub Command3_Click()
If Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then
MsgBox "输入不能为空,请重新输入!", 16, "错误"
ElseIf Text3.Text = 0 Or Text4.Text = 0 Or Text5.Text = 0 Or Text6.Text = 0 Then
MsgBox "输入正确的数值!", 16, "错误"
Else
If o = 0 Then
MsgBox "请选择关系选项!", 16, "错误"
End If
Select Case o
Case 1
Call tu
Label3.Caption = "尾部形状为矩形时游动推进力F与摆动频率f的人关系"
ρ = 0.001
Cn = 0.5
L0 = Text3.Text
k = Text4.Text
M0 = Text5.Text
α = Text6.Text * PI / 180
λ = L0 / k
M1 = Romberg(0, 0, λ / 2, 0.000001) '矩形
M1 = M1 - Romberg(0, λ / 2, λ, 0.000001)
M1 = M1 * ρ
For f = 0.01 To 7 Step 0.001
T = 1 / f
V1 = f * λ * M1 / (M0 + M1)
F1 = Romberg(3, 0, L0 / 1000, 0.0000001) '矩形力
F1 = -F1 * ρ * Tan(α) * Cn * 10000 / 2
If F1 <= 18 Then
Pic1.PSet (f, F1), QBColor(4)
End If
Next
Pic1.CurrentX = 2.5
T = 1 / 2.5
V1 = 2.5 * λ * M1 / (M0 + M1)
F1 = Romberg(3, 0, L0 / 1000, 0.0000001)
F1 = -F1 * ρ * Tan(α) * Cn * 10000 / 2
Pic1.CurrentY = F1
Pic1.Print "矩形"
Case 2
Call tu
Label3.Caption = "尾部形状为三角形时游动推进力F与摆动频率f的人关系"
ρ = 0.001
Cn = 0.5
L0 = Text3.Text
k = Text4.Text
M0 = Text5.Text
α = Text6.Text * PI / 180
λ = L0 / k
M1 = Romberg(1, 0, λ / 2, 0.000001) '三角形
M1 = M1 - Romberg(1, λ / 2, λ, 0.000001)
M1 = M1 * ρ
For f = 0.01 To 7 Step 0.001
T = 1 / f
V1 = f * λ * M1 / (M0 + M1)
F1 = Romberg(4, 0, L0 / 1000, 0.0000001) '三角形力
F1 = -F1 * ρ * Tan(α) * Cn * 10000 / 2
If F1 <= 18 Then
Pic1.PSet (f, F1), QBColor(4)
End If
Next
Pic1.CurrentX = 3.2
T = 1 / 3.2
V1 = 3.2 * λ * M1 / (M0 + M1)
F1 = Romberg(4, 0, L0 / 1000, 0.0000001)
F1 = -F1 * ρ * Tan(α) * Cn * 10000 / 2
Pic1.CurrentY = F1
Pic1.Print "三角形"
Case 3
Call tu
Label3.Caption = "尾部形状为抛物线时游动推进力F与摆动频率f的人关系"
ρ = 0.001
Cn = 0.5
L0 = Text3.Text
k = Text4.Text
M0 = Text5.Text
α = Text6.Text * PI / 180
λ = L0 / k
M1 = Romberg(2, 0, λ / 2, 0.000001) '抛物线
M1 = M1 - Romberg(2, λ / 2, λ, 0.000001)
M1 = M1 * ρ
For f = 0.01 To 7 Step 0.001
T = 1 / f
V1 = f * λ * M1 / (M0 + M1)
F1 = Romberg(5, 0, L0 / 1000, 0.0000001) '抛物线力
F1 = F1 * ρ * Tan(α) * Cn * 10000 / 2
If F1 <= 18 Then
Pic1.PSet (f, F1), QBColor(4)
End If
Next
Pic1.CurrentX = 4.4
T = 1 / 4.4
V1 = 4.4 * λ * M1 / (M0 + M1)
F1 = Romberg(5, 0, L0 / 1000, 0.0000001)
F1 = F1 * ρ * Tan(α) * Cn * 10000 / 2
Pic1.CurrentY = F1
Pic1.Print "抛物线"
Case 4
Pic1.Scale (-0.1, 9)-(1, -2)
Pic1.Line (-0.05, 0)-(0.9, 0)
Pic1.Line (0, -1)-(0, 7)
Pic1.Line (0.85, -0.4)-(0.9, 0)
Pic1.Line (0.85, 0.4)-(0.9, 0)
Pic1.Line (-0.03, 6.5)-(0, 7)
Pic1.Line (0.03, 6.5)-(0, 7)
Pic1.CurrentX = 0.9
Pic1.CurrentY = -0.5
Pic1.Print "M(g)"
Pic1.CurrentX = 0.05
Pic1.CurrentY = 7
Pic1.Print "F(E-4N)"
Pic1.DrawStyle = 2
For i = 0.1 To 0.9 Step 0.1
Pic1.CurrentY = -0.5
Pic1.CurrentX = i - 0.1
Pic1.Print i - 0.1
Pic1.Line (i - 0.1, 0)-(i - 0.1, 6)
Next
For i = 1 To 6
Pic1.CurrentX = -0.05
Pic1.CurrentY = i
Pic1.Print i
Pic1.Line (0, i)-(0.8, i)
Next
Pic1.DrawStyle = 0
Label3.Caption = "尾部形状为矩形时游动推进力F与机器人质量M关系"
ρ = 0.001
Cn = 0.5
f = 1
L0 = Text3.Text
k = Text4.Text
α = Text6.Text * PI / 180
λ = L0 / k
M1 = Romberg(0, 0, λ / 2, 0.000001) '矩形
M1 = M1 - Romberg(0, λ / 2, λ, 0.000001)
M1 = M1 * ρ
For M0 = 0.01 To 0.8 Step 0.001
T = 1 / f
V1 = f * λ * M1 / (M0 + M1)
F1 = Romberg(3, 0, L0 / 1000, 0.0000001) '矩形力
F1 = -F1 * ρ * Tan(α) * Cn * 10000 / 2
If F1 <= 18 Then
Pic1.PSet (M0, F1), QBColor(4)
End If
Next
Pic1.CurrentX = 2.5
Pic1.CurrentY = 3
Pic1.Print "ρ = 0.001,Cn = 0.5,f = 1"
End Select
End If
End Sub
Private Sub Command4_Click()
Text5.Enabled = True
Combo1.Text = "形状选择"
Option1.Enabled = True
Option2.Enabled = True
Option1.Value = False
Option2.Value = False
Frame7.Enabled = True
o = 0
Text1.Text = "6"
Text2.Text = "6"
Text7.Text = "-0.0025"
Text8.Text = "3"
Text3.Text = "20"
Text4.Text = "1"
Text5.Text = "0.8"
Text6.Text = "20"
Pic1.Cls
End Sub
Private Sub HScroll1_Change()
Frame1.Left = 1080 - HScroll1.Value
End Sub
Private Sub Option1_Click()
Text5.Enabled = False
Frame7.Enabled = False
Option2.Enabled = False
o = 4
End Sub
Private Sub Option2_Click()
Option1.Enabled = False
Frame7.Visible = True
Combo1.Enabled = True
End Sub
Private Sub VScroll1_Change()
Frame1.Top = 480 - VScroll1.Value
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -