📄 frmregular.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmRegularQ
Caption = "长系列调节流量计算"
ClientHeight = 8085
ClientLeft = 60
ClientTop = 450
ClientWidth = 9855
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 8694.763
ScaleMode = 0 'User
ScaleWidth = 10014.92
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 8355
Left = 0
TabIndex = 3
Top = 420
Width = 10695
_ExtentX = 18865
_ExtentY = 14737
_Version = 393216
Rows = 32
Cols = 8
End
Begin VB.CommandButton CmdCalu
Caption = "计 算"
Height = 375
Left = 6480
TabIndex = 0
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdclose
Caption = "退 出"
Height = 375
Left = 7560
TabIndex = 4
Top = 0
Width = 1095
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 375
Left = 2895
TabIndex = 2
Top = 0
Width = 3240
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 375
Left = 30
TabIndex = 1
Top = 0
Width = 2775
End
End
Attribute VB_Name = "frmRegularQ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdCalu_Click()
'w():差积曲线坐标,Q():第I年的供水期平均出力
Dim p() As Single, w() As Single, Q() As Single
Dim ax As Single
Dim i As Integer, j As Integer, k As Integer
Dim IL As Integer, iil As Integer
Dim il1, il2 As Integer
Dim zzl As Single, vs As Single
Dim zz As Single, QQa As Single '假定为调节流量的初值
Dim vv1 As Single, vv2 As Single
Dim iis As Integer, ie As Integer
'假定的供水期平均出力
Dim F As Single, fi As Single, iu As Integer, iiu As Integer
Dim d As Single, jf As Integer
Dim condition As Boolean
Dim dd As Single
Dim i1 As Integer, i2 As Integer
Dim q0 As Single, iAction As Integer
'on error goto errform1click
'读取水位库容、水位流量关系表
Call ReadFile
q0 = ReadRunoff '多年平均流量
Call CaluFlow
zz = Val(InputBox("输入正常高水位：", "长系列调节流量计算"))
If zz <= 0 Then Exit Sub
QQa = 0.8 * q0 '假定为调节流量的初值
Call 插值图(mmg, gvv, gzz, zz, vv1) 'gvv：库容参数，gzz：水位参数，zz：正常高水位
'第一层循环 ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Do
Call 插值图(nng, gz1, gqq, QQa, zzl) 'nng：下泄流量的组数，多年平均流量*0.8后对应的下游水位
'hm:(zz - zzl) * 0.35是消落深度,zz - (zz - zzl) * 0.35是死水位
zzs = max(82, zz - (zz - zzl) * 0.35) '最低死水位与计算的死水位相比取大值得出需要的死水位
Call 插值图(mmg, gvv, gzz, zzs, vv2)
v = vv1 - vv2 '兴利库容
k = 1
ReDim w(k)
w(1) = 0
For i = 1 To m
For j = 1 To 12
ReDim Preserve w(k + 1)
w(k + 1) = w(k) + a(i, j) - q0 'W(k)是31年的累积水量
k = k + 1
Next j
Next i
kk = 1
iis = 1
'第二层循环 =================================================
Do
ie = iis + 9
If (ie > 12 * m + 1) Then ie = 12 * m + 1 '因ie小于373,故仍然等于10
F = w(iis)
For j = iis To ie
If (w(j) > F) Then
F = w(j)
iu = j
End If
Next j
fi = w(iu) '先找出十个数字中最大的一个4113.394
iiu = iu + 9 '找出十个数字中最大数对应的下标数 5 并加上 9
If (iiu > 12 * m + 1) Then iiu = 12 * m + 1
For j = iu To iiu
If (w(j) < fi) Then
fi = w(j) '再从 5 到 14组数中找出一个最小值-3167.968
IL = j '找出最小值-3167.968对应的组数12
End If
Next
iil = IL
'第三层循环 ------------------------------------------
Do
il1 = IL
il2 = iu
For j = iu To IL
d = w(iu) + (w(IL) + v - w(iu)) / CSng(IL - iu) * (j - iu)
If (d > w(j) + v) Then
IL = j '记下第11组数据，并把它传给IL
End If
Next j
For j = iu To IL
d = w(iu) + (w(IL) + v - w(iu)) / CSng(IL - iu) * (j - iu)
If d < w(j) Then iu = j '记下第5组数据，并把它传给IL
Next j
Loop Until (il1 = IL And il2 = iu) '找出IL=11,iu=5,
'-----------------------------------------------------
ReDim Preserve Q(kk)
Q(kk) = (w(IL) + v - w(iu)) / CSng(IL - iu) + q0
ReDim Preserve iss(kk), iee(kk), ig(kk)
iss(kk) = iu
iee(kk) = IL
ig(kk) = IL - iu
Debug.Print kk + 1950, iis, ie, iu, IL
Debug.Print kk + 1950, iss(kk) - 1, iee(kk) - 2, Q(kk)
kk = kk + 1
iis = iil
Loop Until (kk > m)
'========================================================
Dim Filenum As Integer
Filenum = FreeFile
Open App1 & "\no.dat" For Output As #Filenum '为保证出力计算提供试算文件
For i = 1 To m
Print #Filenum, iss(i) - 1, iee(i) - 1, Q(i)
Next i
Close #Filenum
ReDim p(m)
Call 排频(m, Q, p)
ax = 100#
For i = 1 To m
If Abs(p(i) - 87.5) < ax Then
ax = Abs(p(i) - 87.5)
jf = i '找出等于87.5相对应的调节流量
End If
Next i
condition = Abs(Q(jf) - QQa) > 1 '假定为调节流量的初值
If condition Then QQa = Q(jf)
Loop While (condition)
'||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Call 插值图(mmg, gvv, gzz, zzs, vs)
Label2 = "正常高水位 = " & zz & " 米"
Label3 = "死库容 = " & Format(vs, "#.00") & " m3/s.月"
Debug.Print "start"
For i = 1 To m
Debug.Print p(i), Q(i)
Next i
With MSFlexGrid1
.Rows = m + 1
For i = 1 To m
dd = (w(iee(i)) - w(iss(i))) + q0 * (iee(i) - iss(i)) '供水期水量
i1 = iss(i) - 12 * (i - 1) + ii0 - 1
If i1 > 12 Then i1 = i1 - 12 '供水期初径流量
i2 = iee(i) - 12 * (i - 1) + ii0 - 2
If i2 > 12 Then i2 = i2 - 12 '供水期末径流量
.TextMatrix(i, 0) = Str(i + i0 - 1)
.TextMatrix(i, 1) = Str(i1)
.TextMatrix(i, 2) = Str(i2)
.TextMatrix(i, 3) = Str(ig(i))
.TextMatrix(i, 4) = Format(dd, "#.00")
.TextMatrix(i, 5) = Format(v, "#.00")
.TextMatrix(i, 6) = Format(Q(i), "#.00")
.TextMatrix(i, 7) = Format(p(i), "#.00")
Dim ab As Integer
Filenum = FreeFile
Open App1 & "\调节流量成果表.dat" For Output As #Filenum '为保证出力计算提供试算文件
For ab = 1 To m
Print #Filenum, .TextMatrix(ab, 0); " "; .TextMatrix(ab, 1); " "; .TextMatrix(ab, 2); _
" "; .TextMatrix(ab, 3); " "; .TextMatrix(ab, 4); " "; .TextMatrix(ab, 5); " "; .TextMatrix(ab, 6); _
" "; .TextMatrix(ab, 7)
Next ab
Close #Filenum
Next
End With
Exit Sub
End Sub
Private Function max(s As Single, t As Single)
max = IIf(s > t, s, t)
End Function
Private Sub cmdClose_Click()
Unload Me
End Sub
'调节流量窗体
Private Sub Form_Load()
Dim j As Integer
With MSFlexGrid1
.Width = frmRegularQ.Width
.TextMatrix(0, 0) = "年份"
.TextMatrix(0, 1) = "供水期初"
.TextMatrix(0, 2) = "供水期末"
.TextMatrix(0, 3) = "供水期"
.TextMatrix(0, 4) = "来水量"
.TextMatrix(0, 5) = "兴利库容"
.TextMatrix(0, 6) = "调节流量"
.TextMatrix(0, 7) = "频率"
For j = 0 To .Cols - 1
.ColAlignment(j) = 4
Next
End With
Label2 = "": Label2.FontSize = 12: Label2.FontBold = True
Label3 = "": Label3.FontSize = 12: Label3.FontBold = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -