# SelectCase 语句应用方案

## 知识概述

### SelectCase 语句

当选择的情况较多时，使用 If 语句实现，就会很麻烦而且不直观，而 VB 中提供的 SelectCase 语句可以方便、直观地处理多分支的控制结构。

语法：

SelectCase 测试表达式

Case 表达式 1

语句块 1

Case 表达式 2

语句块 2

…

Case 表达式 n

语句块 n

[CaseElse

语句块 n+1]

EndSelect

SelectCase 语句的执行流程如图 1 所示。

图 1SelectCase 语句的执行流程图

执行过程说明：

（1）首先计算“测试表达式”的值。

（2）然后用这个值与 Case 后面表达式 1，表达式 2，……中的值比较。

（3）若有相匹配的，则执行 Case 表达式后面的语句块，执行完该语句块则结束 SeledtCase 语句，不再与后面的表达式比较。

（4）当“测试表达式”的值与后面所有表达式的值都不相匹配时，若有 CaseElse 语句，则执行 CaseElse 后面的语句块 n+1，若没有 CaseElse 语句，则直接结束 SelsctCase 语句。

在 SelectCase 语句中“表达式”通常是一个具体的值（如 Case1），每一个值确定一个分支。“表达式”的值称为域值，有以下 3 种方法可以设定该值：

（1）表达式列表为表达式，例如：X+100。

CaseX+100 '表达式列表为表达式

（2）一组值（用逗号隔开），例如：

Case1,4,7 '表示条件在 1、4、7 范围内取值

（3）表达式 1To 表达式 2，例如：

Case50TO60 '表示条件取值范围为 50～60

（4）Is 关系表达式，例如：

CaseIs<4 '表示条件在小于 4 的范围内取值

本范例将使用 SelectCase 语句实现职工年龄统计的功能。程序运行结果如图 2 所示。

图 2 职工年龄统计

程序代码如下。

DimrsAsNewADODB.Recordset

DimcnnAsNewADODB.Connection

Dims1AsInteger,s2AsInteger,s3AsInteger,s4AsInteger

Dims5AsInteger,s6AsInteger,s7AsInteger,s8AsInteger,s9AsInteger

PrivateSubForm_Load()

DimnlAsLong

MSHFlexGrid1.ColWidth(0)=200

cnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&App.Path&"\db_manpower.mdb;PersistSecurityInfo=False"

Label1="21 岁以下："&0

Label2="21 岁～25 岁："&0

Label3="26 岁～30 岁："&0

Label4="31 岁～35 岁："&0

Label5="36 岁～40 岁："&0

Label6="41 岁～45 岁："&0

Label7="46 岁～50 岁："&0

Label8="51 岁～55 岁："&0

Label9="56 岁以上："&0

rs.Open"select*from 人事表",cnn,adOpenKeyset,adLockOptimistic

DoWhilers.EOF=False

nl=rs.Fields("年龄")

SelectCasenl

CaseIs<21

s1=s1+1

Label1="21 岁以下："&s1

Case21To25

s2=s2+1

Label2="21 岁～25 岁："&s2

Case26To30

s3=s3+1

Label3="26 岁～30 岁："&s3

Case31To35

s4=s4+1

Label4="31 岁～35 岁："&s4

Case36To40

s5=s5+1

Label5="36 岁～40 岁："&s5

Case41To45

s6=s6+1

Label6="41 岁～45 岁："&s6

Case46To50

s7=s7+1

Label7="46 岁～50 岁："&s7

Case51To55

s8=s8+1

Label8="51 岁～55 岁："&s8

CaseIs>56

s9=s9+1

Label9="56 岁以上："&s9

EndSelect

rs.MoveNext

Loop

rs.Close

EndSub

一般情况在多分支选择情况下，使用 SelectCase 语句，结构更清晰。当然，若只有两个分支或分支数很少的情况下，直接使用 If…Then 语句更好一些。

## 应用一：使用控件数组

本节将通过实例讲解如何在程序中结合 SelectCase 语句使用控件数组。运行程序单击命令控钮，控制窗口在屏幕中的位置，结果如图 1 所示。

图 1 设置窗口在屏幕中的位置

设计步骤如下：

（1）设计控件数组 Command1，其中包含 5 个控件数组元素。具体操作方法如下。

①在窗体上添加第一个按钮控件 CommandButton，名称为默认的 Command1。

②单击工具栏上的“复制”按钮（或按〈Ctrl+C〉键）。

③单击工具栏上的“粘贴”按钮（或按〈Ctrl+V〉键），此时系统弹出如图 1 所示的对话框，单击【是】按钮，就建立了一个控件数组元素，其 Index 属性为 1，事先在窗体上添加的第 1 个命令按钮控件的 Index 属性值为 0。用户通过鼠标可以把新控件拖放到第一个控件的右方。

④继续单击【粘贴】按钮（或按〈Ctrl+V〉键），可得到控件数组中的其他 3 个控件，其 Index 属性分别为 2、3 和 4（即为 0、1、2、3、4）。

⑤设置控件数组各元素（从 0～4）的 Caption 属性分别为“左上脚”、“右上脚”、“左下脚”、“右下脚”和“居中”，并调整控件位置。

（2）完整程序代码如下。

PrivateSubCommand1_Click(IndexAsInteger)

SelectCaseIndex

Case0'设置窗体在桌面左上角

Me.Top=0

Me.Left=0

Case1'设置窗体在桌面右上角

Me.Top=0

Me.Left=Screen.Width-Me.Width

Case2'设置窗体在桌面左下角

Me.Top=Screen.Height-Me.Height

Me.Left=0

Case3'设置窗体在桌面右下角

Me.Top=Screen.Height-Me.Height

Me.Left=Screen.Width-Me.Width

Case4'设置窗体在桌面中央

IfWindowState=0Then

Move(Screen.Width-Form1.Width)/2,(Screen.Height-Form1.Height)/2

EndIf

EndSelect

EndSub

## 应用二：工具栏事件处理

SelectCase 语句可以很容易的实现工具栏的功能，ButtonClick 事件和 ButtonMenuClick 事件是工具栏最常用的两个事件。实际上，工具栏上的按钮是控件数组，单击工具栏上的按钮会发生 ButtonClick 事件或者 ButtonMenuClick 事件，其中主要利用数组的索引（Index 属性）或关键字（Key 属性）来识别被单击的按钮。

示例：

下图是合同管理系统的一个界面。其中应用到 Toolbar 控件的 ButtonClick 事件。在程序运行时，单击 Toolbar 上的按钮，就可以显示相应的窗体，其实现界面如图 1 所示。

图 1Toolbar 控件的典型应用

实现的关键代码如下。

PrivateSubToolbar1_ButtonClick(ByValButtonAsMSComctlLib.Button)

SelectCaseButton.Index

Case1:frm_khxxb.Show

Case2:frm_gysxxb.Show

Case3:frm_xmxxb.Show

Case4:frm_htsh.Show

Case5:frm_htxxb.Show

Case6:frm_htxx_cx.Show

Case7:frm_XTWH_CZYSZ.Show

Case8:frm_sjtj.Show

Case9

frm_sjbfyhf.Show

frm_sjbfyhf.Opt1.Value=1

frm_sjbfyhf.Text3.Text=Text1.Text

UnloadMe

Case10:End

EndSelect

EndSub

完整程序代码

PrivateSubTimer1_Timer()

StatusBar1.Panels(3).Text=Format(Now,"hh 点 mm 分 ss 秒")

EndSub

'******实现 Toolbar 控件的关键代码如下，******

'******但由于本实例仅包含一个窗体，******

'******所以在代码中添加了错误处理。******

'////////////////////////////////////////////////////////////////////////

PrivateSubToolbar1_ButtonClick(ByValButtonAsMSComctlLib.Button)

OnErrorResumeNext

SelectCaseButton.Index

Case1:frm_khxxb.Show

Case2:frm_gysxxb.Show

Case3:frm_xmxxb.Show

Case4:frm_htsh.Show

Case5:frm_htxxb.Show

Case6:frm_htxx_cx.Show

Case7:frm_XTWH_CZYSZ.Show

Case8:frm_sjtj.Show

Case9

frm_sjbfyhf.Show

frm_sjbfyhf.Opt1.Value=1

frm_sjbfyhf.Text3.Text=Text1.Text

Case10:End

EndSelect

EndSub

'/////////////////////////////////////////////////////////////////////////

## 应用三：WebBrowser 控件的编程

IE 强大的功能对大家来说并不陌生，本例中向大家介绍如何利用 VB 的 WebBrowser 控件和 SelectCase 语句实现简单的浏览器。

完整程序代码

PrivateFormOldWidthAsLong'保存窗体的原始宽度

PrivateFormOldHeightAsLong'保存窗体的原始高度

'按比例改变表单内各元件的大小，在调用 ReSizeForm 前先调用 ReSizeInit 函数

PublicSubResizeForm(FormNameAsForm)

DimPos(4)AsDouble

DimiAsLong,TempPosAsLong,StartPosAsLong

'DimObjAsControl

DimScaleXAsDouble,ScaleYAsDouble

ScaleX=Form1.ScaleWidth/FormOldWidth

'保存窗体宽度缩放比例

ScaleY=Form1.ScaleHeight/FormOldHeight

'保存窗体高度缩放比例

OnErrorResumeNext

''ForEachObjInFormName

StartPos=1

Fori=0To4

'读取控件的原始位置与大小

TempPos=InStr(StartPos,WebBrowser1.Tag,"",vbTextCompare)

IfTempPos>0Then

Pos(i)=Mid(WebBrowser1.Tag,StartPos,TempPos-StartPos)

StartPos=TempPos+1

Else

Pos(i)=0

EndIf

'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小

WebBrowser1.MovePos(0),Pos(1),Pos(2)*ScaleX,Pos(3)*ScaleY

Nexti

'''NextObj

OnErrorGoTo0

EndSub

PrivateSubForm_Load()

FormOldWidth=Form1.ScaleWidth

FormOldHeight=Form1.ScaleHeight

WebBrowser1.Tag=WebBrowser1.Left&""&WebBrowser1.Top&""&WebBrowser1.Width&""&WebBrowser1.Height&""

EndSub

PrivateSubForm_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)

Label2.BorderStyle=0

EndSub

PrivateSubForm_Resize()

CallResizeForm(Me)

'确保窗体改变时控件随之改变

EndSub

PrivateSubCommand1_Click()'进入

EndSub

PrivateSubLabel2_Click()

WebBrowser1.NavigateText1.Text

EndSub

PrivateSubLabel2_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)

Label2.BorderStyle=1

EndSub

PrivateSubToolbar1_ButtonClick(ByValButtonAsMSComctlLib.Button)

SelectCaseButton.Index

Case1'后退

OnErrorGoToErrBack

WebBrowser1.GoBack

ExitSub

ErrBack:

MsgBox"没有可后退的页！",vbCritical,"信息提示"

Case2'前进

OnErrorGoToErrForward

WebBrowser1.GoForward

ExitSub

ErrForward:

MsgBox"没有可以下载的页！",vbCritical,"信息提示"

Case3'停止

WebBrowser1.Stop

Case4'刷新

WebBrowser1.Refresh

Case5'搜索

OnErrorGoToErrSearch

WebBrowser1.GoSearch

ExitSub

ErrSearch:

MsgBox"没有找到相关的页！",vbInformation,"信息提示"

Case6'主页

WebBrowser1.GoHome

EndSelect

EndSub

执行效果如图 1 所示。

图 1 浏览器

## 应用四：常用 ASCII 字符与键盘操作

Ascii 字符集中 0、8、9、10 和 13 分别为空字符、退格、制表、换行和回车字符，在代码中使用较多，应牢记。本例判断得到的数据是否包含回车。代码如下：

IntPositionD=InStr(StrInComm1,Chr(13))'判断从串口 1 中得到的数据是否有回车

也可以使用 Keycode 常数代替实际值，如字符串相加后，再换行，回车符可以是 vbCrLf 或 chr(13+chr(10))，代码如下：

Text1=Text1&Trim(TextLine)&vbCrLf

下面是利用 SelectCase 语句列出的常用的 ASCII 字符集操作例子。

SubGrid1__keyPress(keyasciiAslnteger)

SelectCaseKeyAscii

Case8'处理退格键

IfLen(grid1.Text)=0ThenExitSub

grid1.Text=Left$(grid1.Text,Len(grid1.Text)-1)

ExitSub

Case46'处理小数点

grid1.Text=grid1.Text+.

ExitSub

Case45'处理负号

grid1.Text=grid1.Text+-

ExitSub

Case43'处理正号

grid1.Text=grid1.Text++

ExitSub

EndSelect

If(KeyAscii<48OrKeyAscii>58)Then'处理非数字

Beep:ExitSub

Endlf

grid1.Text=grid1.Text+Right(Str(KeyAscii-48),1)

EndSub

## 应用五：移动记录

数据环境对象中的 Recordset 对象包括一些方法，其中的 MoveFirst、MoveNext、MovePrevious 和 MoveLast 方法可以实现移动记录的功能。例如移动 Command 命令返回的记录集，可以使用如下语句：

DataEnvironment1.rsCommand1.MoveFirst

DataEnvironment1.rsCommand1.MoveNext

DataEnvironment1.rsCommand1.MovePrevious

DataEnvironment1.rsCommand1.MoveLast

下面移动部门信息表中的记录。运行程序，单击“第一条”、“下一条”等按钮，程序根据 SelectCase 语句中的分支条件移动指定记录，如图 1 所示。

图 1 移动记录

具体操作步骤如下：

（1）新建一个工程，在该工程中创建一个窗体，名为 main_bmgl_view。

（2）添加数据环境设计器，将其中的 Connection 对象连接到 rsdagl.mdb 数据库。

（3）添加一个 Command 对象，在其属性窗口中，设置数据源类型为“表”，对象名称为“部门信息表”。

（4）在 main_bmgl_view 窗体上添加 Label、TextBox 控件和一个名为 cmdMoveData 的 CommandButton 控件数组。

完整程序代码如下：

SubViewData()

WithDataEnvironment1.rsCommand1

Fori=0ToText1.UBound

If.Fields(i)<>""ThenText1(i).Text=.Fields(i)

Nexti

EndWith

EndSub

PrivateSubForm_Load()

DataEnvironment1.rsCommand1.Open"select*from 部门信息表"

EndSub

PrivateSubcmdMoveData_Click(IndexAsInteger)

WithDataEnvironment1.rsCommand1

SelectCaseIndex

Case0'移到第一条记录

IfNot.BOFThen.MoveFirst

Case1'移到上一条记录

If.RecordCount>0Then

If.BOF=FalseThen.MovePrevious

If.BOF=TrueThen.MoveFirst

EndIf

Case2

If.RecordCount>0Then

If.EOF=FalseThen.MoveNext

If.EOF=TrueThen.MoveLast

EndIf

Case3

IfNot.EOFThen.MoveLast

CallViewData

EndSelect

EndWith

CallViewData

EndSub

## 应用六：万能查询（main_fzfind 窗体）完整程序代码

万能查询如图 1 所示。

图 1 万能查询

Dimfld

DimrsAsNewADODB.Recordset

PrivateSubcmdAdd_Click()

DimmyvalAsString

IfcboFields.text=""Then

MsgBox"系统不允许字段名称为空！",,"提示窗口"

ExitSub

EndIf

IfcboOperator.text=""Then

MsgBox"系统不允许运算符为空！",,"提示窗口"

ExitSub

EndIf

Iftxtdata.text=""Then

MsgBox"系统不允许关键字为空！",,"提示窗口"

ExitSub

EndIf

rs.Opentb1,Cnn,adOpenKeyset,adLockOptimistic

SelectCasers.Fields(cboFields.ListIndex).Type

Case129,200,201'字符型

IfcboOperator.text="like"Then

myval="like+'%'+'"+txtdata+"'+'%'"

Else

myval=cboOperator&"'"+txtdata+"'"

EndIf

Case135'日期型

IfcboOperator.text="like"Then

MsgBox"日期型数据不能选用“Like”作为运算符！",,"提示窗口"

cboOperator.ListIndex=1

EndIf

IfIsDate(txtdata)=FalseThen

MsgBox"请输入正确的日期！",,"提示窗口"

rs.Close

ExitSub

EndIf

myval=cboOperator&"'"+txtdata+"'"

Case131,20,3,6'数值型数据

IfIsNumeric(txtdata)=FalseThen

MsgBox"请输入正确的数据！",,"提示窗口"

rs.Close

ExitSub

EndIf

IfcboOperator.text="like"Then

MsgBox"数字数据不能选用“Like”作为运算符！"

cboOperator.ListIndex=1

EndIf

myval=cboOperator&txtdata

Case11

Iftxtdata<>0Ortxtdata<>1Then

MsgBox"只能输入 0 或 1！",,"提示窗口"

rs.Close

ExitSub

EndIf

Case205

MsgBox"图片类型不允许查询",,"提示窗口"

rs.Close

ExitSub

EndSelect

IfList1.ListCount>0Then

IfOpt1.Value=FalseAndOpt2.Value=FalseThen

MsgBox"必须选择一个逻辑值！",,"提示窗口"

Opt1.Value=True

EndIf

IfOpt1.Value=TrueThen

List1.AddItemOpt1.Tag&""&tb1&"."&cboFields&""&myval

EndIf

IfOpt2.Value=TrueThen

List1.AddItemOpt2.Tag&""&tb1&"."&cboFields&""&myval

EndIf

Else

List1.AddItemtb1&"."&cboFields&""&myval

EndIf

cmdFind.Enabled=True

rs.Close

EndSub

PrivateSubForm_Load()

rs.Opentb1,Cnn,adOpenKeyset,adLockOptimistic

Setfld=rs.Fields

ForEachfldInrs.Fields

'向 combo 控件中添加字段

cboFields.AddItemfld.Name

Next

rs.Close

cboFields.ListIndex=0

'向 cboOperator 中添加查询条件

cboOperator.AddItem("like")

cboOperator.AddItem(">")

cboOperator.AddItem("=")

cboOperator.AddItem(">=")

cboOperator.AddItem("<")

cboOperator.AddItem("<=")

cboOperator.AddItem("<>")

cboOperator.ListIndex=0

EndSub

PrivateSubList1_Click()

cmdDel.Enabled=True

EndSub

PrivateSubcmdFind_Click()'查询

DimintXAsInteger'声明计数器变量。

ForintX=1ToList1.ListCount

txtsql=txtsql&""&List1.List(intX)

NextintX

SelectCaseLeft(List1.List(0),3)

Case"and"

sql1=tb1&"where"&Right(List1.List(0),Len(List1.List(0))-3)&Trim(txtsql)

Case"or"

sql1=tb1&"where"&Right(List1.List(0),Len(List1.List(0))-2)&Trim(txtsql)

CaseElse

sql1=tb1&"where"&List1.List(0)&Trim(txtsql)

EndSelect

UnloadMe

EndSub

PrivateSubcmdAll_Click()

sql1=tb1

UnloadMe

EndSub

PrivateSubcmdDel_Click()

List1.RemoveItem(List1.ListIndex)

cmdDel.Enabled=False

IfList1.ListCount=0ThencmdFind.Enabled=False

EndSub

PrivateSubcmdExit_Click()

UnloadMe

EndSub

## 应用七：商品金额大写转换程序

### 实例说明

商品金额大写转换程序。运行程序，在输入金额的文本框内输入一定的数字金额，程序会将这些数字金额自动转换为大写金额，效果如图 1 所示。

图 1 商品金额大写转换程序窗体

### 思路与技术

在开发商业管理软件时，经常会涉及到大小写金额，比如在销售商品的收银窗口，应收金额为 128,988.00 元，如果只使用小写，很容易将位数弄错，如果将小写金额转换为大写金额（拾贰万捌仟玖佰捌拾捌元）就很容易读取了。那么如何将小写数字金额转换为大写的金额呢？

利用 SelectCase 结构，结合阿拉伯数字和汉字数字的规律，编写数字转换函数和位数转换函数。利用这两个函数和字符串函数，转换小写金额为大写金额。

Len 函数的使用。

Len 函数返回 Long，其中包含字符串内字符的数目，或是存储一变量所需的字节数。

语法：

Len(string|varname)

参数说明：

string 任何有效的字符串表达式。如果 string 包含 null，会返回 null。

varname 任何有效的变量名称。如果 varname 包含 null，会返回 null。如果 varname 是 variant，Len 会视其为 string 并且总是返回其包含的字符数。

注意：当在用户自定义数据类型中使用变长字符串时，Len 可能无法确定实际存储所需的字节数目。

利用 SelectCase 语句语句列出 10 个数字对应的大写字，根据要转换的数据在 SelectCase 语句的分支中查找对应的大写字。

### 开发步骤

（1）新建一个标准工程，默认名为【工程 1】。在该工程中会自动创建一个窗体，默认名为【Form1】。

（2）在【Form1】窗体中放置 2 个 TextBox 控件等。主要对象控件的属性如表 1 所示。

表 1 主要控件对象的属性列表

对象 | 属性 | 值 | 功能
Text1 | Enabled | False | 显示大写金额
Lable1 | Caption | 请输入金额 | 标题
Lable2 | Caption | 转换为大写金额 | 标题
Command1 | Caption Default | 退出 True | 退出程序

（3）程序完整代码。

PrivateFunctionsetdata(numAsInteger)AsString'数字转换

SelectCasenum

Case0

setdata="零"

Case1

setdata="壹"

Case2

setdata="贰"

Case3

setdata="叁"

Case4

setdata="肆"

Case5

setdata="伍"

Case6

setdata="陆"

Case7

setdata="柒"

Case8

setdata="捌"

Case9

setdata="玖"

EndSelect

EndFunction

PrivateFunctionchang(aaaAsInteger)AsString'位数转换

SelectCaseaaa

Case1

chang=""

Case2

chang="拾"

Case3

chang="佰"

Case4

chang="仟"

Case5

chang="万"

Case6

chang="拾"

Case7

chang="佰"

Case8

chang="仟"

Case9

chang="亿"

Case10

chang="拾"

EndSelect

EndFunction

PrivateSubForm_Activate()'设定文本长度

Text2.MaxLength=10

Text2.SetFocus

EndSub

PrivateSubText2_Change()'小写转大写

DimiAsInteger

DimjAsInteger

DimmyintAsInteger

Dimmyint1AsInteger

DimmydoubAsDouble

DimmystrAsString

Dimmystr1AsString

Dimmystr2AsString

Dimmystr3AsString

Dimmystr4AsString

DimmoneyAsLong

Dimmoney1AsInteger

Dimmoney2AsLong

mystr=Text2.Text

myint=InStr(mystr,".")

Ifmyint=0Then

mystr=Text2.Text

Else

mystr3=Right(Text2.Text,Len(Text2.Text)-myint)

Ifmystr3<>""Then'转换小数位

mystr4=Left(mystr3,1)

mystr3=Right(mystr3,Len(mystr3)-1)

Ifmystr4<>"0"Then

mystr2=mystr2+setdata(Val(mystr4))+"角"

EndIf

Ifmystr3<>""Then

mystr4=Left(mystr3,1)

mystr2=mystr2+setdata(Val(mystr4))+"分"

EndIf

EndIf

mystr=Left(Text2.Text,myint-1)

EndIf

j=Len(mystr)

Fori=1ToLen(mystr)'转换整数位

money2=Left(mystr,i)

money1=Right(money2,1)

Ifmoney1=0Then

Ifj=5Then

IfRight(mystr1,1)<>"万"Thenmystr1=mystr1&"万"

Else

IfRight(mystr1,1)<>"零"AndRight(money,j)>0Thenmystr1=mystr1&"零"

EndIf

Else

mystr1=mystr1&setdata(money1)+chang(j)

EndIf

j=j-1

Nexti

Text1.Text=mystr1&"元"&mystr2'显示大写

EndSub

PrivateSubCommand1_Click()

End

EndSub

## 应用八：过程的递归调用

过程的递归调用是过程使用自身描述自身，即在过程中调用自身的结构。递归调用分为递归与回归两个过程。

l 递归过程：调用自身，把当前过程中的参数（如形参、变量等）加入栈中，直到递归条件成立时结束。

l 回归过程：当递归条件成立时，从栈中取出参数参与运算，直至栈空。

本例实现的是，通过 SelectCase 语句使用递归调用过程，实现数学运算中的乘积运算。程序运行后的效果如图 1 所示。

图 1 递归调用

完整程序代码如下：

OptionExplicit

FunctionF(nAsInteger)AsLong

Ifn<1Orn>12Then

MsgBox"堆栈溢出，请重新输入！"

ExitFunction

EndIf

SelectCasen

Case1

F=1

CaseElse

F=n*F(n-1)

EndSelect

EndFunction

PrivateSubCommand1_Click()

IfIsNumeric(Text1.Text)ThenText2.Text=F(CInt(Text1.Text))

EndSub

注意：递归调用需要条件成立才能结束，否则程序将产生内存溢出的错误。

## 应用九：设计 MDI 主窗体

MDI 窗体只能包含一个 Menu、PictureBox 控件、具有 Align 属性的 ActiveX 控件和自定义控件，或者具有不可见界面的控件（如 Timer）。为把其它控件添加到 MDI 窗体上，可在窗体上设置一个图片框，然后在图片框中放置其它控件。在 MDI 窗体的图片框中可以使用 Print 方法显示文本，但是不能在 MDI 窗体上直接用 Print 方法显示文本。

本例是利用 MDI 窗体设计的一个具有文档编辑功能的简单程序，它可以新建或打开一个文档并对其进行编辑操作。其中应用 Toolbar 控件的关键代码如下，

PrivateSubtbToolBar_ButtonClick(ByValButtonAsMSComCtlLib.Button)

OnErrorResumeNext

SelectCaseButton.Key

Case"新建"

LoadNewDoc

Case"打开"

mnuFileOpen_Click

Case"保存"

mnuFileSave_Click

Case"打印"

mnuFilePrint_Click

Case"剪切"

mnuEditCut_Click

Case"复制"

mnuEditCopy_Click

Case"粘贴"

mnuEditPaste_Click

Case"粗体"

ActiveForm.rtfText.SelBold=NotActiveForm.rtfText.SelBold

Button.Value=IIf(ActiveForm.rtfText.SelBold,tbrPressed,tbrUnpressed)

Case"斜体"

ActiveForm.rtfText.SelItalic=NotActiveForm.rtfText.SelItalic

Button.Value=IIf(ActiveForm.rtfText.SelItalic,tbrPressed,tbrUnpressed)

Case"下划线"

ActiveForm.rtfText.SelUnderline=NotActiveForm.rtfText.SelUnderline

Button.Value=IIf(ActiveForm.rtfText.SelUnderline,tbrPressed,tbrUnpressed)

Case"左对齐"

ActiveForm.rtfText.SelAlignment=rtfLeft

Case"置中"

ActiveForm.rtfText.SelAlignment=rtfCenter

Case"右对齐"

ActiveForm.rtfText.SelAlignment=rtfRight

EndSelect

EndSub

运行效果如图 1 所示：

图 1 对文档进行编辑操作

完整程序代码

（1）frmMain 窗体完整程序代码

PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,ByVallParamAsAny)AsLong

ConstEM_UNDO=&HC7

PrivateDeclareFunctionOSWinHelp%Lib"user32"Alias"WinHelpA"(ByValhwnd&,ByValHelpFile$,ByValwCommand%,dwDataAsAny)

PrivateSubMDIForm_Load()

Me.Left=GetSetting(App.Title,"Settings","MainLeft",1000)

Me.Top=GetSetting(App.Title,"Settings","MainTop",1000)

Me.Width=GetSetting(App.Title,"Settings","MainWidth",6500)

Me.Height=GetSetting(App.Title,"Settings","MainHeight",6500)

LoadNewDoc

EndSub

PrivateSubLoadNewDoc()

StaticlDocumentCountAsLong

DimfrmDAsfrmDocument

lDocumentCount=lDocumentCount+1

SetfrmD=NewfrmDocument

frmD.Caption="文档"&lDocumentCount

frmD.Show

EndSub

PrivateSubMDIForm_Unload(CancelAsInteger)

IfMe.WindowState<>vbMinimizedThen

SaveSettingApp.Title,"Settings","MainLeft",Me.Left

SaveSettingApp.Title,"Settings","MainTop",Me.Top

SaveSettingApp.Title,"Settings","MainWidth",Me.Width

SaveSettingApp.Title,"Settings","MainHeight",Me.Height

EndIf

EndSub

PrivateSubtbToolBar_ButtonClick(ByValButtonAsMSComCtlLib.Button)

OnErrorResumeNext

SelectCaseButton.Key

Case"新建"

LoadNewDoc

Case"打开"

mnuFileOpen_Click

Case"保存"

mnuFileSave_Click

Case"打印"

mnuFilePrint_Click

Case"剪切"

mnuEditCut_Click

Case"复制"

mnuEditCopy_Click

Case"粘贴"

mnuEditPaste_Click

Case"粗体"

ActiveForm.rtfText.SelBold=NotActiveForm.rtfText.SelBold

Button.Value=IIf(ActiveForm.rtfText.SelBold,tbrPressed,tbrUnpressed)

Case"斜体"

ActiveForm.rtfText.SelItalic=NotActiveForm.rtfText.SelItalic

Button.Value=IIf(ActiveForm.rtfText.SelItalic,tbrPressed,tbrUnpressed)

Case"下划线"

ActiveForm.rtfText.SelUnderline=NotActiveForm.rtfText.SelUnderline

Button.Value=IIf(ActiveForm.rtfText.SelUnderline,tbrPressed,tbrUnpressed)

Case"左对齐"

ActiveForm.rtfText.SelAlignment=rtfLeft

Case"置中"

ActiveForm.rtfText.SelAlignment=rtfCenter

Case"右对齐"

ActiveForm.rtfText.SelAlignment=rtfRight

EndSelect

EndSub

PrivateSubmnuHelpAbout_Click()

MsgBox"版本"&App.Major&"."&App.Minor&"."&App.Revision

EndSub

PrivateSubmnuHelpSearchForHelpOn_Click()

DimnRetAsInteger

'如果这个工程没有帮助文件，显示消息给用户

'可以在“工程属性”对话框中为应用程序设置帮助文件

IfLen(App.HelpFile)=0Then

MsgBox"无法显示帮助目录，该工程没有相关联的帮助。",vbInformation,Me.Caption

Else

OnErrorResumeNext

nRet=OSWinHelp(Me.hwnd,App.HelpFile,261,0)

IfErrThen

MsgBoxErr.Description

EndIf

EndIf

EndSub

PrivateSubmnuHelpContents_Click()

DimnRetAsInteger

'如果这个工程没有帮助文件，显示消息给用户

'可以在“工程属性”对话框中为应用程序设置帮助文件

IfLen(App.HelpFile)=0Then

MsgBox"无法显示帮助目录，该工程没有相关联的帮助。",vbInformation,Me.Caption

Else

OnErrorResumeNext

nRet=OSWinHelp(Me.hwnd,App.HelpFile,3,0)

IfErrThen

MsgBoxErr.Description

EndIf

EndIf

EndSub

PrivateSubmnuWindowArrangeIcons_Click()

Me.ArrangevbArrangeIcons

EndSub

PrivateSubmnuWindowTileVertical_Click()

Me.ArrangevbTileVertical

EndSub

PrivateSubmnuWindowTileHorizontal_Click()

Me.ArrangevbTileHorizontal

EndSub

PrivateSubmnuWindowCascade_Click()

Me.ArrangevbCascade

EndSub

PrivateSubmnuWindowNewWindow_Click()

LoadNewDoc

EndSub

PrivateSubmnuEditPaste_Click()

OnErrorResumeNext

ActiveForm.rtfText.SelRTF=Clipboard.GetText

EndSub

PrivateSubmnuEditCopy_Click()

OnErrorResumeNext

Clipboard.SetTextActiveForm.rtfText.SelRTF

EndSub

PrivateSubmnuEditCut_Click()

OnErrorResumeNext

Clipboard.SetTextActiveForm.rtfText.SelRTF

ActiveForm.rtfText.SelText=vbNullString

EndSub

PrivateSubmnuFileExit_Click()

'卸载窗体

UnloadMe

EndSub

PrivateSubmnuFilePrint_Click()'打印

OnErrorResumeNext

IfActiveFormIsNothingThenExitSub

WithdlgCommonDialog

.DialogTitle="Print"

.CancelError=True

.Flags=cdlPDReturnDC+cdlPDNoPageNums

IfActiveForm.rtfText.SelLength=0Then

.Flags=.Flags+cdlPDAllPages

Else

.Flags=.Flags+cdlPDSelection

EndIf

.ShowPrinter

IfErr<>MSComDlg.cdlCancelThen

ActiveForm.rtfText.SelPrint.hDC

EndIf

EndWith

EndSub

PrivateSubmnuFilePageSetup_Click()

OnErrorResumeNext

WithdlgCommonDialog

.DialogTitle="页面设置"

.CancelError=True

.ShowPrinter

EndWith

EndSub

PrivateSubmnuFileSaveAs_Click()

DimsFileAsString

IfActiveFormIsNothingThenExitSub

WithdlgCommonDialog

.DialogTitle="另存为"

.CancelError=False

'设置 commondialog 控件的标志和属性

.Filter="所有文件(*.*)|*.*|RTF 格式(*.rtf)|*.rtf|文本文件(*.txt)|*.txt"

.ShowSave

IfLen(.FileName)=0Then

ExitSub

EndIf

sFile=.FileName

EndWith

ActiveForm.Caption=sFile

ActiveForm.rtfText.SaveFilesFile

EndSub

PrivateSubmnuFileSave_Click()'保存

DimsFileAsString

IfLeft$(ActiveForm.Caption,8)="Document"Then

WithdlgCommonDialog

.DialogTitle="保存"

.CancelError=False

'设置 commondialog 控件的标志和属性

.Filter="所有文件(*.*)|*.*|RTF 格式(*.rtf)|*.rtf|文本文件(*.txt)|*.txt"

.ShowSave

IfLen(.FileName)=0Then

ExitSub

EndIf

sFile=.FileName

EndWith

ActiveForm.rtfText.SaveFilesFile

Else

sFile=ActiveForm.Caption

ActiveForm.rtfText.SaveFilesFile

EndIf

EndSub

PrivateSubmnuFileOpen_Click()'打开

DimsFileAsString

IfActiveFormIsNothingThenLoadNewDoc

WithdlgCommonDialog

.DialogTitle="打开"

.CancelError=False

'设置 commondialog 控件的标志和属性

.Filter="所有文件(*.*)|*.*|RTF 格式(*.rtf)|*.rtf|文本文件(*.txt)|*.txt"

.ShowOpen

IfLen(.FileName)=0Then

ExitSub

EndIf

sFile=.FileName

EndWith

ActiveForm.rtfText.LoadFilesFile

ActiveForm.Caption=sFile

EndSub

PrivateSubmnuFileNew_Click()

LoadNewDoc

EndSub

（2）frmDocument 窗体完整程序代码

PrivateSubrtfText_SelChange()

fMainForm.tbToolBar.Buttons("粗体").Value=IIf(rtfText.SelBold,tbrPressed,tbrUnpressed)

fMainForm.tbToolBar.Buttons("斜体").Value=IIf(rtfText.SelItalic,tbrPressed,tbrUnpressed)

fMainForm.tbToolBar.Buttons("下划线").Value=IIf(rtfText.SelUnderline,tbrPressed,tbrUnpressed)

fMainForm.tbToolBar.Buttons("左对齐").Value=IIf(rtfText.SelAlignment=rtfLeft,tbrPressed,tbrUnpressed)

fMainForm.tbToolBar.Buttons("置中").Value=IIf(rtfText.SelAlignment=rtfCenter,tbrPressed,tbrUnpressed)

fMainForm.tbToolBar.Buttons("右对齐").Value=IIf(rtfText.SelAlignment=rtfRight,tbrPressed,tbrUnpressed)

EndSub

PrivateSubForm_Load()

Form_Resize

EndSub

PrivateSubForm_Resize()

OnErrorResumeNext

rtfText.Move100,100,Me.ScaleWidth-200,Me.ScaleHeight-200

rtfText.RightMargin=rtfText.Width-400

EndSub

（3）公共模块完整程序代码

PublicfMainFormAsfrmMain

SubMain()

SetfMainForm=NewfrmMain

fMainForm.Show

EndSub