📄 first.frm

📁 单戗堤截流图解法计算程序使用帮助操作步骤：一：输入分流能力数据文本文件文件格式为上游水位
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    WZ = InStr(1, CStr(N), ".")
    If WZ <> 0 Then
       N = Val(Left(N, WZ + 3))
    End If
    WZ = InStr(1, CStr(DkQ), ".")
    If WZ <> 0 Then
       DkQ = Val(Left(DkQ, WZ + 3))
    End If
    OutString = CStr(B) + ", " + CStr(H) + ", " + CStr(Q152) + ", " + CStr(V) + ", " + CStr(DkQ) + ", " + CStr(Z1) + ", " + CStr(N)
    List3.AddItem (OutString)
    LbMsg.Caption = "即时提示：计算完毕"
End If
    
'//////////////////////////////////////////////////////////////
'计算类型为自动计算时
ElseIf JType = 2 Then
    Dim Z As Integer
    '简单的数据检查
    If TextB1.Text = "" Or TextB2.Text = "" Or TextZ.Text = "" Or TextQ.Text = "" Or TextWC.Text = "" Then
    
        ret2 = MsgBox("您还有必需的数据没有输入", vbInformation, "友好提示")
    Exit Sub
    End If
    If TextQ.Text = "" Or TextHx.Text = "" Or TextWC.Text = "" Then
    
        ret1 = MsgBox("您还有必需的数据没有输入", vbInformation, "友好提示")
    Exit Sub
    End If
    B1 = Val(TextB1.Text)
    B2 = Val(TextB2.Text)
    Z = Val(TextZ.Text)
    CS = Int(Abs(B2 - B1) / Z) + 1
    ReDim QH3(CS, 4)
    Q = Val(TextQ.Text) '截流设计流量
    Hx = Val(TextHx.Text) '下游水位
    WC = Val(TextWC.Text) '误差
    Hd = Val(TextHd.Text) '河底高程
    Hdd = Val(TextHdd.Text) '堤顶高程
    Hhd = Val(TextHhd.Text) '护坡厚度
    Bp = Val(Text1.Text) / Val(Text2.Text) '边坡
    BLJ = (Hdd - Hd - Hhd) / Bp '临界宽度
    '数据检查
    Check (TextB1.Text)
    Check (TextZ.Text)
    Check (TextB2.Text)
    Check (TextQ.Text)
    Check (TextHx.Text)
    Check (TextWC.Text)
    Check (TextHd.Text)
    Check (TextHdd.Text)
    Check (TextHhd.Text)
    Check (Bp)
    If BeErr = True Then
        ret3 = MsgBox("请检查您所输入的数据的合理性，再选择计算。", vbInformation, "友好提示")
        Exit Sub
    End If
'记录本次计算参数
If Right(App.Path, 1) = "\" Then
    Path1 = App.Path
Else
    Path1 = App.Path + "\"
End If

   Open Path1 + "last.txt" For Output As 11#
   OutStr2 = TextQ.Text + "#" + TextHhd.Text + "#" + TextM.Text + "#" + TextHx.Text + "#" + TextHdd.Text + "#" + TextHd.Text + "#" + Text1.Text + "#" + Text2.Text
   Print #11, OutStr2
    Close 11#
    
'>>>>>>>>>>开始循环计算<<<<<<<<<<<<<<<
For k = 0 To CS - 1
    B = B1 + k * Z
    '二分法计算上游水位H
'/////////////////////////////
'龙口宽度为0时，单独计算
If B = 0 Then
    Q2 = 0
    Q1 = Q - Q2
    '计算上游水位H1
    For i = 1 To X1 - 1
    If Q1 >= Val(QH1(i, 1)) And Q1 <= Val(QH1(i + 1, 1)) Then
        K1 = (QH1(i + 1, 0) - QH1(i, 0)) / (QH1(i + 1, 1) - QH1(i, 1))
        H1 = K1 * (Q1 - QH1(i, 1)) + QH1(i, 0)
        Exit For
    End If
    Next i
    Z1 = H1 - Hx '落差
    V = 0
    DkQ = 0
    N = 0
    '输出结果

    WZ = InStr(1, CStr(H1), ".")
    If WZ <> 0 Then
        H1 = Val(Left(H1, WZ + 3))
    End If
    WZ = InStr(1, CStr(Z1), ".")
    If WZ <> 0 Then
        Z1 = Val(Left(Z1, WZ + 3))
    End If
    WZ = InStr(1, CStr(N), ".")
    If WZ <> 0 Then
       N = Val(Left(N, WZ + 3))
    End If
    WZ = InStr(1, CStr(DkQ), ".")
    If WZ <> 0 Then
       DkQ = Val(Left(DkQ, WZ + 3))
    End If
    OutString = CStr(B) + ", " + CStr(H1) + ", " + CStr(Q2) + ", " + CStr(V) + ", " + CStr(DkQ) + ", " + CStr(Z1) + ", " + CStr(N)
    List3.AddItem (OutString)
Else
'////////////////////////
'龙口宽度不为0时
    '判断断面形式
    If B > (Hdd - Hd - Hhd) / Bp Then '梯形断面
        Hjz = Hd + Hhd
        Hs = Hx - Hjz
        BZ = 0.6
    ElseIf B = (Hdd - Hd - Hhd) / Bp Then '临界断面
        Hjz = Hd + Hhd
        Hs = Hx - Hjz
        BZ = 0.7
    Else '三角形断面
        Hjz = Hd + Hhd + ((Hdd - Hd - Hhd) / Bp - B) * Bp
        Hs = Hx - Hjz
        BZ = 0.8
    End If

    '生成数组QH2()并输出
    '设置龙口流量系数
    If TextM.Text = "" Then
        M = 0.35 '设定流量系数
    Else
        M = Val(TextM.Text)
    End If
    
    Line2 = (Hdd - Hjz) * 10 + 2
    ReDim QH2(Line2, 2)
    j = 0
    OutString = "龙口平均宽度B=" + CStr(B) + "米"
    List2.AddItem OutString
QH2(j, 0) = Hjz
    QH2(j, 1) = 0
    OutString = CStr(QH2(j, 0)) + ", " + CStr(QH2(j, 1))
    List2.AddItem OutString
    j = 1
    For i = Int(Hjz) + 1 To Int(Hdd) Step 0.1
       QH2(j, 0) = i
        QH2(j, 1) = M * B * 19.6 ^ 0.5 * (i - Hjz) ^ 1.5
        WZ = InStr(1, CStr(QH2(j, 1)), ".")
        If WZ <> 0 Then
            QH2(j, 1) = Val(Left(QH2(j, 1), WZ + 3))
        End If
        OutString = CStr(QH2(j, 0)) + ", " + CStr(QH2(j, 1))
        List2.AddItem OutString
        j = j + 1
    Next i
    QH2(j, 0) = Hdd
    QH2(j, 1) = M * B * 19.6 ^ 0.5 * (Hdd - Hjz) ^ 1.5
    WZ = InStr(1, CStr(QH2(j, 1)), ".")
        If WZ <> 0 Then
            QH2(j, 1) = Val(Left(QH2(j, 1), WZ + 3))
       End If
    OutString = CStr(QH2(j, 0)) + ", " + CStr(QH2(j, 1))
    List2.AddItem OutString
    '二分法计算上游水位H
   
   
   
    H1 = Hjz
    H2 = Hdd
    H15 = (H1 + H2) / 2
    '计算Q1
If H1 < Val(QH1(1, 0)) Then
    Q11 = 0
