📄 锥形护坡.frm
字号:
VERSION 5.00
Begin VB.Form frmzhxhp
BorderStyle = 1 'Fixed Single
Caption = "锥形护坡"
ClientHeight = 5100
ClientLeft = 45
ClientTop = 330
ClientWidth = 6345
Icon = "锥形护坡.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5100
ScaleWidth = 6345
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "关闭"
Height = 375
Left = 5280
TabIndex = 12
Top = 4680
Width = 975
End
Begin VB.CommandButton Command1
Caption = "计算"
Height = 375
Left = 4200
TabIndex = 11
Top = 4680
Width = 975
End
Begin VB.Frame Frame3
Caption = "原始数据"
Height = 2535
Left = 120
TabIndex = 15
Top = 120
Width = 6135
Begin VB.TextBox Text9
Height = 270
Left = 2040
TabIndex = 0
Text = "Text9"
Top = 360
Width = 975
End
Begin VB.TextBox Text10
Height = 270
Left = 2040
TabIndex = 1
Text = "Text10"
Top = 810
Width = 975
End
Begin VB.TextBox Text11
Height = 270
Left = 2040
TabIndex = 2
Text = "Text11"
Top = 1260
Width = 975
End
Begin VB.TextBox Text12
Height = 270
Left = 2040
TabIndex = 3
Text = "Text12"
Top = 1710
Width = 975
End
Begin VB.TextBox Text13
Height = 270
Left = 2040
TabIndex = 4
Text = "Text13"
Top = 2160
Width = 975
End
Begin VB.TextBox Text14
Height = 270
Left = 5040
TabIndex = 5
Text = "Text14"
Top = 360
Width = 975
End
Begin VB.TextBox Text15
Height = 270
Left = 5040
TabIndex = 6
Text = "Text15"
Top = 720
Width = 975
End
Begin VB.TextBox Text16
Height = 270
Left = 5040
TabIndex = 7
Text = "Text16"
Top = 1080
Width = 975
End
Begin VB.TextBox Text17
Height = 270
Left = 5040
TabIndex = 8
Text = "Text17"
Top = 1440
Width = 975
End
Begin VB.TextBox Text18
Height = 270
Left = 5040
TabIndex = 9
Text = "Text18"
Top = 1800
Width = 975
End
Begin VB.TextBox Text19
Height = 270
Left = 5040
TabIndex = 10
Text = "Text19"
Top = 2160
Width = 975
End
Begin VB.Label Label9
Caption = "锥坡总高度(m) H＝"
Height = 255
Left = 120
TabIndex = 26
Top = 360
Width = 2055
End
Begin VB.Label Label10
Caption = "上锥坡纵坡(1:m) m＝"
Height = 255
Left = 120
TabIndex = 25
Top = 810
Width = 1935
End
Begin VB.Label Label11
Caption = "上锥坡横坡(1:n) n＝"
Height = 255
Left = 120
TabIndex = 24
Top = 1260
Width = 1935
End
Begin VB.Label Label12
Caption = "上锥坡高度(m) H0＝"
Height = 255
Left = 120
TabIndex = 23
Top = 1710
Width = 2055
End
Begin VB.Label Label13
Caption = "上锥坡铺砌厚(m) t＝"
Height = 255
Left = 120
TabIndex = 22
Top = 2160
Width = 2055
End
Begin VB.Label Label14
Caption = "基础厚度(m) d＝"
Height = 255
Left = 3120
TabIndex = 21
Top = 1440
Width = 2175
End
Begin VB.Label Label15
Caption = "基础宽度(m) b0＝"
Height = 255
Left = 3120
TabIndex = 20
Top = 1800
Width = 1935
End
Begin VB.Label Label16
Caption = "襟边宽度(m) e＝"
Height = 255
Left = 3120
TabIndex = 19
Top = 2160
Width = 1935
End
Begin VB.Label Label17
Caption = "下锥坡纵坡(1:m1) m1＝"
Height = 255
Left = 3120
TabIndex = 18
Top = 360
Width = 1935
End
Begin VB.Label Label18
Caption = "下锥坡横坡(1:n1) n1＝"
Height = 255
Left = 3120
TabIndex = 17
Top = 720
Width = 2055
End
Begin VB.Label Label19
Caption = "下锥坡铺砌厚(m) t1＝"
Height = 255
Left = 3120
TabIndex = 16
Top = 1080
Width = 2055
End
End
Begin VB.Frame Frame4
Caption = "计算结果"
Height = 1815
Left = 120
TabIndex = 13
Top = 2760
Width = 6135
Begin VB.ListBox List1
Height = 1500
Left = 120
TabIndex = 14
Top = 240
Width = 5895
End
End
End
Attribute VB_Name = "frmzhxhp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'计算
Dim m As Double, bt As Double, hg As Double, hd As Double
Dim a As Double, n As Double, d As Double, e As Double
Dim m0 As Double, m0z As Double, vs As Double, e1 As Double, dtz As Double, e3z As Double
Dim e2 As Double, vj As Double, ad As Double, c As Double
Dim h As Double, m1 As Double
Dim n1 As Double, h0 As Double, t As Double, t1 As Double
Dim b0 As Double, b As Double, hp As Double
Dim vt As Double, vp As Double, ap As Double
On Error GoTo handlerror
'锥坡
'原始数据
h = Val(Text9.Text)
m = Val(Text10.Text)
n = Val(Text11.Text)
h0 = Val(Text12.Text)
t = Val(Text13.Text)
m1 = Val(Text14.Text)
n1 = Val(Text15.Text)
t1 = Val(Text16.Text)
d = Val(Text17.Text)
b0 = Val(Text18.Text)
e = Val(Text19.Text)
'输出
List1.Clear
List1.AddItem "《锥形护坡计算》"
List1.AddItem ""
List1.AddItem "－－－－原始数据－－－－"
List1.AddItem Label9.Caption + " " + Text9.Text
List1.AddItem Label10.Caption + " " + Text10.Text
List1.AddItem Label11.Caption + " " + Text11.Text
List1.AddItem Label12.Caption + " " + Text12.Text
List1.AddItem Label13.Caption + " " + Text13.Text
List1.AddItem Label14.Caption + " " + Text14.Text
List1.AddItem Label15.Caption + " " + Text15.Text
List1.AddItem Label16.Caption + " " + Text16.Text
List1.AddItem Label17.Caption + " " + Text17.Text
List1.AddItem Label18.Caption + " " + Text18.Text
List1.AddItem Label19.Caption + " " + Text19.Text
'计算
If h = h0 Then '单段
a = Sqr(1 + m * m) / m
b = Sqr(1 + n * n) / n
hp = h - (a + b) * t / 2
vt = pi * m * n * hp * hp * hp / 12
vp = pi * m * n * (h * h * h - hp * hp * hp) / 12
vj = ((m * h + e) * (n * h + e) - (m * h + e - b0) * (n * h + e - b0)) * pi * d / 4
' vj = k * pi * ((m + n) * h + 2 * e - b0) * b0 * d / 4
ap = pi * m * n * (a + Sqr(a * b) + b) / 12 * h * h
List1.AddItem ""
List1.AddItem "－－－－计算结果－－－－"
List1.AddItem "锥坡填土体积(m3) ＝" + Trim(Str(Int(vt * 1000 + 0.5) / 1000))
List1.AddItem "锥坡片石体积(m3) ＝" + Trim(Str(Int(vp * 1000 + 0.5) / 1000))
List1.AddItem "锥坡基础体积(m3) ＝" + Trim(Str(Int(vj * 1000 + 0.5) / 1000))
List1.AddItem "锥坡表面积(m2) ＝" + Trim(Str(Int(ap * 1000 + 0.5) / 1000))
End If
If h > h0 Then '多段
a = m * h0
hpi = m * h0 / m1
h1 = h - h0 + m * h0 / m1
'第一段
a = Sqr(1 + m * m) / m
b = Sqr(1 + n * n) / n
hp = h0 - (a + b) * t / 2
vt1 = pi * m * n * hp * hp * hp / 12
vp1 = pi * m * n * (h0 * h0 * h0 - hp * hp * hp) / 12
If t = 0 Then
ap1 = pi * m * n * (a + Sqr(a * b) + b) / 12 * h0 * h0
Else
ap1 = 0
End If
'第二段
a = Sqr(1 + m1 * m1) / m1
b = Sqr(1 + n1 * n1) / n1
hp = h1 - (a + b) * t1 / 2
vt2 = pi * m1 * n1 * hp * hp * hp / 12
vp2 = pi * m1 * n1 * (h1 * h1 * h1 - hp * hp * hp) / 12
vj = ((m1 * h1 + e) * (n1 * h1 + e) - (m1 * h1 + e - b0) * (n1 * h1 + e - b0)) * pi * d / 4
' vj = k * pi * ((m1 + n1) * h1 + 2 * e - b0) * b0 * d / 4
If t1 = 0 Then
ap2 = pi * m1 * n1 * (a + Sqr(a * b) + b) / 12 * h1 * h1
Else
ap2 = 0
End If
'第三段
hp = hpi - (a + b) * t1 / 2
vt3 = pi * m1 * n1 * hp * hp * hp / 12
vp3 = pi * m1 * n1 * (hpi * hpi * hpi - hp * hp * hp) / 12
If t1 = 0 Then
ap3 = pi * m1 * n1 * (a + Sqr(a * b) + b) / 12 * hpi * hpi
Else
ap3 = 0
End If
vt = vt1 + vt2 - vt3
vp = vp1 + vp2 - vp3
ap = ap1 + ap2 - ap3
List1.AddItem ""
List1.AddItem "－－－－计算结果－－－－"
List1.AddItem "锥坡填土体积(m3) ＝" + Trim(Str(Int(vt * 1000 + 0.5) / 1000))
List1.AddItem "锥坡片石体积(m3) ＝" + Trim(Str(Int(vp * 1000 + 0.5) / 1000))
List1.AddItem "锥坡基础体积(m3) ＝" + Trim(Str(Int(vj * 1000 + 0.5) / 1000))
List1.AddItem "锥坡表面积(m2) ＝" + Trim(Str(Int(ap * 1000 + 0.5) / 1000))
End If
Exit Sub
handlerror:
xiansh = MsgBox("在计算时出错，请检查输入的数据后再试试。", vbInformation, "问题提示")
End Sub
Private Sub Command2_Click()
'关闭
On Error GoTo handlerror
If List1.ListCount > 1 And rjsfzc = 88 Then
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
For i = 0 To List1.ListCount - 1
frmMain.Text1 = frmMain.Text1 & vbCrLf & " " + List1.List(i)
Next i
frmMain.Text1 = frmMain.Text1 & vbCrLf & " --------------------------------------"
End If
Unload Me
Exit Sub
handlerror:
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
On Error GoTo handlerror
If KeyAscii = 27 Then
Unload Me
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_Load()
'启动
On Error GoTo handlerror
'锥坡
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Text18.Text = ""
Text19.Text = ""
List1.Clear
List1.AddItem "如果没有变坡点，则下锥坡数据不用输入；"
List1.AddItem "且上锥坡高度应与锥坡总高度相同。"
Exit Sub
handlerror:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -