您的位置：360文档中心› 新安江模型VB代码

新安江模型VB代码

合集下载

VB代码大全1

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经典代码

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编程进行实用堰的消能计算
知 ，消 力池池 深 随跃 后水深 和 下游水 深 差值 的增 大 而 增 大 ，而消 力池 的长 度又 随流 量 的增 大 而增 大 。 我 们传 统 的 消 力 池 水 力 计 算 是 借 助 一 些 专 门
・４ ４・
式中， 为流速 系数 ；ｈ 为收 缩水深 。由式 （ １ ）
ｈ ａ ｌ＝ｈ ｃ １
ｈ ｃ Ｏ＝ ｑ ｌ ／ （ ｆ ａ ｉ ＊ （ （ ２ ＊ ９ ． ８ ， ｌ ｃ （ ｔ Ｏ —ｈ ａ １ ） ） （ １ ／ ２ ） ） ）
”
ｃ
ｑ ｌ＝Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ４ ． Ｔ ｅ ｘ ｔ ） ｆ ａ ｉ＝ Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ５ ． Ｔ ｅ ｘ ｔ ）
议 ：４ ． ５ ｈ
ｍ： Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ３ ． Ｔ ｅ ｘ ｔ ）
Ｐ＝ Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ １ ． Ｔ ｅ ｘ ｔ ） ｈ ｔ＝Ｖ ａ ｌ （ Ｔ ｅ ｘ ｔ ２ ． Ｔ ｅ ｘ ｔ ）
１ 消力池深度计算的基本公式
消能计算，在水利工程实践 中是常见的，笔者 主 要是针 对 实用堰 的消能计 算 ，实 用堰 的流态 模 型 如 图 １所示 。
在堰 前 断面 与收缩 断面 存在 如 下关 系式 ：
Ｅｏ＝ ｈ ，－ １ ２ｇ
ｑ ２
（ １ ）
水流得到很好的消能，必须设法加大建筑物的下游 水深，使水跃控制在紧靠建筑物处，并形成淹没程 度不大 的水跃。 目 前 ，我国中小型水利工程中多是 采用降低护坦高程来形成消能池 ， 通过水跃发生的 表 面旋 滚和 强 烈紊动 来 消除余 能 。由水力 学分 析 可
上述 诸 式 中 ： ｈ ． 一 下游 正常 水深 ，ｍ ；

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编程中的常用代码

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第六单元主要控件的例题代码，以便更好地帮助您理解和掌握相关知识。

以上是本文的大致写作计划，我将在文章撰写完成后为您送去第一版草稿，请您随时查看。

如果有其他要求或变更，欢迎随时告知。

期待能在本文中为您呈现一篇高质量、深度和广度兼具的中文文章！以上是本文首部分的简介和大致写作计划，接下来我将继续为您展开vb第六单元主要控件的例题代码。

matlap新安江三水源模型程序

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';。

四等水准测量VB 程序 代码

四等水准测量VB 程序 代码

四等水准测量VB 程序Private Sub Command1_Click()Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SingleBBU = Val(ltrim$(rtrim$(Text1.Text) ))BBM = Val(ltrim$(rtrim$(Text2.Text) ))BBL = Val(ltrim$(rtrim$(Text3.Text) ))BRM = Val(ltrim$(rtrim$(Text4.Text) ))BK = Val(ltrim$(rtrim$(Text9.Text) ))FBU = Val(ltrim$(rtrim$(Text5.Text) ))FBM = Val(ltrim$(rtrim$(Text6.Text) ))FBL = Val(ltrim$(rtrim$(Text7.Text) ))FRM = Val(ltrim$(rtrim$(Text8.Text) ))FK = Val(ltrim$(rtrim$(Text10.Text) ))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 0.1Elsefdh = fdh + 0.1End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 100 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 0.003 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 0.003 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 0.005 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差'MsgBox "测站高差="& Str$(dh) &”m”,vbokonly,”计算结果” End IfDim hsjl As SingleDim qsjl As SingleDim qhsjc As SingleDim qhsjljc As SingleDim hchhmdsc As SingleDim qchhmdsc As SingleDim hmgc As SingleDim hmgc1 As SingleDim hhmgczc As Singlehsjl = (BBU - BBL) * 100qsjl = (FBU - FBL) * 100qhsjc = qsjl - hsjlhchhmdsc = BBU - BRMqchhmdsc = FBU - FRMhmgc = BBM - FBMhmgc1 = BRM - FRMhhmgczc = hmgc - hmgc1Text1.Text = Format(hsjl, "0.0000")Text2.Text = Format(qsjl, "0.0000")Text3.Text = Format(qhsjc, "0.0000")Text4.Text = Format(qhsjljc, "0.0000")Text5.Text = Format(hchhmdsc, "0.0000")Text6.Text = Format(qchhmdsc, "0.0000")Text7.Text = Format(hmgc, "0.0000")Text9.Text = Format(hhmgczc, "0.0000")Text8.Text = Format(hmgc1, "0.0000")End SubDim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text))) BBM = Val(LTrim$(RTrim$(Text2.Text))) BBL = Val(LTrim$(RTrim$(Text3.Text))) BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text))) FBM = Val(LTrim$(RTrim$(Text6.Text))) FBL = Val(LTrim$(RTrim$(Text7.Text))) FRM = Val(LTrim$(RTrim$(Text8.Text)))Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text)))BBM = Val(LTrim$(RTrim$(Text2.Text)))BBL = Val(LTrim$(RTrim$(Text3.Text)))BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text)))FBM = Val(LTrim$(RTrim$(Text6.Text)))FBL = Val(LTrim$(RTrim$(Text7.Text)))FRM = Val(LTrim$(RTrim$(Text8.Text)))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 100Elsefdh = fdh + 100End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 0.1 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 3 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 3 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 5 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差' Text10.Text = dh / 1000End IfEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text8.Text = ""Text9.Text = ""Text10.Text = ""Text1.SetFocusEnd Sub。

VB编程常用代码大全讲解学习

VB编程常用代码大全讲解学习

VB编程常用代码大全讲解学习V B编程常用代码大全VB编程常用代码大全1.数值型函数：abs(num): 返回绝对值sgn(num): num>0 1; num=0 0; num<0 -1;判断数值正负hex(num): 返回十六进制值直接表示：&Hxx 最大8位oct(num): 返回八进制值直接表示：&Oxx 最大8位sqr(num): 返回平方根 num>0int(num): 取整 int(99.8)=99; int(-99.2)=100fix(num): 取整 fix(99.8)=99; fix(-99.2)=99round(num,n): 四舍五入取小数位round(3.14159,3)=3.142 中点数值四舍五入为近偶取整 round(3.25,1)=3.2log(num): 取以e为底的对数 num>0exp(n): 取e的n次幂通常用 num^nsin(num): 三角函数，以弧度为值计算(角度*Pai)/180=弧度con(num); tan(num); atn(num)2.字符串函数：len(str)：计算字符串长度中文字符长度也计为一！mid(str,起始字符,[读取长度])：截取字符串中间子字符串left(str,nlen)：从左边起截取nlen长度子字符串right(str,nlen)：从右边起截取nlen长度子字符串Lcase(str)：字符串转成小写Ucase(str)：字符串转成大写trim(str)：去除字符串两端空格Ltrim(str)：去除字符串左侧空格Rtrim(str)：去除字符串右侧空格replace(str,查找字符串,替代字符串,[起始字符,替代次数,比较方法])：替换字符串注：默认值：起始字符1；替代次数不限；比较方法区分大小写（0）InStr([起始字符,]str,查找字符串[,比较方法])：检测是否包含子字符串可选参数需同时选返回起始位置InStrRev(str,查找字符串[,起始字符][,比较方法])：反向检测是否包含子字符串返回起始位置space(n)：构造n个空格的字符串string(n,str)：构造由n个str第一个字符组成的字符串StrReverse(str)：反转字符串split(str,分割字符串[,次数][,比较方法])：以分割字符串为分割标志将字符串转为字符数组可选参数需同时选3.数据类型转换函数：Cint(str)：转换正数 True -1；False 0；日期距离1899/12/31天数；时间上午段 0；下午段 1；Cstr(str)：日期输出格式yyyy/mm/dd；时间输出格式Am/Pm hh:mm:ss。

浙江省高中信息技术学考vb知识点汇总

浙江省高中信息技术学考vb知识点汇总

VB 知识点汇总一． 算法：指解决问题的方法。

二．算法的特征：1. 有穷性。

算法的有穷性是指算法必须能在执行有限个步骤之后终止。

2.确切性。

算法的每一步骤必须有确切的定义，不能有歧义。

3.输入项。

一个算法有0个或多个输入，以刻画运算对象的初始情况，所谓0个输入是指算法本身定出了初始条件。

4.输出项。

一个算法有一个或多个输出，以反映对输入数据加工后的结果。

没有输出的算法是毫无意义的。

5.可行性。

算法中执行的任何计算步骤都是可以被分解为基本的可执行的操作步，即每个计算步都可以在有限时间内完成（也称之为有效性）。

三．描述算法的表示方法：1.自然语言。

2.流程图。

3.程序代码。

4.伪代码。

四．对象：具有某些特征的具体事物的实体。

五．类：是对同种对象的集合与抽象，它包含这种对象的属性描述和行为定义。

（VB 工具箱中的控件就是类，设计窗体时，将它们放在窗体上时就是该类的对象。

）前面的label1是对象名称，后面的label 是控件名，也就是类名称。

六．属性：对象的特性、名称、大小、形状、颜色及功能被称为属性。

属性的表示：对象名.属性名 如：指文本框中的值伪代码例子： Begin （算法开始） 输入 A ，B ，C IF A>B 则 A →Max 否则 B →Max属性值的设置：对象名.属性名=属性值如：=”苹果”注意：这里的“=”是赋值号，不是等号，因此这是一句赋值语句。

七．方法：对象能完成的动作。

中的print就是一个方法。

八．事件：指对对象的一个调用。

如：command1_click 按钮上的单击事件请注意格式：对象名_动作九．常用控件及属性：其他属性：: 文本的对齐方式：字体:背景颜色4. visible: 设置对象是否可见:设置对象是否可用十．基本数据类型十一.常量1.直接常量：直接在程序中使用常数2.符号常量：符号常量的定义： const 常量名=常数如：const pi=然后在程序中凡是要用到这个常数的地方，都用pi来代替就行了。

vb实验代码大全

vb实验代码大全

