The double-Assist line method program (Source Code) of the traffic control algorithm is made public for the first time!

'*************************************** **************************************** ***************************
'
'Traffic adjustment and calculation dual-Auxiliary Line Method program 2011.2.13
'
'Author: Xiaoyan Linxian
'Qq: 51817
'Water conservancy Software Development Research Group: 39869071
'Water conservancy and hydropower project construction diversion scheme aided design system official blog: http://www.cnblogs.com/DivClose/
'
'The author is not held responsible for any adaptation of the source code!
'
'*************************************** **************************************** ****************************

Public x1, x2, X3 as integer

Private sub form_load ()

Makewindow me, false
Imgtitlemaxrestore. Picture = imgtitlemaximize. Picture
Loadskinz me
List1.additem ("Format: time period, incoming traffic ")
List2.additem ("Format: water level, storage capacity ")
List3.additem ("Format: water level, traffic leakage ")
End sub

'Input design flood process
Private sub semi click ()
On Error resume next
Dim file1 as string
Dim linein as string
Filenum = freefile

Cd1.dialogtitle = "open design flood process file"
Cd1.filter = "text file (*. txt) | *. txt | all files (*. *) | *.*"
Cd1.showopen
Text1.text = cd1.filename
If cd1.filename <> "then

File1 = cd1.filename
List1.clear
Open file1 for input as # filenum
Do while not EOF (filenum)
Line input # filenum, linein
List1.additem linein
X1 = X1 + 1
Loop
Close # filenum
Else
Exit sub
End if
End sub

'Input reservoir storage capacity curve
Private sub into 2_click ()
On Error resume next
Dim file2 as string
Dim linein as string
Filenum = freefile
Cd2.dialogtitle = "Open the reservoir capacity curve file"
Cd2.filter = "text file (*. txt) | *. txt | all files (*. *) | *.*"
Cd2.showopen
Text2.text = cd2.filename
If cd1.filename <> "then

File2 = cd2.filename
List2.clear
Open file2 for input as # filenum
Do while not EOF (filenum)
Line input # filenum, linein
List2.additem linein
X2 = x2 + 1
Loop
Close # filenum
Else
Exit sub
End if
End sub

'Input streaming Capability Curve
Private sub defaults 3_click ()
On Error resume next
Dim file3 as string
Dim linein as string
Filenum = freefile
Cd3.dialogtitle = "Open the streaming Capability Curve file"
Cd3.filter = "text file (*. txt) | *. txt | all files (*. *) | *.*"
Cd3.showopen
Text3.text = cd3.filename
If cd3.filename <> "" then

File3 = cd3.filename
List3.clear
Open file3 for input as # filenum
Do while not EOF (filenum)
Line input # filenum, linein
List3.additem linein
X3 = X3 + 1
Loop
Close # filenum
Else
Exit sub
End if
End sub

'Streamcompute core code
Private sub command3_click ()
On Error resume next
'Read the file and save it in the array.
Dim SD as single 'period Length
Dim WC, hu1, hU2, Z2, H, Q1 as single
Dim linestring as string

Dim HS (), Kr (), XL (), th (), vtq1 (), vtq2 () as single
Dim WZ, lenth as integer
WC = Val (textwc. Text)
SD = int (Val (textsd. Text) * 3600
Dim file1, file2, file3, file4 as string
File1 = text1.text
File2 = text2.text
File3 = text3.text
Redim HS (X1 + 1, 2)
Redim Kr (X2 + 1, 2)
Redim XL (X3 + 1, 2)
Redim th (X1 + 1, 3)
Redim vtq1 (X1 + 1, 2)
Redim vtq2 (X1 + 1, 2)
'Read the flood process data and save the data in the array
Open file1 for input as #1
For I = 1 to X1
Line input #1, linestring
Lenth = Len (linestring)
WZ = instr (1, linestring ,",")
HS (I, 0) = left (linestring, WZ-1)
HS (I, 1) = mid (linestring, WZ + 1, lenth-WZ)
Next I
Close #1

'Read the reservoir capacity curve and assign a value
Open file2 for input as #2
For I = 1 to X2
Line input #2, linestring
Lenth = Len (linestring)
WZ = instr (1, linestring ,",")
KR (I, 0) = left (linestring, WZ-1)
KR (I, 1) = mid (linestring, WZ + 1, lenth-WZ)
Next I
Close #2
'Read the drain capacity curve and assign a value
Open file3 for input as #3
For I = 1 to X3
Line input #3, linestring
Lenth = Len (linestring)
WZ = instr (1, linestring ,",")
XL (I, 0) = left (linestring, WZ-1)
XL (I, 1) = mid (linestring, WZ + 1, lenth-WZ)
Next I
Close #3
'Calculate the starting Water Level hu1
Dim varhu1 as single
For j = 1 to X3-1
If HS (1, 1)> = Val (XL (J, 1) and HS (1, 1) <= Val (XL (J + 1, 1) then
K = (XL (J + 1, 0)-XL (J, 0)/(XL (J + 1, 1)-XL (J, 1 ))
Varhu1 = K * (HS (1, 1)-XL (J, 1) + XL (J, 0)

Exit
End if
Next J

'Generate arrays vtq1 () and vtq2 ()
For I = 1 to X2
Dim varh, varv, varq as single
Varh = Kr (I, 0)
'Interpolation for database capacity
For j = 1 to x2-1
If varh> = Val (KR (J, 0) and varh <= Val (KR (J + 1, 0) then
K = (KR (J + 1, 1)-Kr (J, 1)/(KR (J + 1, 0)-Kr (J, 0 ))
Varv = K * (varh-Kr (J, 0) + KR (J, 1)
Exit
End if
Next J
'Interpolation for traffic Leakage
For j = 1 to X3-1
If varh> = Val (XL (J, 0) and varh <= Val (XL (J + 1, 0) then
K = (XL (J + 1, 1)-XL (J, 1)/(XL (J + 1, 0)-XL (J, 0 ))
Varq = K * (varh-XL (J, 0) + XL (J, 1)
Exit
End if
Next J
'Assign values to vtq1 () and vtq2 ()
Varv = varv * 10000/SD
Varq = varq/2
Vtq1 (I, 0) = varh
Vtq1 (I, 1) = varv-varq
Vtq2 (I, 0) = varh
Vtq2 (I, 1) = varv + varq
Next I
'Output arrays vtq1 () and vtq2 () to the file
Filenum = freefile
If right (App. Path, 1) = "\" then
File1 = app. Path + "pyevtq1.txt"
File2 = app. Path + "pyevtq2.txt"
Else
File1 = app. Path + "\ pyevtq1.txt"
File2 = app. Path + "\ pyevtq2.txt"
End if
Open file1 for output as # filenum
Write # filenum, "Time period vtq1"
For I = 1 to X2
Write # filenum, Val (vtq1 (I, 0), Val (vtq1 (I, 1 ))
Next I
Close # filenum
Filenum = freefile
Open file2 for output as # filenum
Write # filenum, "Time period vtq2"
For I = 1 to X2
Write # filenum, Val (vtq2 (I, 0), Val (vtq2 (I, 1 ))
Next I
Close # filenum
'Start the traffic optimization calculation, and calculate using the dual-Auxiliary Line Method
'Assign Initial Value
If texthu1.text = "" then
Hu1 = varhu1
Else
Hu1 = Val (texthu1.text)
End if
Th (1, 0) = 1
Th (1, 1) = hu1
For j = 1 to X3-1
If hu1> = Val (XL (J, 0) and hu1 <= Val (XL (J + 1, 0) then
K = (XL (J + 1, 1)-XL (J, 1)/(XL (J + 1, 0)-XL (J, 0 ))
Varq = K * (hu1-XL (J, 0) + XL (J, 1)
Exit
End if
Next J
Th (1, 2) = varq
Outstring = "upstream water level downstream traffic during the time period"
List4.additem (outstring)
Outstring = CSTR (Th (1, 0) + "," + CSTR (Th (1, 1) + "," + CSTR (Th (1, 2 ))
List4.additem (outstring)
Dim IPJ, varvtq1, varvtq2, varhu2 as single
'Cyclic Computation
For I = 2 to X1
Th (I, 0) = I
IPJ = (Val (HS (I, 1) + val (HS (I-1, 1)/2' average inbound traffic
For j = 1 to x2-1
If th (I-1, 1)> = Val (vtq1 (J, 0) and Th (I-1, 1) <= Val (vtq1 (J + 1, 0) then
K = (vtq1 (J + 1, 1)-vtq1 (J, 1)/(vtq1 (J + 1, 0)-vtq1 (J, 0 ))
Varvtq1 = K * (Th (I-1, 1)-vtq1 (J, 0) + vtq1 (J, 1)
Exit
End if
Next J
Varvtq2 = IPJ + varvtq1
For j = 1 to x2-1
If varvtq2> = Val (vtq2 (J, 1) and varvtq2 <= Val (vtq2 (J + 1, 1) then
K = (vtq2 (J + 1, 0)-vtq2 (J, 0)/(vtq2 (J + 1, 1)-vtq2 (J, 1 ))
Varhu2 = K * (varvtq2-vtq2 (J, 1) + vtq2 (J, 0)
Exit
End if
Next J
Th (I, 1) = varhu2
For j = 1 to X3-1
If varhu2> = Val (XL (J, 0) and varhu2 <= Val (XL (J + 1, 0) then
K = (XL (J + 1, 1)-XL (J, 1)/(XL (J + 1, 0)-XL (J, 0 ))
Varq = K * (varhu2-XL (J, 0) + XL (J, 1)
Exit
End if
Next J
Th (I, 2) = varq
WZ = instr (1, CSTR (Th (I, 1 )),".")
If WZ <> 0 then
Th (I, 1) = Val (left (Th (I, 1), WZ + 2 ))
End if
WZ = instr (1, CSTR (Th (I, 2 )),".")
If WZ <> 0 then
Th (I, 2) = Val (left (Th (I, 2), WZ + 2 ))
End if
Outstring = CSTR (Th (I, 0) + "," + CSTR (Th (I, 1) + "," + CSTR (Th (I, 2 ))
List4.additem (outstring)
Next I

End sub

'Save the calculation result
Private sub command4_click ()
If list4.listcount = 0 then
Dim ret4 as vbmsgboxresult
Ret4 = msgbox ("no data needs to be saved. Please calculate it first! ", Vbinformation," prompt ")
Exit sub
End if
Cdsave. dialogtitle = "Save calculation result"
Cdsave. Filter = "text file (*. txt) | *. txt | all files (*. *) | *.*"
Cdsave. showsave
Filenum = freefile
If cdsave. filename <> "then
File4 = cdsave. filename
Open file4 for output as # filenum
Write # filenum, "upstream water level downstream traffic during the time period"
For I = 1 to list4.listcount-1
Out = Split (list4.list (I ),",")
Write # filenum, Val (Out (0), Val (out (1), Val (Out (2 ))
Next I
Close # filenum
Ret4 = msgbox ("the result is saved! ", Vbinformation," prompt ")
Exit sub
Else
Exit sub
End if
End sub

'Clear data
Private sub command5_click ()
List1.clear
List2.clear
List3.clear
List4.clear
Text1.text = ""
Text2.text = ""
Text3.text = ""
Texthu1.text = ""
End sub

Private sub command6_click ()
Mbox "are you sure you want to exit? ", Vbinformation," Save the result"

End sub

'Interface code (start)
Private sub imgtitleclose_click ()
Unload me
End sub
Private sub imgtitleleft_mousedown (p_intbutton as integer, p_intshift as integer, p_sngx as single, p_sngy as Single)
Dodrag me
End sub
Private sub imgtitlemain_mousedown (p_intbutton as integer, p_intshift as integer, p_sngx as single, p_sngy as Single)
Dodrag me
End sub

Private sub imgtitleminimize_click ()
Me. windowstate = vbminimized
End sub

Private sub imgtitleright_mousedown (p_intbutton as integer, p_intshift as integer, p_sngx as single, p_sngy as Single)
Dodrag me
End sub

Private sub lbltitle_mousedown (button as integer, shift as integer, X as single, y as Single)
Dodrag me
End sub

'Part of the interface code (ended)

Source code download:

Http://files.cnblogs.com/DivClose/%e8%b0%83%e6%b4%aa%e6%bc%94%e7% AE %97%e5%8f%8c%e8%be%85%e5%8a%a9%e7%ba%bf%e6%b3%95%e6%ba%90%e4%bb%a3%e7%a0%81%ef%bc%88%e6%99%93%e6%9f%93%e9%9c%9c%e6%9e%97%e9%86%89QQ%ef%bc%9a51817%ef%bc%89.rar