新安江模型VB代码
VB代码大全1
隐藏form1：form1.hide显示form1：form1.show--------------------------------------------------------------------------------------------- 退出程序时，弹出窗口提示是否要退出：Private Sub Form_Unload(Cancel As Integer)Dim iAnswer As IntegeriAnswer = MsgBox("真要退出吗?", vbYesNo)If iAnswer = vbNo ThenCancel = TrueElseEndEnd IfEnd Sub---------------------------------------------------------------------------------------------- 只能用任务管理器关闭程序的代码：Private Sub From_Unload(Cancel As Integer)Cancel = trueEnd Sub------------------------------------------------------------------------------------------------ 点击command1打开33IQ网：Dim strURLPrivate Sub Command1_Click()strURL = ""Shell "explorer.exe " & strURL, 1End Sub------------------------------------------------------------------------------------------------ 运行c:\1.exeshell "c:\1.exe"执行c:\1.batshell "c:\1.bat"注：只适用于大部分exe和全部bat。
vb经典代码
1.求三角形的面积代码：Option ExplicitDim a!,b!,c!r,!,s!Private Sub Command1_Click()a = InputBox("a=", "请输入a的数值")b = InputBox("b=", "请输入b的数值")c = InputBox("c=", "请输入c的数值")If a + b > c And a + c > b And b + c > a And a > 0 And b > 0 And c > 0 Thenr = 1 / 2 * (a + b + c)s = Sqr(r * (r - a) * (r - b) * (r - c))Label1.Caption = "三角形的面积为" & sElseLabel2.Caption = "输入的数据不能构成三角形"End IfEnd Sub2.三个数排列代码：Option ExplicitDim x!, y!, z!, t!Private Sub Command1_Click()x = InputBox("输入第一个数 x")y = InputBox("输入第二个数 y")z = InputBox("输入第三个数 z")Print "排序前"; x & " " & y & " " & zIf x < y Then t = x: x = y: y = tIf y < z Thent = y: y = z: z = tIf x < y Thent = x: x = y: y = tEnd IfEnd IfPrint "排序后"; z & " " & y & " " & xEnd Sub3.计算一元二次方程的代码：Option ExplicitDim a!,b!,c!,d!,x1!,x2!Private Sub Command1_Click()a = InputBox("a=", "请输入一元二次方程的系数a")b = InputBox("b=", "请输入一元二次方程的系数b")c = InputBox("c=", "请输入一元二次方程的系数c")If a = 0 ThenPrint "因为a≠0，你输入的a＝0，请重新输入系数a"End Ifd = b ^ 2 - 4 * a * cIf d >= 0 Thenx1 = (-b + Sqr(d)) / (2 * a)x2 = (-b - Sqr(d)) / (2 * a)Print "系数为" & a; b; c & "的一元二次方程的根分别为" & "x1=" & x1 & " " & "x2=" & x2ElsePrint "此方程在实数范围内无解"End IfEnd Sub4.利用Select Case语句输入年份计算属相代码：Option ExplicitPrivate Sub Command1_Click()Dim i As Integer, x As String, Y As IntegerY = InputBox("输入你的出生年份Y")i = Y Mod 12 Select Case i Case Is = 0 x = "猴" Case Is = 1 x = "鸡" Case Is = 2 x = "狗" Case Is = 3 x = "猪" Case Is = 4 x = "鼠" Case Is = 5 x = "牛" Case Is = 6 x = "虎" Case Is = 7 x = "兔" Case Is = 8 x = "龙" Case Is = 9 x = "蛇" Case Is = 10 x = "马" Case Is = 11 x = "羊" End SelectPrint xEnd Sub5.闰年两种判断方法的代码; 方法一：Option ExplicitDim y As IntegerPrivate Sub Command1_Click()y = InputBox("y=", "输入年份")If y Mod 4 = 0 ThenIf y Mod 100 = 0 ThenIf y Mod 400 = 0 ThenPrint "这年为闰年"ElsePrint "这年为平年"End IfElsePrint "这年为闰年"End IfElsePrint "这年为平年"End IfEnd Sub方法二：Private Sub Command2_Click()y = InputBox("y=", "输入年份")If y Mod 4 = 0 And y Mod 100 = 0 Then Print "这年为闰年"ElseIf y Mod 400 = 0 ThenPrint "这年为闰年"ElsePrint "这年为平年"End IfEnd Sub法一：Option ExplicitDim x!,y!Private Sub Command1_Click()x = InputBox("x=", "输入x的值")If x <> 0 ThenIf x >= 1 Or x <= -1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")ElsePrint "所输入的x不在定义域"End IfElsePrint "除数不能为零"End IfEnd Sub法二：Private Sub Command2_Click()x = InputBox("x=", "输入x的值")Select Case xCase Is = 0Print "除数不能为零"Case Is >= 1, Is <= -1y = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")Case Is <> 0, Is < 1, Is > -1Print "所输入的x不在定义域"End SelectEnd Sub法三：Private Sub Command3_Click()x = InputBox("x=", "输入x的值")If x >= 1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")ElseIf x < 1 And x > 0 ThenPrint "所输入的x不在定义域"ElseIf x = 0 ThenPrint "除数不能为零"ElseIf x >= -1 And x < 0 ThenPrint "所输入的x不在定义域"ElseIf x <= -1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")End IfEnd Sub流程图：伪代码：step1：输入x的值；step2：判断x是否为零;step3：若x=0，输出“除数不能为零”；若x不为零，则继续判断x的绝对值是否大于1；step4：若x的绝对值是否大于1，输出y的值；否则x的值不在函数的定义域里，结束。
新安江模型程序核心源代码
%%%新安江模型程序核心源代码function Qr=XAJ_JUN(DAREA,DT,EM,WwU,WwL,WwD,P,S0, FR0, Qrs0, Qrss0, Qrg0,parameter,Qm) % XAJ是新安江的运行程序,用于单纯形和遗传算法调用,也用于新安江模型的预报Imp1=parameter.IMP ; %流域不透水面积比：次洪Kc= parameter.Kc ; %流域蒸散发折算系数：多年总径流量决定WMU=parameter.WMU ; %流域上层蓄水容量WML=parameter.WML ; %流域中层蓄水容量WMD = parameter.WMD ; %流域下层蓄水容量B = parameter.B ; %流域蓄水容量分布曲线指数C = parameter.C ; %流域深层蒸发系数Ex = parameter.Ex; %流域自由水分布曲线指数SM = parameter.SM ; %流域自由水平均蓄水容量Ki = parameter.Ki ; %自由水箱壤中流出流系数Kg = parameter.Kg ; %自由水箱地下水出流系数Cs = parameter.Cs ; %地面水线性水库汇流系数Ci = parameter.Ci ; %壤中流线性水库汇流系数Cg = parameter.Cg ; %地下水线性水库汇流系数Ke = parameter.Ke ; %马斯京根法河段传播时间Xe = parameter.Xe ; %马斯京根法流量比重系数L = parameter.L ; %滞后演算法参数%次洪决定：WM，B，Imp%WwU(0)=WwU;WwL(0)=WwL;WwD(0)=WwD;%由于日模型与次洪模型的计算时段长不同，参数值不能全部通用，但K、WM、WUM、WLM、B、IMP、EX、C与时段长无关，可以直接引用，%Kc SM、KG、KSS、CS、CI、CG与时段长相关，不能直接引用，需要另外率定%junjunzhu-XAJ-MODELU=DAREA/(DT*3.6); %单位转换D=24/DT;KSSD = (1 - (1 - (Ki + Kg)) ^ (1 / D)) / (1 + Kg / Ki); % 'KSSD，ki出流系数KGD消退系数KGD = KSSD * Kg / Ki;%A_WM=A_WUM+A_WLM+A_WDM;%WMM=(1+B).*WM/(1-IMP);Epp=Kc*EM;% PE=P-K.*EM;for T=1:size(EM,1) %% T以时段为单位计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%三层蒸散发计算if (WwU + P(T)) >= Epp(T)EU(T) = Epp(T); %上层蒸发%Epp为EMEL(T) = 0; %中层ED(T) = 0; %下层elseEU(T) = WwU + P(T) ; %'Ww(1) + P为EUEL(T) = (Epp(T) - EU(T)) * WwL / WML; %要求计算的下层蒸发量与剩余蒸散发能力之比不小于深层蒸散发系数cED(T) = 0;if WwL <= (C * WML) %第二层水量小于蒸散发能力if WwL >= C * (Epp(T) - EU(T)) %'要求计算的下层蒸发量与剩余蒸散发能力之比小于深层蒸散发系数cEL(T) = C * (Epp(T) - EU(T)) ;ED(T) = 0;elseEL(T) = WwL;ED(T) = C * (Epp(T) - EU(T)) - EL(T) ;endendendPE(T) = P(T) - EU(T) - EL(T) - ED(T); %%%%%%%%%%%%%%%%%%%%%%%%==========================================%产流计算部分%%%%%%%%%%%%%%%%%%%%%%%%%%%%%===================================== =====Wm0 = WMU + WML + WMD; % '平均蓄水容量W0 = WwU + WwL + WwD; %'初始含水量R = 0;Rimp = 0;Wmm = (1 + B) * Wm0 / (1 - Imp1) ; % 'Imp1不透水面积比，Wmm为蓄水容量极值if PE(T) >0 %Then GoTo 1000 '降雨小于蒸发，B为蓄水容量曲线的指数if abs(Wm0 - W0) <= 0.0001 % 'Wmm为蓄水容量极值A = Wmm;elseA = Wmm * (1 - (1 - W0 / Wm0) ^ (1 / (1 + B))); %'A为与W0对应的在蓄水容量曲线的纵坐标endif (PE(T) + A) < Wmm % '部分产流R = PE(T) - Wm0 + W0 + Wm0 * ((1 - (PE(T) + A) / Wmm) ^ (1 + B));elseR = PE(T) - (Wm0 - W0) ; % '全部产流endif abs(R - PE(T)) <= 0.0001R = PE(T);Rimp = PE(T) * Imp1 ; % '直接径流endWwU = WwU + P(T) - R - EU(T); %% '第一层蓄水变化WwL = WwL - EL(T) ; % '第二层蓄水变化WwD = WwD - ED (T); %'第三层蓄水变化elseWwU = WwU + P(T) - EU(T); %% '第一层蓄水变化WwL = WwL - EL(T) ; % '第二层蓄水变化WwD = WwD - ED(T) ; %'第三层蓄水变化endif WwU > WMU % '由Ww(1) = Ww(1) + P - R－E(1)：E(1)两断Epp和Ww1WwL = WwL + WwU - WMU; % '由Ww(2) = Ww(2) + Ww(1) - WM(1)检查是否超标WwU = WMU; % '纠正if WwL > WMLWwD = WwD + WwL - WML;WwL = WML;endendif WwU < 0WwU = 0;end%'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝%'汇流计算部分%'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝%'水源划分X = FR0 ; % 'FR0产流面积if PE(T) <= 0 %'认为单是地下自由水在产流面积上的深为Rs(T) = 0;Rss(T) = S0 * KSSD * FR0 ; %'KSSD，ki，KGD（KG地下水出流）出流系数Rg(T) = S0 * KGD * FR0;S0 = S0 - (Rss(T) + Rg(T)) / FR0 ; % 's表示自由水在产流面积上的平均蓄水深elseFR0 = R / PE(T); % '用流量除以单位面积上的净雨（可以理解为产流深）即得产流面积S0 = X * S0 / FR0 ; % '产流面积变化的影响SS = S0;Q = R / FR0 ; % '为产流面积上的平均值NN = fix(Q / 5) + 1 ; % '每次入流按5毫米分成并取整数NN为了消除前向差分误差Q = Q / NN; % '一天分为CSng(NN)个时段Kssdd = (1 - (1 - (KGD + KSSD)) ^ (1 / NN)) / (1 + KGD / KSSD);Kgdd = Kssdd * KGD / KSSD;Rs(T) = 0;Rss(T) = 0;Rg(T) = 0;% ' SM流域的平均自由水容量Smm = (1 + Ex) * SM ; % ' Smm全流域最大的自由水蓄水容量if Ex < 0.001 ThenSmmf = Smm ; % ' Smmf表示产流面积最大一点的自由蓄水容量elseSmmf = Smm * (1 - (1 - FR0) ^ (1 / Ex)); % ' Ex表示流域自有水容水容量曲线的指数endSmf = Smmf / (1 + Ex); %' Smf表示产流面积上一点的自有水平均蓄水容量深for j = 1:NNif S0 > Smf %'s 表示自由水在产流面积上的平均蓄水深S0 = Smf;endAU = Smmf * (1 - (1 - S0 / Smf) ^ (1 / (1 + Ex)));if Q + AU <= 0Rsd(T) = 0 ; %' 当径流与此时刻的平均蓄水深之和小于0时不产流Rssd(T) = 0;Rgd(T) = 0;S0 = 0;else if Q + AU >= Smmf % ' 当径流与此时刻的平均蓄水深之和大于最大平均蓄水深全面产壤中流Rsd(T) = (Q + S0 - Smf) * FR0 ; % ' Rsd中d为分段的地面流Rssd(T) = Smf * Kssdd * FR0 ; % ' Rsd中d为分段的壤中流Rgd(T) = Smf * Kgdd * FR0 ; % ' Rsd中d为分段的地下径流S0 = Smf - (Rssd(T) + Rgd(T)) / FR0; % ' s表示自由水在产流面积上的平均蓄水深else if Q + AU < Smmf % ' 当径流与此时刻的平均蓄水深之和大于最大平均蓄水深部分产壤中流Rsd(T) = (Q - Smf + S0 + Smf * (1 - (Q + AU) / Smmf) ^ (1 + Ex)) * FR0;Rssd(T) = (S0+ Q - Rsd(T) / FR0) * Kssdd * FR0;Rgd(T) = (S0 + Q - Rsd(T) / FR0) * Kgdd * FR0;S0 = S0 + Q - (Rsd(T) + Rssd(T) + Rgd(T)) / FR0;endendendRs(T) = Rs(T) + Rsd(T) ; % '累计三流Rss(T) = Rss(T) + Rssd(T) ; % '累计Rg(T) = Rg(T) + Rgd(T);clear Rsd Rssd RgdendendOUT=[Rs;Rss;Rg];%Rs=OUT(:,1); Rss=OUT(:,2);Rg=OUT(:,3);Rs(T) = Rs(T) * (1 - Imp1) ; % '扣除不透水面积Rss(T) = Rss(T) * (1 - Imp1);Rg(T) = Rg(T) * (1 - Imp1);%'Qrs = (Rs + Rimp) * U%'Qrss = Rss * U * (1 - Ci) + Qrss0 * Ci%'Qrg = Rg * U * (1 - Cg) + Qrg0 * Cg%'＝＝＝＝＝＝＝＝＝＝◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎◎××%' '坡面汇流－－－－－－－－－－－汇流%'＝＝＝＝！＝＝＝＝＝＝￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＝＝＝＝＝＝＝＝Qrs(T) = (Rs(T) + Rimp) * U * (1 - Cs) + Qrs0 * Cs; % '地面水线性水库汇流系数CS Qrss(T) = Rss(T) * U * (1 - Ci) + Qrss0 * Ci ; % '壤中流线性水库汇流系数CI Qrg(T) = Rg(T) * U * (1 - Cg) + Qrg0 * Cg ; % '地下水线性水库汇流系数Cg Qtr(T) = Qrs(T) + Qrss(T) + Qrg(T);QsN(T) = (Rs(T) + Rimp) * U ; %'地面径流总和QIIGG(T) = Qrss(T) + Qrg(T) ; % '地下和壤中总和Qm(T) = Qtr(T); %马斯金根Qfm = Qtr(T); %非马斯金根Qrs0 = Qrs(T);Qrss0 = Qrss(T);Qrg0 = Qrg(T);Rs0 = Rs(T);Qr=Qtr' ;clear Qrs Qrss Qrg Rs R Rimp Rs Rss Rgend。
利用VB编程进行实用堰的消能计算
・４ ４・
式中， 为流速 系数 ；ｈ 为收 缩水深 。由式 （ １ ）
ｈ ａ ｌ＝ｈ ｃ １
ｈ ｃ Ｏ＝ ｑ ｌ ／ （ ｆ ａ ｉ ＊ （ （ ２ ＊ ９ ． ８ ， ｌ ｃ （ ｔ Ｏ —ｈ ａ １ ） ） （ １ ／ ２ ） ） ）
”
ｃ
ｑ ｌ＝Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ４ ． Ｔ ｅ ｘ ｔ ） ｆ ａ ｉ＝ Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ５ ． Ｔ ｅ ｘ ｔ ）
议 ：４ ． ５ ｈ
ｍ： Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ３ ． Ｔ ｅ ｘ ｔ ）
Ｐ＝ Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ １ ． Ｔ ｅ ｘ ｔ ） ｈ ｔ＝Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ２ ． Ｔ ｅ ｘ ｔ ）
１ 消力池深度计算的基本公式
消能计算，在水利工程实践 中是常见的，笔者 主 要是针 对 实用堰 的消能计 算 ，实 用堰 的流态 模 型 如 图 １所示 。
在堰 前 断面 与收缩 断面 存在 如 下关 系式 ：
Ｅｏ＝ ｈ ，－ １ ２ｇ
ｑ ２
（ １ ）
水流得到很好的消能，必须设法加大建筑物的下游 水深，使水跃控制在紧靠建筑物处，并形成淹没程 度不大 的水跃。 目 前 ，我国中小型水利工程中多是 采用降低护坦高程来形成消能池 ， 通过水跃发生的 表 面旋 滚和 强 烈紊动 来 消除余 能 。由水力 学分 析 可
上述 诸 式 中 ： ｈ ． 一 下游 正常 水深 ，ｍ ；
vb常用代码大全
移动无标题栏的窗体dim m（borderstyle=none）ouseX as integerdim mouseY as integerdim moveX as integerdim moveY as integerdim down as booleanform_mousedown: ’mousedown事件down=truemouseX=xmouseY=yform_mouseup: ’mouseup事件down=falseform_mousemoveif down=true thenmoveX=me。
left-mouseX+XmoveY=me.top—mouseY+Yme.move moveX，moveYend if*＊*＊＊*＊***＊*＊**＊＊*****＊＊＊*****＊＊＊＊*＊*＊****＊闪烁控件比如要闪烁一个label（标签）添加一个时钟控件间隔请根据实际需要设置 enabled属性设为true代码为：label1。
visible=not label1。
visible *＊＊＊＊******＊**＊＊＊**＊*＊*＊＊**＊＊＊*＊＊**＊****＊*＊禁止使用 Alt+F4 关闭窗口Private Declare Function DeleteMenu Lib "user32" （ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long ） As LongPrivate Declare Function GetMenuItemC ount Lib ”user32”（ByVal hMenu As Lon g） As LongPrivate Const MF_BYPOSITION = ＆H400&Private Sub Form_Load(）Dim hwndMenu As LongDim c As LonghwndMenu = GetSystemMenu（Me。
VBA编程中的常用代码
VBA编程中的常用代码Excel与VBA编程中的常用代码用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的!使用Dim语句Dim a as integer ' 声明A为整形变量Dim a '声明A为变体变量Dim a as string ' 声明A为字符串变量Dim a,b,c as currency ' 声明A,b,c 为货币变量声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal （当前不支持）、Date、String （只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。
强制声明变量Op tion Ex plicit，说明：该语句必在任何过程之前出现在模块中。
声明常数，用来代替文字值。
Const'常数的默认状态是PrivateConst My = 456声明P ublic 常数。
Public Const MyString = "HEL P"声明P rivate Integer 常数。
Private Const MyInt As Integer = 5在同一行里声明多个常数。
Const MyStr = "Hello", MyDouble As Double = 3.4567在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。
只要将该段代码加入到你的模块中。
Sub My_SelectSelection.CurrentRegion.SelectEnd sub删除当前单元格中数据的前后空格。
sub my_trimTrim(ActiveCell.Value) end sub使单元格位移精选文库sub my_offsetActiveCell.Offset(0, 1).Select' ActiveCell.Offset(0, -1).Select' ctiveCell.Offset(1 , 0).Select' ctiveCell.Offset(-1 , 0).Select'当前单元格向下移动一格当前单元格向上移动一格end sub如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往sub my_offset之下加一段代码 on error resume next注意以下代码都不再添加sub “代码名称”和end sub 请自己添加！给当前单元格赋值:ActiveCell.Value =" 你好！！！"给特定单元格加入一段代码：例如：在Al 单元格中插入 "HELLO "Range("a1").value="hello"又如：你现在的工作簿在sheet1上，你要往sheet2的Al 单元格中插入"HELLO " 1.sheets("sheet2").select range("a1").value="hello"或2.Sheets("sheet1").Range("a1").Value = "hello"说明：1. sheet2被打开，然后在将“ HELLO"放入到A1单元格中。
vb第六单元主要控件的例题代码 -回复
很高兴能为您撰写关于vb第六单元主要控件的例题代码的文章。
这个主题非常有趣，我会按照您的要求，以深度和广度兼具的方式来展开讨论。
第一部分：简介在本文中，我将以详细的例题代码为主线，逐步介绍vb第六单元主要控件的使用方法和实际应用。
在学习和掌握这些控件的过程中，我们将通过多个例题来深入理解其功能和用法。
第二部分：标签控件我们首先从标签控件开始。
标签控件是vb中常用的控件之一，可以用来显示静态文本信息。
在接下来的示例代码中，我们将演示如何创建和使用标签控件，并结合实际案例来展示其在用户界面设计中的应用。
第三部分：文本框控件我们将深入讨论文本框控件。
文本框控件可以用来接受用户的输入，是vb中非常常用的控件之一。
通过具体的例题代码，我们将演示文本框控件的基本操作以及如何获取用户输入的数值，字符串等信息。
第四部分：按钮控件我们将介绍按钮控件。
按钮控件是用户与程序进行交互的重要组成部分，在实际开发中应用广泛。
在本节中，我们将通过多个例题代码来展示按钮控件的创建、事件处理以及与其他控件的组合运用。
第五部分：总结与回顾在文章的结尾，我们将对前面所学的内容进行总结与回顾，提炼出控件使用的关键技巧和注意事项，帮助您更全面、深刻地理解和掌握vb 第六单元主要控件的例题代码。
个人观点和理解：在学习和使用vb中的控件时，深入理解其功能和用法是非常重要的。
通过本文的学习，希望您能够对vb第六单元主要控件有更加全面、深刻和灵活的理解，并能够在实际开发中熟练运用这些知识。
接下来，我将开始着手撰写具体的例题代码和解析。
在文章的内容中，我会多次提及vb第六单元主要控件的例题代码，以便更好地帮助您理解和掌握相关知识。
以上是本文的大致写作计划，我将在文章撰写完成后为您送去第一版草稿，请您随时查看。
如果有其他要求或变更，欢迎随时告知。
期待能在本文中为您呈现一篇高质量、深度和广度兼具的中文文章！以上是本文首部分的简介和大致写作计划，接下来我将继续为您展开vb第六单元主要控件的例题代码。
matlap新安江三水源模型程序
.新安江模型程序核心源代码function [fit,dc,result]=XAJ(XX)% XAJ是新安江的运行程序,用于单纯形和遗传算法调用,也用于新安江模型的预报% XX是调用的优化参数% fit 返回目标函数的适值% dc返回有效性系数.% result是一个数组,返回格式为[时间,雨量,实测流量,计算流量];.%% $Date: 2005/5/25 $%email:******************.cn% 输入起始值W,WU,WL,WD,QGWU=20;WL=50;WD=10;FR=0.89; S=2; AREA=7547;U=AREA/3.6;W=WU+WL+WD;%输入雨量E,蒸散发能力P,实测流量QSglobal DA TA;TIME=DA TA(:,1);P=DA TA(:,2);EM=DATA(:,3);QS=DATA(:,4);TRSS0=0.3.*QS(1);TRG0=0.4.*QS(1);% 参数处理[num,numvars]=size(XX);% 优化参数A_K=XX(:,1);A_SM=XX(:,2);A_KG=XX(:,3);A_KSS=XX(:,4);A_KKG=XX(:,5);A_KKSS=XX(:,6);A_CS=XX(:,7);A_WUM=XX(:,8);A_WLM=XX(:,9);A_WDM=XX(:,10);A_IMP=XX(:,11);A_B=XX(:,12);A_C=XX(:,13);A_EX=XX(:,14);A_L=XX(:,15);A_WM=A_WUM+A_WLM+A_WDM;for I=1:num %%%% %%% 对每组数计算K=A_K(I);SM=A_SM(I);KG=A_KG(I);KSS=A_KSS(I);KKG=A_KKG(I);KKSS=A_KKSS(I);CS=A_CS(I);WUM=A_WUM(I);WLM=A_WLM(I);WDM=A_WDM(I);WM=WUM+WLM+WDM;IMP=A_IMP(I);B=A_B(I);C=A_C(I);EX=A_EX(I);L=A_L(I);L=round(L);WMM=(1+B).*WM/(1-IMP);M=size(P,1);PE=P-K.*EM;for T=1:M %% T以时段为单位计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %以下为产流计算if PE(T)<0R=0;elseif W>=WMA=WMM;elseA=WMM*(1-(1-W/WM).^(1/(1+B)));endif A+PE(T)>0if A+PE(T)<WMMR=PE(T)-WM+W+WM.*(1-(PE(T)+A)./WMM).^(1+B);elseR=PE(T)+W-WM;endelseR=0;endend %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 % 以下为蒸发计算zhengfaif PE(T)<0if WU+PE(T)>0EU=K*EM(T);ED=0;EL=0;WU=WU+PE(T);elseEU=WU+P(T);WU=0;if WL>C*WLMEL=(K.*EM(T)-EU).*WL/WLM;WL=WL-EL;ED=0;elseif WL>C.*(K.*EM(T)-EU)EL=C.*(K.*EM(T)-EU);WL=WL-EL;ED=0;elseEL=WL;WL=0;ED=C.*(K*EM(T)-EU)-EL;WD=WD-ED;endendendelseEU=K.*EM(T);ED=0;EL=0;if WU+PE(T)-R<WUMWU=WU+PE(T)-R;elseif WU+WL+PE(T)-WUM>WLMWU=WUM;WL=WLM;WD=W+PE(T)-R-WU-WL;elseWU=WUM;WL=WU+WL+PE(T)-R-WUM;endendendE=EU+EL+ED;W=WU+WL+WD;% 以下为分水计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SMM=(1+EX).*SM;if (PE(T)<=0)|(R<=0)RS=0;RG=S.*KG.*FR;RSS=RG.*KSS./KG;elseX=FR;FR=(R-PE(T).*IMP)./PE(T);S=X.*S./FR;SS=S;Q=R./FR;G=fix(Q./5)+1;Q=Q./G;%KSSD=KSS.^(1/G);KGD=KSSD.*KG./KSS;RS=0;RG=0;RSS=0;for J=1:Gif S>=SMAU=SMM;elseAU=SMM.*(1-(1-S./SM).^(1./(1+EX)));endif AU+Q<SMMRS=(Q-SM+S+SM.*(1-(Q+AU)./SMM).^(1+EX)).*FR+RS;elseRS=(Q+S-SM).*FR+RS;endS=J.*Q-RS./FR+S;RG=S.*KGD.*FR+RG;RSS=S.*KSSD.*FR+RSS;S=J.*Q+SS-(RS+RSS+RG)./FR;endendOUT(T,:)=[RS,RSS,RG];end % 一次数据演算完%以下为汇流计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% RS=OUT(:,1); RSS=OUT(:,2);RG=OUT(:,3);TRS(1)=RS(1).*U;TRSS(1)=TRSS0 ;TRG(1)=TRG0 ;TR(1)=TRS(1)+TRSS(1)+TRG(1);for T=2:MTRS(T)=RS(T).*U;TRSS(T)=TRSS(T-1).*KKSS+RSS(T).*(1-KKSS).*U;TRG(T)=TRG(T-1).*KKG+RG(T).*(1-KKG).*U;TR(T)=TRS(T)+TRSS(T)+TRG(T);endQJ=TR;if L<0 L=0;endfor T=L+2:MQJ(T)=CS.*QJ(T-1)+(1-CS).*TR(T-L);end%以下为目标函数计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% alf=0.6;y1=0;y2=0;n1=1;n2=1;for T=1:Mif QJ(T)>800y1=(QJ(T)-QS(T)).^2+y1;n1=n1+1;elsey2=(QJ(T)-QS(T)).^2+y2;n2=n2+1;endendq0=mean(QS);q1=mean(QJ);y=(y1*alf/n1+y2*(1-alf)/n2)*(1+abs(q0-q1)/q0);fit(I)=y;%以下为(有效性系数)确定性系数计算%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%f1=sum( (QS-QJ').^2);f2=sum((QS-mean(QS).*ones(M,1)).^2);dq=1-f1/f2;dc(I)=dq;result =[TIME,P,QS,QJ'];end %一组参数计算结束Ifit=-fit'; 遗传算法为了求最大值,在此加负号.dc=dc';。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
Dim P(25), EI(25), PE(25), A(25), AU(25), FR(25), W(25), WU(25), WL(25), WD(25), E(25), EU(25), EL(25), ED(25), R2(25), R3(25), RS(25), RG(25), RSS(25), RIMP(25), QR(25), QRG(25), QRSS(25), QRSP(25), S(25), UH(3), q(3) As SingleDim N, m, K, B, C, D, EX, SM, SSM, MP, KG, KSS, KKSS, KGD, KSSD, KKGD, KKG, WM, WWMM, WUM, WLM, WDM, DT, UN, QRSS0, QRG0, F, i, j As SinglePrivate Sub Command1_Click()Static ik As Integerik = ik + 1Command1.Caption = "您还需计算" & 7 - ik & " 次"If ik = 7 Then Command1.Enabled = FalseSet xlbook = GetObject(App.Path & "\" & "xaj.xls")xlbook.application.Visible = True: xlbook.windows(1).Visible = TrueSet xlsheet1 = xlbook.worksheets("sheet1")Set xlsheet2 = xlbook.worksheets("sheet2")K = xlsheet1.Cells(3, 1)C = xlsheet1.Cells(3, 2)B = xlsheet1.Cells(3, 3)SM = xlsheet1.Cells(3, 5)WUM = xlsheet1.Cells(3, 6)WLM = xlsheet1.Cells(3, 7)WDM = xlsheet1.Cells(3, 8)EX = xlsheet1.Cells(3, 9)KG = xlsheet1.Cells(3, 10)KSS = xlsheet1.Cells(3, 11)KKG = xlsheet1.Cells(3, 12)KKSS = xlsheet1.Cells(3, 13)DT = xlsheet1.Cells(3, 14)UH(1) = xlsheet1.Cells(3, 15)UH(2) = xlsheet1.Cells(3, 16)UH(3) = xlsheet1.Cells(3, 17)WU(0) = xlsheet1.Cells(3, 18)WL(0) = xlsheet1.Cells(3, 19)WD(0) = xlsheet1.Cells(3, 20)FR(0) = xlsheet1.Cells(3, 21)S(0) = xlsheet1.Cells(3, 22)QRSS(0) = xlsheet1.Cells(3, 23)QRG(0) = xlsheet1.Cells(3, 24)F = xlsheet1.Cells(3, 25)MP = 0: RS(0) = 0: W(0) = 150WM = (WUM + WLM + WDM)WWMM = WM * (1 + B)SSM = SM * (1 + EX)KSSD = (1 - (1 - (KG + KSS)) ^ (DT / 24)) / (1 + KG / KSS)KGD = KSSD * KG / KSSKKGD = KKG ^ (DT / 24)N = 24For i = 1 To NP(i) = xlsheet1.Cells(5, i + 1)EI(i) = xlsheet1.Cells(8, i + 1)PE(i) = P(i) - K * EI(i)Next iFor i = 1 To N '计算产流If PE(i) > 0 ThenA(i) = WWMM * (1 - (1 - W(i - 1) / WM) ^ (1 / (1 + B)))If PE(i) + A(i) >= WWMM ThenR2(i) = PE(i) - (WM - W(i - 1))ElseR2(i) = PE(i) - (WM - W(i - 1) - WM * (1 - (PE(i) + A(i)) / WWMM) ^ (1 + B)) End IfIf PE(i) > 0 ThenFR(i) = R2(i) / PE(i)ElseFR(i) = 1 - (1 - S(i - 1) / WM) ^ (B / (1 + B))End IfAU(i) = SSM * (1 - (1 - S(i - 1) / SM) ^ (1 / (1 + EX)))If PE(i) + AU(i) < SSM ThenRS(i) = (PE(i) - SM + S(i - 1) + SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * FR(i) RSS(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * KSSD * FR(i)RG(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * KGD * FR(i)S(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * (1 - KSSD - KGD) ElseRS(i) = (PE(i) - SM + S(i - 1)) * FR(i)RSS(i) = SM * KSSD * FR(i)RG(i) = SM * KGD * FR(i)S(i) = SM * (1 - KSSD - KGD)End IfElseR2(i) = 0FR(i) = 1 - (1 - W(i - 1) / WM) ^ (B / (1 + B))RS(i) = 0RSS(i) = S(i - 1) * KSSD * FR(i)RG(i) = S(i - 1) * KGD * FR(i)S(i) = S(i - 1) * (1 - KSSD - KGD)End IfRIMP(0) = 0RIMP(i) = P(i) * MPR3(i) = RS(i) + RSS(i) + RG(i)Next iFor m = 1 To 3 ‘计算汇流q(m) = F * UH(m) / (3.6 * DT)Next mQRSP(0) = 0QRSP(1) = 0 * (RS(1) + RIMP(1)) + q(1) * (RS(0) + RIMP(0))QRSP(2) = 0 * (RS(2) + RIMP(2)) + q(1) * (RS(1) + RIMP(1)) + q(2) * (RS(0) + RIMP(0))For H = 3 To NQRSP(H) = 0 * (RS(H) + RIMP(H)) + q(1) * (RS(H - 1) + RIMP(H - 1)) + q(2) * (RS(H - 2) + RIMP(H - 2)) + q(3) * (RS(H - 3) + RIMP(H - 3))Next HQRSS(0) = 40For L = 1 To NQRSS(L) = QRSS(L - 1) * KKSS ^ (DT / 24) + RSS(L) * (1 - KKSS ^ (DT / 24)) * F / (3.6 * DT)Next LQRG(0) = 20For L = 1 To NQRG(L) = QRG(L - 1) * KKGD ^ (DT / 24) + RG(L) * (1 - KKGD ^ (DT / 24)) * F / (3.6 * DT)Next LFor m = 0 To NQR(m) = QRSP(m) + QRSS(m) + QRG(m)Next mFor j = 1 To N '计算蒸散发If WU(j - 1) + P(j) < K * EI(j) ThenEU(j) = WU(j - 1) + P(j)If WL(j - 1) / WLM < C ThenIf WL(j - 1) < C * (K * EI(j) - EU(j)) ThenEL(j) = WL(j - 1)ED(j) = C * (K * EI(j) - EU(j)) - EL(j)ElseEL(j) = C * (K * EI(j) - EU(j))ED(j) = 0End IfElseEL(j) = (K * EI(j) - EU(j)) * WL(j - 1) / WLMED(j) = 0End IfElseEU(j) = K * EI(j)EL(j) = 0ED(j) = 0End IfIf WU(j - 1) + P(j) - R2(j) - EU(j) >= WUM ThenIf WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM >= WLM ThenWU(j) = WUMWL(j) = WLMIf WD(j - 1) - ED(j) + (WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM - WLM) >= WDM ThenWD(j) = WDMEnd IfElseWU(j) = WUMWL(j) = WL(j - 1) + EL(j) + (WU(j - 1) + P(j) - R2(j) - EU(j) - WUM)WD(j) = WD(j - 1) - ED(j)End IfElseWU(j) = WU(j - 1) + P(j) - R2(j) - EU(j)WL(j) = WL(j - 1) - EL(j)WD(j) = WD(j - 1) - ED(j)End IfW(j) = WU(j) + WL(j) + WD(j)E(j) = EU(j) + EL(j) + ED(j)Next jFor j = 0 To NFor L = 4 To 21xlsheet2.Cells(5 + j, L) = ""Next LNext jFor j = 1 To N '输出xlsheet2.Cells(5 + j, 2) = P(j)xlsheet2.Cells(5 + j, 3) = EI(j)xlsheet2.Cells(5 + j, 4) = PE(j)xlsheet2.Cells(5 + j, 5) = RS(j)xlsheet2.Cells(5 + j, 6) = RSS(j)xlsheet2.Cells(5 + j, 7) = RG(j)xlsheet2.Cells(5 + j, 8) = R3(j)'xlsheet2.cells(5 + j, 9) = RIMP(j)xlsheet2.Cells(5 + j, 9) = S(j)xlsheet2.Cells(5 + j, 10) = EU(j)xlsheet2.Cells(5 + j, 11) = EL(j)xlsheet2.Cells(5 + j, 12) = ED(j)xlsheet2.Cells(5 + j, 13) = E(j)Next jFor H = 0 To Nxlsheet2.Cells(5 + H, 14) = WU(H)xlsheet2.Cells(5 + H, 15) = WL(H)xlsheet2.Cells(5 + H, 16) = WD(H)xlsheet2.Cells(5 + H, 19) = QRSS(H)xlsheet2.Cells(5 + H, 20) = QRG(H)xlsheet2.Cells(5 + H, 17) = W(H)xlsheet2.Cells(5 + H, 18) = QRSP(H)xlsheet2.Cells(5 + H, 21) = QR(H) Next HEnd SubPrivate Sub Command2_Click()EndEnd Sub。