vb实验代码大全实验31Public Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton1.ClickDim i As IntegerDim n As IntegerDim s As Singles = 0n = InputBox("请输入n")For i = 1 To ns = s + 1 / (i * (i + 1))NextMsgBox("s=" & s)End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton2.ClickDim a(10) As Integeri As Integer DimDim x As IntegerDim y As Integerx = 0y = 0For i = 1 To 10a(i) = InputBox("请输入第" & i & "个数")If i Mod 2 = 0 Thenx = x + a(i)Elsey = y + a(i)End IfNextMsgBox("下标为奇数的元素和为" & y & "下标为偶数的元素和为" & x) End SubPrivate Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton3.ClickDim r As Integer, s As Integer, c As Integer, y(5) As String, j As Integer, ys As Stringys = ""r = 1Do While r <= 4c = 10 - r : s = 1y(r) = y(r) & Space(c + s)Do While s <= 2 * r - 1y(r) = y(r) & "*"s = s + 1Loopr = r + 1LoopFor j = 1 To 4ys = ys & y(j) & Chr(10)NextMsgBox(ys)End SubPrivate Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton4.ClickDim r As Integer, s As Integer, c As Integer, y(5) As String, ys As Stringys = ""r = 4Do While r >= 1c = 10 - r : s = 1ys = ys & Space(c + s)Do While s <= 2 * r - 1ys = ys & "*"s = s + 1Loopr = r - 1ys = ys & Chr(10)LoopMsgBox(ys)End SubPrivate Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton5.ClickEnd SubPrivate Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton6.ClickDim a(19) As IntegerDim s As StringDim i As IntegerDim x As IntegerDim y As Integerx = 0y = 0s = ""For i = 0 To 19a(i) = Int(Rnd() * 100)s = s & a(i) & ","If a(i) > 50 Thenx = x + 1ElseIf a(i) < 10 Theny = y + 1End IfNextMsgBox(s & vbCrLf & "50万元以上的业务人数为" & x & ",10万元以下的业务人数为" & y)End SubSub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PrivateButton7.ClickDim a(19) As IntegerDim t As IntegerDim i As IntegerDim j As IntegerDim x As StringDim y As Stringx = ""y = ""For i = 0 To 19a(i) = Int(Rnd() * 100)x = x & a(i) & ","NextFor i = 0 To 19For j = 19 To i + 1 Step -1If a(j) < a(j - 1) Thent = a(j)a(j) = a(j - 1)a(j - 1) = tEnd IfNexty = y & a(i) & ","NextMsgBox(x & vbCrLf & y)End SubPrivate Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton8.ClickDim a As IntegerDim b(9) As IntegerDim s As Integeru As String DimDim i As IntegerRandomize()a = Int(Rnd() * 90000000 + 10000000)For i = 0 To 7s = Mid(a, i + 1, 1)b(s) = b(s) + 1Nextu = "8位数为:(" & a & ")" & vbCrLfFor i = 0 To 9u = u & i & "出现次数:" & b(i) & vbCrLfNextMsgBox(u)End SubPrivate Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton9.ClickDim b(19) As IntegerDim i As IntegerDim s As Strings = ""For i = 0 To 19b(i) = Int(Rnd() * 90000000 + 10000000)s = s & b(i) & vbCrLfNextMsgBox(s)End SubPrivate Sub Button10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton10.ClickDim i As IntegerDim t As SingleDim s As Singlei = 1t = 1 / (i * (i + 1))s = 0Do While t >= 0.000001s = s + ti = i + 1t = 1 / (i * (i + 1))LoopMsgBox("s=" & s)End SubPrivate Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton11.ClickDim i As IntegerDim t As SingleDim s As Singlei = 1t = 1 / (i * (i + 1))s = 0Dos = s + ti = i + 1t = 1 / (i * (i + 1))Loop While t >= 0.000001MsgBox("s=" & s)End SubPrivate Sub Button14_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton14.ClickDim a() As IntegerDim i As Integern As Integer DimDim x As IntegerDim y As Integerx = 0y = 0n = InputBox("请输入数组的数量")ReDim a(n)For i = 1 To na(i) = InputBox("请输入第" & i & "个数")If i Mod 2 = 0 Thenx = x + a(i)Elsey = y + a(i)End IfNextMsgBox("下标为奇数的元素和为" & y & "下标为偶数的元素和为" & x)End SubPrivate Sub Button15_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton15.ClickDim s As StringDim y As StringDim t As StringDim a() As StringDim i As IntegerDim j As IntegerDim l As Integert = ""y = ""s = InputBox("请输入要排序的字符串")l = Len(s)ReDim a(l)For i = 1 To la(i) = Mid(s, i, 1)NextFor i = 1 To lFor j = l To i + 1 Step -1If a(j) < a(j - 1) Thent = a(j)a(j) = a(j - 1)a(j - 1) = tEnd IfNexty = y & a(i)NextMsgBox(s & vbCrLf & y)End SubPrivate Sub Button16_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton16.ClickDim n As IntegerDim i As Integerj As Integer DimDim s As StringDim t As StringDim i_0 As IntegerDim j_0 As IntegerDim mfz_bz(9, 9) As StringDim mfz(9, 9) As Stringn = InputBox("请输入魔方阵阶数 N")If n < 3 Or n > 9 Or n Mod 2 <> 1 ThenMsgBox("您输入的魔方阵阶数 N 不在范围内，请输入3-9之间的奇数") Exit SubEnd If'初始化For i = 1 To 9For j = 1 To 9mfz_bz(i, j) = 0mfz(i, j) = ""Next jNext imfz(1, n \ 2 + 1) = 1mfz_bz(1, n \ 2 + 1) = 1i_0 = 1j_0 = n \ 2 + 1For ysz = 2 To n * nIf mfz(i_0, j_0) > n And (mfz(i_0, j_0) Mod n = 0) Then i = i_0 + 1j = j_0ElseIf i_0 = 1 Theni = nj = j_0 + 1ElseIf j_0 = n Theni = i_0 - 1j = 1Elsei = i_0 - 1j = j_0 + 1End IfIf mfz_bz(i, j) = 1 Then i = i_0 + 1j = j_0End Ifmfz(i, j) = yszmfz_bz(i, j) = 1i_0 = ij_0 = jNext yszMsgBox("魔方阵排列完毕") s = ""For i = 1 To 9For j = 1 To 9t = mfz(i, j)s = s & Format(t, "{0,4}") Nexts = s & vbCrLfNextMsgBox(s)End SubEnd Class实验30Public Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim a As String, b As String, c As StringDim x1 As Single, x2 As Singlea = InputBox("输入A", "输入数据Y", , 500, 500)b = InputBox("输入B", "输入数据Y", , 500, 500)c = InputBox("输入C", "输入数据Y", , 500, 500)x1 = -b + Math.Sqrt(b ^ 2 - 4 * a * c) / 2 / a2 = -b - Math.Sqrt(b ^ 2 - 4 * a * c) / 2 / a xMsgBox("x1=" & Format(x1, "###.###") & " x2=" & Format(x2,"###.###"))End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.ClickDim x As IntegerDim y As IntegerDim z As Singlex = 5y = 9z = (x ^ 3 + x * y + y ^ 3) / (2 * x * y)MsgBox("(x ^ 3 + x * y + y ^ 3) / (2 * x * y)=" & z)End SubPrivate Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.ClickDim x As SingleDim y As Singlex = InputBox("输入x")y = Math.Log(20) + Math.Abs(x - 16)MsgBox("Math.Log(20) + Math.Abs(x - 16)=" & y)End SubPrivate Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.ClickDim x As SingleDim y As Singlex = InputBox("输入x")y = 0.231 * x + 1.36MsgBox("0.231 * x + 1.36=" & y)End SubPrivate Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.ClickConst g As Single = 9.81Dim v As Single, o As Single, t As Single, s As Singlev = InputBox("输入初速度")o = InputBox("输入角度")t = 2 * v * Math.Sin(o * Math.PI / 180) / gs = v * Math.Sin(2 * o * Math.PI / 180) / gMsgBox("落地所需时间" & t & " 落地时运动的射程" & s)End SubEnd ClassPublic Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim x As Integerx = Int(Rnd() * 100)If x Mod 2 = 0 ThenMsgBox(x & "是偶数")ElseMsgBox(x & "是奇数")End IfEnd SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton2.ClickDim a As Single, b As Single, c As Single, x As Single, y As Singlea = InputBox("请输入a")b = InputBox("请输入b")c = InputBox("请输入c")If a > b Thenx = ay = bElsex = by = aEnd IfIf c > x Thenx = cElseIf c < y Theny = cIf EndEnd IfMsgBox("最大数" & x & " 最小数" & y)End SubPrivate Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton3.ClickDim t As Single, f As Singlet = InputBox("请输入t")If t < 120 Thenf = 0.06 * t + 2MsgBox("f = 0.06 * t + 2=" & f)Elsef = 0.06 * t * 0.85MsgBox("f = 0.06 * t * 0.85=" & f)End IfEnd SubPrivate Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton4.ClickDim x As SingleDim y As Stringx = InputBox("请输入成绩")If x >= 90 Theny = "A"ElseIf x >= 80 Theny = "B"ElseIf x >= 70 Theny = "C"ElseIf x >= 60 Theny = "D"Elsey = "E"End IfMsgBox("成绩" & x & "等级为" & y)End SubPrivate Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton5.ClickDim x As Single, y As Singlex = InputBox("请输入x")Case x SelectCase Is <= -1y = x - 1Case Is <= 2y = 2 * xCase Is <= 10y = x * (x + 2)Case Elsey = 0End SelectMsgBox("y=" & y)End SubPrivate Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton6.ClickDim a As String, b As String, c As StringDim x1 As Single, x2 As Single, x As Singlea = InputBox("输入A", "输入数据Y", , 500, 500)b = InputBox("输入B", "输入数据Y", , 500, 500)c = InputBox("输入C", "输入数据Y", , 500, 500)x = b ^ 2 - 4 * a * cIf x >= 0 Thenx1 = -b + Math.Sqrt(x) / 2 / ax2 = -b - Math.Sqrt(x) / 2 / aMsgBox("x1=" & Format(x1, "###.###") & " x2=" & Format(x2,"###.###"))Elsex1 = Math.Sqrt(-x) / 2 / ax2 = -Math.Sqrt(-x) / 2 / aMsgBox("x1=" & -b / 2 / a & x1 & "i x2=" & -b / 2 / a & x2 & "i") End IfEnd SubPrivate Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.ClickDim x As Single, y As Singlex = InputBox("请输入x")If x <= -1 Theny = x - 1ElseIf x <= 2 Theny = 2 * xElseIf x <= 10 Theny = x * (x + 2)End IfMsgBox("y=" & y)End SubEnd Class实验32Public Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim n As Integern = InputBox("请输入需求阶乘之和的任意整数n")If n Mod 2 = 0 ThenMsgBox("偶数序列" & Str(n) & " 的阶乘之和:" & Str(factorial(n))) ElseMsgBox("请输入偶数")End IfEnd SubPublic Function factorial(ByVal x) As IntegerDim s As IntegerDim t As IntegerDim i As IntegerDim j As Integers = 0For i = 1 To x Step 2t = 1For j = 1 To it = t * jNexts = s + tNextReturn sEnd FunctionPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton2.ClickDim r As SingleDim h As Singler = InputBox("请输入半径:")h = InputBox("请输入高度:")Formula(r, h)End SubPublic Sub Formula(ByVal r As Single, ByVal h As Single)Dim x As SingleDim y As SingleDim z As Singlex = Math.PI * r ^ 2y = 2 * Math.PI * rz = Math.PI * r ^ 2 * hMsgBox("圆面积:" & x & ",圆周长:" & y & ",圆柱体积:" & z)End SubPrivate Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton3.ClickDim s As Strings = InputBox("请输入一个字符串")MsgBox("" & Inverse(s))End SubPrivate Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton4.ClickDim m As IntegerDim n As IntegerDim s As Integerm = InputBox("请输入一个数m")n = InputBox("请输入一个数n")s = cmn(m, n)MsgBox("该组合数为" & s)End Subcmn(ByVal m As Integer, ByVal n As Integer) As Integer Public FunctionIf n = 0 ThenReturn 1ElseIf n = 1 ThenReturn mElseIf n > m / 2 ThenReturn cmn(m, m - n)ElseReturn cmn(m - 1, n) + cmn(m - 1, n - 1)End IfEnd FunctionPrivate Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) HandlesButton5.ClickDim n As Integern = InputBox("请输入要计算兔子的月数:")MsgBox(n & "个月后有:" & f(n) & "个兔子。

VB 课后代码

VB 课后代码

vb课后实验代码来源：柯善永的日志A．1Private Sub Command1_Click()Label3 = Text1End SubA．2Private Sub Form_Load()Timer1.Interval = 0End SubPrivate Sub Command1_Click() '自动Timer1.Interval = 200End SubPrivate Sub Command2_Click() '手动Timer1.Interval = 0Call MyMoveEnd SubPrivate Sub Timer1_Timer()Call MyMoveEnd SubSub MyMove()Label1.Move Label1.Left - 50If Label1.Left < 0 Then Label1.Left = Form1.Width End SubA．3Private Sub Form_Click()Text1 = Val(Text1) + 1End SubPrivate Sub Form_Load()Text1 = 0End SubA．4Private Sub Form_Click()Caption = "单击窗体，改变图片"Picture = LoadPicture(App.Path + "\n_015.bmp") Print "欢迎使用VB"End SubPrivate Sub Form_DblClick()ClsCaption = "双击窗体，卸去图片"Picture = LoadPicture("") 'End SubPrivate Sub Form_Load()Caption = "装入窗体"Picture = LoadPicture(App.Path + "\n_016.bmp")Print "装入图"End SubPrivate Sub Form_Resize() ' 该事件的作用窗体始终与图一样大'Caption = "窗体大小不变"'Form1.Width = 260 * 16 ' 260是Tongji-2.bmp图的宽度，象素单位'Form1.Height = 260 * 16 + 200 ' 260是图的高度，象素单位，200是窗体的标题栏高度End SubA．5Sub Command1_Click()Text1.FontName = "隶书"Text1.FontSize = 25End SubSub Command2_Click()Text2.Text = Text1.SelTextText2.FontName = Text1.FontNameText2.FontSize = Text1.FontSizeEnd SubB．1Private Sub Command1_Click()Text2 = Format(5 / 9 * (Val(Text1) - 32), "0.00")End SubPrivate Sub Command2_Click()Text1 = Format(9 / 5 * Val(Text2) + 32, "0.00")End Sub或Private Sub Command1_Click()Dim f!, c! ' 声明两个变量f = Val(Text1)c = 5 / 9 * (f - 32)Text2 = Format(c, "0.00") ' 保留两位小数End SubPrivate Sub Command2_Click()Dim ff!, cc! ' 声明两个变量cc = Val(Text2)ff = 9 / 5 * cc + 32Text1 = Format(ff, "0.00") ' 保留两位小数End SubB．2Private Sub Command1_Click()Label2 = Format(Val(Text1) * Val(Text1) * 3.14, "0.00")End SubPrivate Sub Command2_Click()Label3 = Format(Val(Text1) * 3.14 * 2, "0.00")End SubPrivate Sub Text1_LostFocus()If Not IsNumeric(Text1.Text) ThenMsgBox "输入有非数字字符，请重新输入", , "警告"Text1.Text = ""Text1.SetFocusEnd IfEnd Sub或Private Sub Command1_Click()Label2 = Format(Val(Text1) * Val(Text1) * 3.14, "0.00") End SubPrivate Sub Command2_Click()Label3 = Format(Val(Text1) * 3.14 * 2, "0.00")End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii = 13 ThenIf Not IsNumeric(Text1.Text) ThenText1.Text = ""End IfEnd IfEnd SubB．3Private Sub Command1_Click()n = Int(Log(2) / Log(1.008) + 1)Label1 = n & "年后人数超过26亿"End SubB．4Private Sub Command1_Click()Dim x, dx, cdx = Text1.Textdx = UCase(x)cd = Len(x)Print "大写字母为:"; dxPrint "字符串长度为:"; cdEnd SubB．5Private Sub Command1_Click()Text1 = Int(Rnd * 900 + 100)End SubPrivate Sub Command2_Click()Dim x%, x1%, x2%, x3%x = Val(Text1)x1 = x Mod 10 ' 分离出的个位数x2 = (x Mod 100) \ 10 ' 分离出的十位数x3 = x \ 100 ' 分离出的百位数Label1 = x1 * 100 + x2 * 10 + x3End SubB．6Private Sub Form_Click()Label1 = Left(Text1, 11)Label2 = Mid(Text1, 12, 6)Label3 = Right(Text1, 5)End SubB．7Private Sub Command1_Click()PrintFor i = 1 To 5Print Tab(15 - i * 2); String(2 * i - 1, "★"); Spc(18 - 4 * (i - 1)); String(2 * i - 1, "★")Next iEnd SubPrivate Sub Command2_Click()ClsEnd Sub进一步要求：Private Sub Command1_Click()PrintFor i = 1 To 5Print Tab(15 - i * 2); String(2 * i - 1, "★"); String(10 - (2 * i - 1), "☆"); String(2 * i - 1, "★") Next iEnd SubPrivate Sub Command2_Click()ClsEnd SubB．8Private Sub Form_Click()x = Val(InputBox("输入一正实数", "计算", 0))pf = Format(x * x, "0.000")pfg = Format(Sqr(x), "0.000")lf = Format(x * x * x, "0.000")lfg = Format(x ^ (1 / 3), "0.000")Print "平方为:"; pf; Space(5); "平方根为:"; pfg; Space(5); "立方为:"; lf; Space(5); "立方根为:"; lfgEnd SubC．1Private Sub Form_Click()Dim x!, y!x = Val(InputBox("输入x的值"))If x < 1000 Theny = xElseIf x < 2000 Theny = 0.9 * xElseIf x < 3000 Theny = 0.8 * xElsey = 0.7 * xEnd IfPrint yEnd SubC．2Private Sub Form_Click()Dim x!, y!x = Val(InputBox("输入上网时间"))If x < 10 Theny = 30ElseIf x < 50 Theny = 30 + 2.5 * (x - 10)Elsey = 30 + 2.5 * 40 + 2 * (x - 50)End IfIf y > 150 Theny = 150End IfPrint yEnd SubC．3Private Sub Command1_Click()Dim x!, y!, z!x = InputBox("input x")y = InputBox("input y")z = InputBox("input z")Print " x y z"Print " 排序前"; x; " "; y; " "; zIf x < y Then t = x: x = y: y = tIf x < z Then t = x: x = z: z = tIf y < z Then t = y: y = z: z = tPrint " 排序后" & x & " " & y & " " & z End SubPrivate Sub Command2_Click()Dim x!, y!, z!x = InputBox("input x")y = InputBox("input y")z = InputBox("input z")Print " x y 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 " 排序后" & x & " " & y & " " & z End SubC．4Dim a(3) As IntegerPrivate Sub Command1_Click()Picture1.ClsFor i = 0 To 2a(i) = Int(Rnd * 100 + 200)Picture1.Print a(i)Next iEnd SubPrivate Sub Command2_Click()Picture2.ClsDim z As IntegerFor i = 0 To 1If a(i) > a(i + 1) Thenz = a(i + 1)a(i + 1) = a(i)a(i) = zEnd IfNext iPicture2.Print a(0)Picture2.Print a(1)Picture2.Print a(2)End SubC．5Private Sub Text2_LostFocus()Dim m%, n%, y%m = Val(Text1)n = Val(Text2)If n Mod 2 <> 0 ThenMsgBox ("脚数必定为偶数")Text2 = ""Text2.SetFocusElsey = n / 2 - mIf y < 0 ThenMsgBox ("脚数必须≥2倍的头数，请重新输入")Text2 = ""Text2.SetFocusElsex = n / 2 - mLabel2 = yLabel3 = m - yEnd IfEnd IfEnd SubC．6Private Sub Command1_Click()Dim a!, b!, c!, x1!, x2!, de!a = Text1b = Text2c = Text3de = b * b - 4 * a * ct = 2 * aIf de = 0 ThenText4 = Format(-b / t, "0.00")Text5 = Format(-b / t, "0.00")ElseIf de > 0 ThenText4 = Format((-b + Sqr(de)) / t, "0.00")Text5 = Format((-b - Sqr(de)) / t, "0.00")ElseText4 = Format(-b / t, "0.00") & "+" & Format(Sqr(Abs(de)) / t, "0.00") & "i" Text5 = Format(-b / t, "0.00") & "-" & Format(Sqr(Abs(de)) / t, "0.00") & "i" End IfEnd SubPrivate Sub Command2_Click()Text1 = ""Text2 = ""Text3 = ""Text4 = ""Text5 = ""End SubC．7Private Sub Text3_LostFocus()Select Case Trim(Text3)Case "+"Text4 = Val(Text1) + Val(Text2)Case "-"Text4 = Val(Text1) - Val(Text2)Case "*"Text4 = Val(Text1) * Val(Text2)Case "/"If Val(Text2) = 0 ThenMsgBox "分母为零，重新输入"Text2 = ""Text2.SetFocusElseText4 = Val(Text1) / V al(Text2)End IfEnd SelectEnd SubC．8Private Sub Text1_LostFocus()Select Case Trim(Text1)Case 1Text2 = "Monday"Case 2Text2 = "Tuesday"Case 3Text2 = "Wednesday"Case 4Text2 = "Thursday"Case 5Text2 = "Friday"Case 6Text2 = "Saturday"Case 7Text2 = "Sunday"Case Is > 7, Is < 1MsgBox "数字为1~7，重新输入"Text1 = ""Text1.SetFocusEnd SelectEnd Sub或者Private Sub Text1_LostFocus()If Text1 > 7 Or Text1 < 1 ThenMsgBox "数字为1~7，重新输入"Text1 = ""Text1.SetFocusElseText2 = Choose(Text1, "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday","Sunday")End IfEnd SubD．1Private Sub Form_Click()For i = 1 To 9Print Tab(10 - i); String(2 * i - 1, Trim(Str(i))) Next iEnd SubD．2Private Sub Form_Click()For i = 1 To 10 Step 1Print Tab(i); String((20 - 2 * i), Chr(64 + i)) Next iEnd SubD．3Private Sub Command1_Click()Dim s!, t!, i&s = 1t = 1For i = 1 To 100000t = t + is = s + 1 / tIf 1 / t < 0.00001 Then Exit ForNext iPrint "For结构"; s, i; "项"End SubD．4Private Sub Command1_Click()Dim n&, pi#, i&n = InputBox("输入n值")pi = 2For i = 1 To npi = pi * (2 * i) / (2 * i - 1) * (2 * i) / (2 * i + 1) Next iPrint "当n=" & n & "时，pi="; piEnd SubD．5Private Sub Form_Click()Dim s!, t!, i!, a%, n%a = Int(Rnd * 9 + 1)n = Int(Rnd * 6 + 5)t = 0: s = 0Print "a="; a, "n="; nFor i = 1 To nt = t * 10 + as = s + tPrint t;Next iPrintPrint "s="; sEnd SubD．6Private Sub Command1_Click()Dim s As Integers = 0For i = 1 To 9For j = 0 To 9For k = 0 To 9s = i * 100 + j * 10 + kIf s = i ^ 3 + j ^ 3 + k ^ 3 ThenPrint sEnd IfNext kNext jNext iEnd SubPrivate Sub Command3_Click()formd6.Hidemain.ShowEnd SubD．7Private Sub Command1_Click()Dim a!, x0!, x1!a = 27x0 = 2i = 0Doi = i + 1x1 = 2 * x0 / 3 + a / (3 * x0 * x0)If Abs(x1 - x0) < 0.00001 Then Exit Do x0 = x1LoopPrint x1, iEnd SubD．8Private Sub Command1_Click()s = 0x0 = 0.01For i = 1 To 30s = s + x0x0 = x0 * 2Next iPrint sEnd SubD．9Private Sub Command4_Click()Picture1.ClsPicture1.Print "x课安排在"; "y课安排在"; "z课安排在"Picture1.Print ""For z = 5 To 6For x = 1 To z - 2For Y = x + 1 To z - 1X1 = Choose(Weekday(x), "周一", "周二", "周三", "周四", "周五", "周六", "周日") Y1 = Choose(Weekday(Y), "周一", "周二", "周三", "周四", "周五", "周六", "周日") z1 = Choose(Weekday(z), "周一", "周二", "周三", "周四", "周五", "周六", "周日") Picture1.Print " "; X1; " "; Y1; " "; z1Next YNext xNext zEnd SubE．1Private Sub Form_Click()Dim a(1 To 10) As IntegerFor i = 1 To 10a(i) = Int(Rnd * 71 + 30)Print a(i); " ";Next iMax = a(1)Min = a(1)Avg = a(1)For i = 2 To 10If a(i) > Max Then Max = a(i)If a(i) < Min Then Min = a(i)Avg = Avg + a(i)Next iAvg = Avg / 10PrintPrint "Max="; Max; " Min="; Min; " Avg="; AvgEnd SubE．2Private Sub Form_Click()Dim aa = Array(56, 78, 98, 88, 76, 78)For i = 0 To 5Print String(a(i) \ 5, "◆"); a(i)PrintNext iEnd SubE．3Dim a%(19)Private Sub Command1_Click()Picture1.ClsFor i = 0 To 19a(i) = Int(Rnd * 101)Picture1.Print a(i); " ";If (i + 1) Mod 4 = 0 Then Picture1.PrintNext iEnd SubPrivate Sub Command2_Click()Picture2.ClsDim s(5 To 9)For i = 0 To 19k = a(i) \ 10Select Case kCase 0 To 5s(5) = s(5) + 1Case 9 To 10 '90～100分的人数s(9) = s(9) + 1Case 6 To 8 ' 存放其他三个分数段的下标有规律，根据K获得s(k) = s(k) + 1End SelectNext iFor i = 5 To 9If s(i) <> 0 Then Picture2.Print "s("; i; ")的人数有"; Format(s(i), "0"); "个" Next iEnd SubE．4Private Sub Command1_Click()Picture1.ClsDim d%(1 To 10)For i3 = 1 To 10Randomized(i3) = Int(Rnd * 91 + 10)Next i3For i = 1 To 10For j = 1 To 10 - iIf d(j) < d(j + 1) Thent = d(j): d(j) = d(j + 1): d(j + 1) = t End IfNext jNext iFor i = 1 To 10: Picture1.Print d(i); If i Mod 5 = 0 Then Picture1.Print Next iEnd SubE．5Dim a%(3, 3), b%(3, 3)Private Sub Form_Load()For i = 0 To 3For j = 0 To 3a(i, j) = Int(Rnd * 36 + 35)b(i, j) = Int(Rnd * 41 + 100) Next jNext iEnd SubPrivate Sub Command1_Click() Picture1.ClsFor i = 0 To 3For j = 0 To iPicture1.Print a(i, j); " "; Next jPicture1.PrintNext iEnd SubPrivate Sub Command2_Click() Picture2.ClsFor i = 0 To 3For j = i To 3Picture2.Print Tab(j * 6); b(i, j); Next jPicture2.PrintNext iEnd SubPrivate Sub Command3_Click() Picture3.Clssa = 0For i = 0 To 3sa = sa + a(i, i)Next isb = 0For i = 0 To 3sb = sb + b(i, 3 - i)Next iPicture3.Print "A数组主对角线元素和为："; sa Picture3.Print "B数组副对角线元素和为："; sb End SubE．6Private Sub Form_Click()n = InputBox("输入n值")ReDim a6%(n + 1, n + 1)a6(0, 0) = 1: a6(1, 1) = 1: a6(1, 0) = 1For i = 2 To n + 1For j = 2 To ia6(i, j) = a6(i - 1, j - 1) + a6(i - 1, j)Picture1.Print a6(i, j); "";Next jPicture1.PrintNextEnd SubE．7Private Sub Form_Load()List1.ClearList1.AddItem "大学计算机基础"List1.AddItem "C/C++程序设计"List1.AddItem "VB程序设计"List1.AddItem "Web程序设计"List1.AddItem "多媒体技术与应用"List1.AddItem "数据库技术与应用"List1.AddItem "网络技术与应用"List1.AddItem "硬件技术基础"List1.AddItem "软件技术技术基础"End SubPrivate Sub List1_Click()If List2.ListCount >= 5 ThenMsgBox ("超过5门课程，不能再选")Exit SubElseList2.AddItem List1.TextList1.RemoveItem List1.ListIndexEnd SubE．8Sub Combo1_KeyPress(KeyAscii As Integer)Select Case KeyAsciiCase 48 To 57, 13Case ElseKeyAscii = 0End SelectIf KeyAscii = 13 ThenCombo1.AddItem Combo1.TextCombo1.Text = ""End IfEnd SubPrivate Sub Command1_Click()Dim min%, max%min = Val(Combo1.List(0))max = Val(Combo1.List(0))imin = 0imax = 0For i = 1 To Combo1.ListCount - 1If Val(Combo1.List(i)) > max Thenimax = imax = Combo1.List(i)ElseIf Val(Combo1.List(i)) < min Thenimin = imin = Combo1.List(i)End IfNext it = Combo1.List(0)Combo1.List(0) = Combo1.List(imin)Combo1.List(imin) = tt = Combo1.List(Combo1.ListCount - 1)Combo1.List(Combo1.ListCount - 1) = Combo1.List(imax) Combo1.List(imax) = tEnd SubE．9Private Sub Form_Click()For i = 0 To Screen.FontCount - 1If Asc(Left(Screen.Fonts(i), 1)) < 0 ThenPicture1.Print Screen.Fonts(i)Picture2.FontName = Screen.Fonts(i)Picture2.Print "商丘师范学院"Next iEnd SubE．10Private Type clerknumber As String * 3name As String * 5salary As IntegerEnd TypeDim a(0 To 4) As clerk, n%Private Sub Command1_Click()If n >= 5 ThenMsgBox ("输入人数超过数组声明的个数") ElseWith a(n).number = Text1.name = Text2.salary = Text3Picture1.Print a(n).number, a(n).name, a(n).salary PrintEnd Withn = n + 1Text1 = ""Text2 = ""Text3 = ""End IfEnd SubPrivate Sub Command2_Click()Dim t As clerk, i%, j%For i = 0 To n - 1For j = i To n - 1If a(i).salary < a(j + 1).salary Thent = a(i): a(i) = a(j + 1): a(j + 1) = tEnd IfNext jNext iPicture1.ClsPicture1.Print "工号姓名工资"For i = 0 To n - 1Picture1.Print a(i).number, a(i).name, a(i).salary PrintNext iF．1Private Sub Form_Click()Dim a(1 To 10), amin, i%For i = 1 To 10a(i) = -Int(Rnd * 101 + 300)Print a(i);Next iCall s(a(), amin)PrintPrint "min="; aminEnd SubSub s(b(), min)Dim i%min = b(LBound(b))For i = LBound(b) + 1 To UBound(b)If b(i) < min Then min = b(i)Next iEnd SubF．2Private Sub Command1_Click()Dim mm%, nn%mm = Val(Text1)nn = Val(Text2)Picture1.Print mm; Tab(6); nn; Tab(12); gcd(mm, nn) End SubFunction gcd%(ByVal m%, ByVal n%)If m < n Then t = m: m = n: n = tr = m Mod nDo While (r <> 0)m = n: n = r: r = m Mod nLoopgcd = nEnd FunctionF．3Dim x!Private Sub Command1_Click()Print "调用标准函数Sin的结果"; Sin(x)End SubPrivate Sub Command2_Click()Print "调用自定义函数MySin的结果"; MySin(x) End SubFunction MySin(x!) As DoubleDim i%, t!, s!t = xs = ti = 1Do While Abs(t) > 0.00001t = -1 * t * x * x / ((i + 1) * (i + 2))s = s + ti = i + 2LoopMySin = sEnd FunctionPrivate Sub Command3_Click()x = InputBox("输入要计算正弦函数的角度值x") x = x * 3.14 / 180End SubF．4Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 ThenIf Not IsNumeric(Text1) ThenMsgBox "输入非数字串，重新输入"Text1.Text = ""Text1.SetFocusElseIf IsH(Text1) ThenPicture1.Print Text1; " ★"ElsePicture1.Print Text1End IfText1 = ""End IfEnd IfEnd SubFunction IsH(ss As String) As BooleanDim i%, Ls%IsH = Truess = Trim(ss)Ls = Len(ss)For i = 1 To Ls \ 2If Mid(ss, i, 1) <> Mid(ss, Ls + 1 - i, 1) ThenIsH = FalseExit FunctionEnd IfNext iEnd FunctionF．5Function prime(ByVal m As Integer) As Booleanprime = TrueDim i%For i = 2 To m - 1If (m Mod i) = 0 Then prime = False: Exit Function '注意冒号和exit的范围Next iEnd FunctionPrivate Sub Command1_Click()n = 0For i = 6 To 100 Step 2For j = 3 To i \ 2If prime(j) ThenIf prime(i - j) ThenList1.AddItem i & " =" & j & " +" & i - jn = n + 1End IfEnd IfNext jNext iPicture1.Print " 6和100之间共有"; n; "对素数和"End SubF．6Dim a%()Private Sub Form_Click()Print "1000以内的完数为："For i = 1 To 1000If IsWs(i) ThenPrint i; "=1";For j = 1 To UBound(a)Print "+"; a(j);Next jPrintEnd IfNext iEnd SubFunction IsWs(m) As BooleanDim s%s = 0For i = 1 To m \ 2If m Mod i = 0 ThenReDim Preserve a(j)a(j) = ij = j + 1s = s + iEnd IfNext iIf m = s Then IsWs = TrueEnd FunctionF．7Private Sub DeleStr(s1 As String, ByVal s2 As String)Dim i%ls2 = Len(s2)i = InStr(s1, s2)Do While i > 0s1 = Left(s1, i - 1) + Mid(s1, i + ls2) ' 在s1中去除s2子串i = InStr(s1, s2)LoopEnd SubPrivate Sub Command1_Click() ' 调用DeleStr子过程Dim ss1 As Stringss1 = Text1Call DeleStr(ss1, Text2)Text3 = ss1End SubPrivate Sub Command2_Click()End SubF．8Private Sub Command1_Click()Dim maxw$maxlen Text1 & " ", maxwText2 = maxwEnd SubSub maxlen(s$, maxw$)Dim word$maxw = ""Do While s <> ""i = InStr(s, " ")word = Left(s, i - 1)If Len(word) > Len(maxw) Then maxw = words = Mid(s, i + 1)LoopEnd SubG．1Private Sub Command1_Click()List1.ClearList1.AddItem Combo1If Option1 Then List1.AddItem "Pentium II"If Option2 Then List1.AddItem "Pentium I"If Option3 Then List1.AddItem "Celeron"List1.AddItem Text1If Check1 Then List1.AddItem "声卡"If Check2 Then List1.AddItem "Modem"If Check3 Then List1.AddItem "网络适配器"End SubPrivate Sub Text1_LostFocus()st = UCase(Trim(Text1))le = Len(st)If Not IsNumeric(Left(st, le - 2)) Or Right(st, 2) <> "MB" Then MsgBox "有不合法字符！"Text1 = ""Text1.SetFocusEnd IfEnd SubG．2Private Sub Check1_Click()Picture1.Font.Bold = Not Picture1.Font.BoldEnd SubPrivate Sub Check2_Click()Picture1.Font.Italic = Not Picture1.Font.BoldEnd SubPrivate Sub Command1_Click()Picture1.ClsIf Option1 ThenPicture1.Print Sin(Val(Text1))ElseIf Option2 ThenPicture1.Print Exp(Val(Text1))ElseIf Option3 ThenPicture1.Print Sqr(Val(Text1))End IfEnd SubPrivate Sub return_Click(Index As Integer)Form6.ShowUnload Form2G．3Private Sub HScroll1_Change()Text1 = VScroll1.ValueText2 = HScroll1.ValueText3 = HScroll2.ValueText4 = Format(Val(Text1) * (Text3 / 100) * (Text2 / 12), "0.00") Text5 = Format(Val(Text4) + Val(Text1), "0.00")End SubPrivate Sub HScroll2_Change()Text1 = VScroll1.ValueText2 = HScroll1.ValueText3 = HScroll2.ValueText4 = Format(Val(Text1) * (Text3 / 100) * (Text2 / 12), "0.00") Text5 = Format(Val(Text4) + Val(Text1), "0.00")End SubPrivate Sub VScroll1_Change()Text1 = VScroll1.ValueText2 = HScroll1.ValueText3 = HScroll2.ValueText4 = Format(Val(Text1) * (Text3 / 100) * (Text2 / 12), "0.00") Text5 = Format(Val(Text4) + Val(Text1), "0.00")End SubG．4Dim t As SinglePrivate Sub Command1_Click()t = InputBox("输入倒计时分钟数")t = t * 60ProgressBar1.Min = 0ProgressBar1.Max = tProgressBar1.Value = tEnd SubPrivate Sub Command2_Click()Timer1.Interval = 1000ProgressBar1.Visible = TrueEnd SubPrivate Sub Timer1_Timer()Dim m%, s%t = t - 1ProgressBar1.Value = ts = t Mod 60Label1 = m & "分" & s & "秒"If t = 0 ThenMsgBox "时间到！"Timer1.Interval = 0ProgressBar1.Visible = FalseEnd IfEnd SubG．5Private Sub Command1_Click()CommonDialog1.ShowColorLabel1.ForeColor = CommonDialog1.ColorEnd SubPrivate Sub Command2_Click()CommonDialog1.ShowOpeni = Shell("C:\WINDOWS\NOTEPAD.exe " + CommonDialog1.FileName, vbNormalFocus) End SubG．6rivate Sub bold_Click()Text1.FontBold = Not Text1.FontBoldbold.Checked = Not bold.CheckedEnd SubPrivate Sub del_Click()Text1 = ""End SubPrivate Sub end_Click()EndEnd SubPrivate Sub font12_Click()Text1.FontSize = 12End SubPrivate Sub font16_Click()Text1.FontSize = 16End SubPrivate Sub Form_Load()bold.Checked = Falseitalic.Checked = FalsePrivate Sub italic_Click()Text1.FontItalic = Not Text1.FontItalicitalic.Checked = Not italic.CheckedEnd SubPrivate Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu menu2End SubG．7Private Sub Command1_Click()CommonDialog1.ShowColorLabel1.ForeColor = CommonDialog1.ColorEnd SubPrivate Sub Command2_Click()CommonDialog1.ShowOpeni = Shell("C:\WINDOWS\NOTEPAD.exe " + CommonDialog1.FileName, vbNormalFocus) End SubPrivate Sub return_Click(Index As Integer)Form6.ShowUnload Form5End SubG．8G．9Private Sub 结束_Click()EndEnd SubPrivate Sub 删除最大值_Click()max = List1.List(0)For i = 1 To List1.ListCount - 1If max < List1.List(i) Then max = List1.List(i): j = iNext iList1.RemoveItem jEnd SubPrivate Sub 删除最小值_Click()min = List1.List(0)For i = 1 To List1.ListCount - 1If min > List1.List(i) Then min = List1.List(i): j = iNext iList1.RemoveItem jEnd SubPrivate Sub 随机产生_Click()RandomizeFor i = 0 To 9List1.List(i) = Int(Rnd * 30 + 70)Next iEnd SubPrivate Sub 添加数据_Click()List1.AddItem Int(Rnd * 30 + 70)End SubPrivate Sub 统计_Click()Dim max%, min%, ave!, m%, n%max = List1.List(0)min = List1.List(0)ave = List1.List(0)m = 0n = 0For i = 1 To List1.ListCount - 1If max < List1.List(i) Then max = List1.List(i): m = i If min > List1.List(i) Then min = List1.List(i): n = i ave = ave + List1.List(i)Next iForm2.Text1 = List1.List(n)Form2.Text2 = List1.List(m)Form2.Text3 = Format(ave / List1.ListCount, "0.00") Form2.ShowEnd SubG．10Private Sub experimentG2_Click()Form2.ShowEnd SubPrivate Sub experimentG3_Click()Form3.ShowEnd SubPrivate Sub experimentG4_Click()Form4.ShowEnd SubPrivate Sub experimentG5_Click()Form5.ShowEnd SubPrivate Sub font_12_Click()Text1.FontSize = 12End SubPrivate Sub font_16_Click()Text1.FontSize = 16End SubPrivate Sub rnd10_Click()RandomizeFor i = 0 To 9List1.List(i) = Int(Rnd * 30 + 70)Next iEnd SubPrivate Sub stat_Click()Dim max%, min%, ave!, m%, n%max = List1.List(0)min = List1.List(0)ave = List1.List(0)m = 0n = 0For i = 1 To List1.ListCount - 1If max < List1.List(i) Then max = List1.List(i): m = iIf min > List1.List(i) Then min = List1.List(i): n = iave = ave + List1.List(i)Next istat2.Text1 = List1.List(n)stat2.Text2 = List1.List(m)stat2.Text3 = Format(ave / List1.ListCount, "0.00")stat2.ShowEnd SubPrivate Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu caidan2, vbPopupMenuCenterAlignEnd SubPrivate Sub xie_Click()Text1.Font.Italic = Not Text1.Font.BoldH．1Private Sub Command1_Click()Open "c:\score" For Output As #1Print #1, "051023", "王海涛", 66Print #1, "052498", "周文英", 88Print #1, "050992", "陈建东", 77Open "c:\score1" For Output As #2Write #2, "051023", "王海涛", 66Write #2, "052498", "周文英", 88Write #2, "050992", "陈建东", 77Closei1 = Shell("NOTEPAD.exe" + " c:\score", vbNormalNoFocus) i2 = Shell("NOTEPAD.exe" + " c:\score1", vbNormalNoFocus) End SubPrivate Sub Command2_Click()Dim no As String, name As String, s As IntegerOpen "c:\score" For Input As #1Do While Not EOF(1)Line Input #1, linedataList1.AddItem linedataLoopOpen "c:\score1" For Input As #2Do While Not EOF(2)Input #2, no, name, sList2.AddItem no & name & sLoopCloseEnd SubH．2Private Sub Command1_Click()Dim fib%(0 To 9), i%Open "c:\fb.dat" For Output As #1For i = 0 To 9If i = 0 Or i = 1 Thenfib(i) = iElsefib(i) = fib(i - 1) + fib(i - 2)End IfPrint #1, """Fib(" & i & ")""," & fib(i)Next iClose #1i = Shell("NOTEPAD.exe" + " c:\fb.dat", vbNormalNoFocus)。