Else
    For i = 1 To X1 - 1
        If H1 >= Val(QH1(i, 0)) And H1 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q11 = K1 * (H1 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H1 >= Val(QH2(i, 0)) And H1 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q12 = K2 * (H1 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q1 = Q11 + Q12

    '计算Q2
If H2 < Val(QH1(1, 0)) Then
    Q21 = 0
Else
    For i = 1 To X1 - 1
        If H2 >= Val(QH1(i, 0)) And H2 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q21 = K1 * (H2 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H2 >= Val(QH2(i, 0)) And H2 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q22 = K2 * (H2 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q2 = Q21 + Q22

    '计算Q15
If H15 < Val(QH1(1, 0)) Then
    Q151 = 0
Else
    For i = 1 To X1 - 1
        If H15 >= Val(QH1(i, 0)) And H15 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q151 = K1 * (H15 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H15 >= Val(QH2(i, 0)) And H15 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q152 = K2 * (H15 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q15 = Q151 + Q152

    '判断是否求出解
    If Abs(Q1 - Q) <= WC Then
        H = H1
        TextOUT.Text = H
        Exit Sub
    End If
    If Abs(Q2 - Q) <= WC Then
        H = H2
        TextOUT.Text = H
        Exit Sub
    End If
        If Abs(Q15 - Q) <= WC Then
        H = H15
        TextOUT.Text = H
        Exit Sub
    End If
    '未计算出结果开始循环
Do While Abs(Q15 - Q) > WC
    If Sgn(Q15 - Q) = Sgn(Q2 - Q) Then
        H2 = H15
    Else
        H1 = H15
    End If
Kill = Kill + 1 '防止程序不响应
If Kill > 20000 Then
    retkill = MsgBox("无法计算结果，请检查数据或调整误差", vbInformation, "友好提示")
    Kill = 0
    Exit Sub
End If
    H15 = (H1 + H2) / 2
    '计算Q1
If H1 < Val(QH1(1, 0)) Then
    Q11 = 0
Else
    For i = 1 To X1 - 1
        If H1 >= Val(QH1(i, 0)) And H1 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q11 = K1 * (H1 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H1 >= Val(QH2(i, 0)) And H1 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q12 = K2 * (H1 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q1 = Q11 + Q12

    '计算Q2
If H2 < Val(QH1(1, 0)) Then
    Q21 = 0
Else
    For i = 1 To X1 - 1
        If H2 >= Val(QH1(i, 0)) And H2 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q21 = K1 * (H2 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H2 >= Val(QH2(i, 0)) And H2 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q22 = K2 * (H2 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q2 = Q21 + Q22
    
    '计算Q15
If H15 < Val(QH1(1, 0)) Then
    Q151 = 0
Else
    For i = 1 To X1 - 1
        If H15 >= Val(QH1(i, 0)) And H15 <= Val(QH1(i + 1, 0)) Then
            K1 = (QH1(i + 1, 1) - QH1(i, 1)) / (QH1(i + 1, 0) - QH1(i, 0))
            Q151 = K1 * (H15 - QH1(i, 0)) + QH1(i, 1)
            Exit For
        End If
    Next i
End If
    For i = 0 To Line2 - 1
        If H15 >= Val(QH2(i, 0)) And H15 <= Val(QH2(i + 1, 0)) Then
            K2 = (QH2(i + 1, 1) - QH2(i, 1)) / (QH2(i + 1, 0) - QH2(i, 0))
            Q152 = K2 * (H15 - QH2(i, 0)) + QH2(i, 1)
            Exit For
        End If
    Next i
    Q15 = Q151 + Q152
Loop

    H = H15
    '求龙口水深Hlk
    If (Hx - Hjz) / (H - Hjz) > BZ Then
        Hlk = Hx - Hjz '淹没时
    Else
        Hlk = FHK(B, Q152, Bp, 0.01) '非淹没时
    End If
    '求龙口平均流速V
    V = Q152 / (B * Hlk)
    '数据小数位数处理
    WZ = InStr(1, CStr(H), ".")
    If WZ <> 0 Then
        H = Val(Left(H, WZ + 3))
    End If
    WZ = InStr(1, CStr(Q152), ".")
    If WZ <> 0 Then
        Q152 = Val(Left(Q152, WZ + 3))
    End If
    WZ = InStr(1, CStr(V), ".")
    If WZ <> 0 Then
        V = Val(Left(V, WZ + 3))
    End If
    '输出结果
    'TextOUT.Text = CStr(H)
    'TextV.Text = CStr(V)
    Z1 = H - Hx
    If Z1 < 0 Then
        Z1 = 0
    End If
    N = 1# * 9.8 * Z1
    '对Z1进行处理
    Z1 = CStr(Z1)
    If Right(CStr(Z1), 4) = "E-01" Then
       WZ = InStr(1, CStr(Z1), ".")
        If WZ <> 0 Then
            Z1 = Val(Left(Z1, WZ + 3))
        End If
        Z1 = Z1 / 10
    ElseIf Right(CStr(Z1), 4) = "E-02" Then
       WZ = InStr(1, CStr(Z1), ".")
        If WZ <> 0 Then
            Z1 = Val(Left(Z1, WZ + 3))
        End If
        Z1 = Z1 / 100
    ElseIf Right(CStr(Z1), 4) = "E-03" Then
       WZ = InStr(1, CStr(Z1), ".")
        If WZ <> 0 Then
            Z1 = Val(Left(Z1, WZ + 3))
        End If
        Z1 = Z1 / 1000
    Else
        WZ = InStr(1, CStr(Z1), ".")
        If WZ <> 0 Then
            Z1 = Val(Left(Z1, WZ + 3))
        End If
    End If
    DkQ = Q152 / B
    WZ = InStr(1, CStr(Z1), ".")
    If WZ <> 0 Then
        Z1 = Val(Left(Z1, WZ + 3))
    End If
    WZ = InStr(1, CStr(N), ".")
    If WZ <> 0 Then
       N = Val(Left(N, WZ + 3))
    End If
    If WZ <> 0 Then
       DkQ = Val(Left(DkQ, WZ + 3))
    End If
    OutString = CStr(B) + ", " + CStr(H) + ", " + CStr(Q152) + ", " + CStr(V) + ", " + CStr(DkQ) + ", " + CStr(Z1) + ", " + CStr(N)
    List3.AddItem (OutString)
    LbMsg.Caption = "即时提示：计算完毕"
End If
'<<<<<<<<<<<<循环结束>>>>>>>>>>>>>
Next k
End If
End Sub

Private Sub Command4_Click()
'保存结果
On Error Resume Next
If List3.ListCount = 0 Then
上一页 1 2 3 45
💿 文件大小 93 K
👤 上传用户 whyzhao
📂 所属分类其他行业
🏷️ 相关标签

#图解 #分 #计算 #程序
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -