⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmdetroyline.frm

📁 水利计算程序!年径流量!调节计算!调洪计算.
💻 FRM
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmDetroyLine 
   Caption         =   "防破坏线制作"
   ClientHeight    =   3660
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4365
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3660
   ScaleWidth      =   4365
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   3015
      Left            =   0
      TabIndex        =   2
      Top             =   360
      Width           =   4215
      _ExtentX        =   7435
      _ExtentY        =   5318
      _Version        =   393216
      Rows            =   14
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退    出"
      Height          =   350
      Left            =   1560
      TabIndex        =   1
      Top             =   0
      Width           =   1455
   End
   Begin VB.CommandButton cmdCalu 
      Caption         =   "计    算"
      Height          =   350
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1575
   End
End
Attribute VB_Name = "frmDetroyLine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdCalu_Click()
'VV():防破坏线纵坐标值
Dim v() As Single, vv() As Single
'VM:兴利库容,VS:死库容,AN:保证出力
Dim VM As Single, vs As Single, An As Single
Dim i As Integer, j As Integer, kn As Integer, ik As Integer
Dim v1 As Single, v2 As Single, vp As Single
Dim zs As Single, zx As Single
Dim QQ As Single, DQ As Single, Fm As Single, Fn As Single
Call ReadFile
Call ReadRunoff1
Call CaluFlow
Dialoge.Show vbModal
If Dialoge.Tag <> "ok" Then Exit Sub
VM = Val(Dialoge.Text1) 'VM:兴利库容
vs = Val(Dialoge.Text2) 'VS:死库容
An = Val(Dialoge.Text3) 'AN:保证出力
'VM = 1630.78: vs = 552.65: An = 400990.1

DoEvents
MousePointer = 11
ReDim v(m, 13)
For i = 1 To m
    v(i, 13) = vs '使初始库容等于死库容
    v2 = vs
    For j = 13 To 2 Step -1
        v1 = v2
        kn = 0
        Do While (kn < 100)
           vp = (v1 + v2) / 2#
           Call 插值图(mmg, gzz, gvv, vp, zs)
           QQ = v1 - v2 + a(i, j - 1)
           Call 插值图(nng, gz1, gqq, QQ, zx)
           Fn = ak * QQ * (zs - zx)
           If Abs(Fn - An) >= e Then
              DQ = (Fn - An) / ak / (zs - zx) '计算差值
              v1 = v1 - DQ '利用差值重新确定月初库容。
              If v1 > (VM + vs) Then v1 = VM + vs
              If v1 < vs Then v1 = vs  '条件判断后使初始库容在正常库容与死库容之间
              kn = kn + 1  '判断试算出力次数,使计算的保证出力等于87.5%频率下的保证出力
            Else
                Exit Do
            End If
        Loop
        v(i, j - 1) = v1 '得到某年某月的水库蓄水位
        Debug.Print "v(" & i & "," & j - 1 & ") = "; v(i, j - 1);
'        Debug.Print v(i, j - 1);
        v2 = v1
    Next j
    Debug.Print
Next i
ReDim vv(13)
For j = 1 To 13
    Fm = v(1, j)
    For i = 1 To m
      If Fm < v(i, j) Then Fm = v(i, j) '得到剔除破坏年后的某月最大蓄水量
      vv(j) = Fm
    Next i
Next j
With MSFlexGrid1
     For i = 1 To 13
     ik = i + 2
     If ik > 12 Then ik = ik - 12
     .TextMatrix(i, 0) = ik
     .TextMatrix(i, 1) = Format(vv(i), "#.00") '由月份为纵坐标,最大蓄水量为横坐标得到防破坏线
     Next i
End With
MousePointer = 0
    Dim Filenum As Integer
    Filenum = FreeFile
    Open App.Path & "\Fph.dat" For Output As #Filenum '防破坏线纵坐标数据文件
    For i = 1 To 13
       Print #Filenum, vv(i)
    Next i
    Close #Filenum
End Sub
Private Sub cmdexit_click()
    Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer, j As Integer
With MSFlexGrid1
    .Height = frmDetroyLine.Height - cmdCalu.Height
     .Width = frmDetroyLine.Width
     .Rows = 14
     .TextMatrix(i, 0) = "月份"
     .TextMatrix(i, 1) = "库蓄水量"
     For j = 0 To .Cols - 1
         .ColAlignment(j) = 4
     Next
End With
End Sub
'Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
' If Button = 2 Then
'    PopupMenu PopMenu
' End If
'End Sub

⌨️ 快捷键说明

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