VB编程语言在都江堰水利枢纽水位流量关系曲线中的应用

VB编程语言在都江堰水利枢纽水位流量关系曲线中的应用

74 S ichuan W a ter Pow erVB 编程语言在都江堰水利枢纽水位流量关系曲线中的应用张　迅,　刘　强(四川省都江堰管理局供水管理处,四川都江堰　611830)摘　要:作为全国特大型灌区之一的都江堰灌区,在水量调配、供水管理过程中,经常需要根据水位流量关系曲线查询各大干渠的水位、流量情况。

人工插值查询的方式不仅查询速度慢,而且在插值计算时也易产生计算错误。

用VB 编程语言编写相关应用程序,具有查询速度快、查询结果准确的特点,有效提高了日常工作效率。

关键词:都江堰水利枢纽;VB;编程;水位流量关系曲线;应用中图分类号:TP3;TP39;T V647文献标识码:　B文章编号:100122184(2010)0120074203都江堰灌区渠首骨干输水渠道包括内江的蒲阳河、柏条河、走马河、江安河,以及外江的沙沟河与黑石河,共六大干渠。

作为一个灌溉面积达1031.7万亩(1h m 2=15亩)的全国特大型灌区,在水量调配、供水管理的过程中,经常需要根据水位流量关系曲线查询各大干渠的水位、流量。

传统人工插值查询的方式不仅查询速度较慢,而且在插值计算时也易造成计算错误。

因此,编制相关应用程序,采用计算机的手段进行水位流量的查询具有非常重要的现实意义。

1　水位流量关系曲线的数学表示根据每年年末对各大干渠水文定线的结果绘制出的水位流量关系曲线见图1。

图1　稳定的水位流量关系曲线图对每条干渠的水位流量关系曲线分别取若干节点(H 1,Q 1),(H 2,Q 2),(H 3,Q 3)…(H n ,Q n ),则位于区间[H k ,H k +1]内的点(H,Q )可用线性插值表示为:收稿日期:2009207211H =H k +H k +1-H kQ k +1-Q k (Q -Q k )　k =1,2,3…n(1)Q =Q k +Q k +1-Q k H k +1-H k(H -H k )　k =1,2,3…n(2)2　应用程序的编写Excel 是微软Office 办公套件中的一款常用电子表格软件,由于其内置了丰富的功能与函数,使其能够用于数据分析与处理。

新安江模型VB代码

新安江模型VB代码

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。

基于新安江模型的太平口水文站洪水预报

基于新安江模型的太平口水文站洪水预报

基于新安江模型的太平口水文站洪水预报摘要：本文运用太平口水文站2000年~2014年的历史降雨洪水摘录数据，构建新安江三水源预报模型，基于单纯形法的自动率定与人工经验结合的方法确定方案参数，各参数符合该地区的洪水特性。

对2000年~2009年共10年16场次洪水样本进行评定，洪峰流量合格率为87.5%，峰现时间合格率为93.75%。

对2010年~2014年6场次洪水样本进行检验，洪峰流量合格率为83.3%，峰现时间合格率为83.3%。

综合评定本方案为乙级方案，可用于发布正式预报。

关键词：洪水实时预报；参数率定；新安江模型；太平口水文站1.概述新安江模型是河海大学赵人俊教授等提出来的降雨径流预报模型，最初研制的是二水源新安江模型，经过改进和发展，现广为使用的是三水源新安江模型。

新安江模型的特点是认为湿润地区主要产流方式为蓄满产流，流域蓄水容量曲线是模型的核心，因此该模型适用于南方湿润地区与半湿润地区的湿润季节，现已成为与我国特色应用较为广泛的一个流域水文模型。

本文通过对大樟溪流域清凉溪洪水特性进行分析，探讨了基于该模型的太平口水文站的洪水预报方案编制。

2.案例应用2.1站点概况太平口水文站位于福建省福州市永泰县清凉乡太平口村，位于大樟溪流域清凉溪干流上。

清凉溪河源位于永泰县盘古乡洋里村，河口位于永泰县樟城镇城关村。

流域面积为254km2，河流长度为35km，平均比降为16.6‰。

流域全年降水量在1400~2000mm之间，多年平均降水深为1689.3mm，多年平均净流深为959.4mm。

溪谷低丘向高山递增。

流域多年平均4～9月的降水量占年总量的73.7%。

大樟溪洪水主要来自暴雨，主要出现在梅雨（4～6月）和台风雨（6～9月）两个季节。

太平口水文站是清凉溪干流上的控制站，集水面积为244km2。

2.3资料收集及处理本次收集到的资料主要包括太平口水文站2000年～2014年的降雨、洪水摘录数据；北山、白云、渔溪3个雨量站20005年～2014年降雨摘录数据。

  1. 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 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。

相关文档
最新文档