# For…Next 语句应用方案

## 知识概述

### For…Next 循环语句

当循环次数确定时，可以使用 For…Next 语句。

语法：

For<变量>=<开始值>To<结束值>[Step<增量>]

[语句组]

[ExitFor]

[语句组]

Next[变量]

For…Next 语句的参数说明如表 1 所示。

表 1For…Next 语句的参数说明

参数 | 描述
变量 | 必要参数。循环次数的计数数值变量，这个变量不能是 Boolean 型或数组元素
开始值 | 必要参数。变量的初值
结束值 | 必要参数。变量的终值
增量 | 可选参数。变量的步长（每循环一次增加或减少的数值）。如果没有指定，则增量的默认值为 1，为负数时则是变量每次减少的数值
语句组 | 可选参数。放在 For 和 Next 之间的一条或多条语句
ExitFor | 一种退出 For 循环的方法，会将控制权转移到 Next 之后的语句

For…Next 语句执行过程如图 1 所示。

图 1For 语句的执行流程图

（1）如果不指定“步长”，则系统默认步长为 1；当“初值＜终值”时，“步长”为 0；当“初值＞终值”时，“步长”应小于 0。

（2）ExitFor 用来退出循环，执行 Next 后面的语句。

（3）如果出现循环变量的值总是不超出终值的情况，则会产生死循环。此时，可按〈Ctrl+Break〉组合键，强制终止程序的运行。

（4）循环次数 N=Int((终值－初值)/步长+1)。

（5）Next 后面的循环变量名必须与 For 语句中的循环变量名相同，并且可以省略。

例如在 ComboBox 下拉列表控件中添加 1～12 个月，代码如下。

PrivateSubForm_Load()

Dimi% '定义一个整型变量

Fori=1To12

Combo1.AddItemi&"月"

Nexti

EndSub

按〈F5〉键，运行工程，效果如图 2 所示。

图 2For 语句的简单应用

如果只显示 2、4、6 等偶数月份，则应将上述代码改为：

PrivateSubForm_Load()

Dimi%

Fori=1To12Step2

Combo1.AddItemi+1&"月"

Nexti

EndSub

如果只显示 1、3、5 等奇数月份，则只须将上述代码中的 Combo1.AddItemi+1&"月"改为 Combo1.AddItemi&"月"。

另外，For 循环中的计数还可以是倒数，只要把间隔值设为负值（即间隔值小于 0），而令初始值大于终止值就可以了。这时，循环的停止条件将会变成是计数值小于终止值时停止。

例如在窗体上输出 10～1 的整数，代码如下。

PrivateSubForm_Click()

Dimi%

Fori=10To1Step-1

Printi

Nexti

EndSub

注意：增量的值不能为0。如果为0程序将进入死循环。而且最好不要在循环所执行的语句组当中改变循环次数的计数变量的值，这样会使程序代码的阅读和调试变得更加困难，不便于程序的维护。

## 应用一：打印 99 乘法表

For...Next 语句可以嵌套，即一个在另一个里面。本示例是运用嵌套的循环在窗体上打印出 99 乘法表，如图 1 和 2 所示。

图 1 窗体程序

图 2 打印出的结果

完整程序代码如下：

PrivateSubCommand1_Click()

Cls

Fori=1To9

Forj=1Toi

a=i*j

PrintTab(j*12-12);j&"*"&i&"="&a;

Nextj

Nexti

EndSub

## 应用二：控制 ProgressBar 控件进度

ProgressBar 控件在工程中经常被用在数据备份和数据恢复中用户显示备份和恢复的进度，如图 1 所示的即为 ProgressBar 控件，用于显示数据备份的进度。

图 1 数据备份

其关键代码如下。

Dimworkarea(6)AsString'定义字符串变量

Dimstr1AsString

Dimstr2AsString

DimcharAsByte

PrivateSubCommand1_Click()

str1=App.Path&"\db_kfgl.mdb"

str2=App.Path&"\数据库备份\db_kfgl.mdb"

IfMsgBox("确定备份数据？",4,"信息提示")=vbYesThen

Command1.Enabled=False

ProgressBar1.Visible=True

ProgressBar1.Max=UBound(workarea)

ProgressBar1.Value=ProgressBar1.Min

ForCounter=LBound(workarea)ToUBound(workarea)

workarea(Counter)="initialvalue"&Counter

ProgressBar1.Value=Counter

Openstr1ForBinaryAs#1

Openstr2ForBinaryAs#2

DoWhileNotEOF(1)

Get#1,,char

Put#2,,char

Loop

Close

NextCounter

ProgressBar1.Value=ProgressBar1.Min

MsgBox"数据库备份成功！",,"信息提示"

EndIf

EndSub

完整程序代码

Dimworkarea(6)AsString'定义字符串变量

Dimstr1AsString

Dimstr2AsString

DimcharAsByte

PrivateSubCommand1_Click()

str1=App.Path&"\db_kfgl.mdb"

str2=App.Path&"\数据库备份\db_kfgl.mdb"

A=MsgBox("确定备份数据？",4,"信息提示")

IfA=vbYesThen

Command1.Enabled=False

ProgressBar1.Visible=True

ProgressBar1.Max=UBound(workarea)

ProgressBar1.Value=ProgressBar1.Min

ForCounter=LBound(workarea)ToUBound(workarea)

workarea(Counter)="initialvalue"&Counter

ProgressBar1.Value=Counter

Openstr1ForBinaryAs#1

Openstr2ForBinaryAs#2

DoWhileNotEOF(1)

Get#1,,char

Put#2,,char

Loop

Close

NextCounter

ProgressBar1.Value=ProgressBar1.Min

MsgBox"数据库备份成功！",,"信息提示"

Command1.Enabled=True

EndIf

EndSub

PrivateSubCommand2_Click()

UnloadMe

EndSub

## 应用三：选择结构与循环结构的嵌套

在 VB 中，所有的控制结构（包括 If 语句、SelectCase 语句、Do…Loop 语句、For…Next 语句等）都可以嵌套使用。

例如将 100 元钱换成零钱（5 元、10 元、20 元中的任意多个面值）有很多种换法。组成 100 元的零钱中，最多有 20 个 5 元、10 个 10 元和 5 个 20 元。判断所有的组合中，总和正好是 100 元的，代码如下。这类方法称为“穷举法”，也称为“列举法”。

PrivateSubForm_Click()

Dimx%,y%,z%,n% '定义整型变量

Print"5 元个数","10 元个数","20 元个数" '输出标题

Forx=0To20 '5 元的个数

Fory=0To10 '10 元的个数

Forz=0To5 '20 元的个数

If5*x+y*10+z*20=100Then '满足条件

n=n+1 '满足条件的组合数

Printx,y,z '输出结果

EndIf

Nextz

Nexty

Nextx

Print"共有"&n&"种换法" '输出满足条件的组合数

EndSub

上述程序使用了三重 For…Next 循环，循环计数器变量分别为 x、y、z，代表 5 元、10 元和 20 元的个数，20 个 5 元、10 个 10 元和 5 个 20 元之内共有 21×11×6＝1386 种组合，内嵌 If…Then 判断总和正好等于 100 元的只有 36 种，如图 1 所示。

图 1 兑换零钱

## 应用四：动态设置 MSFlexGrid 内容

借书管理如图 1 所示。

图 1 借书管理

Dims,Y,i'声明变量

'声明数据集对象

Dimrs1AsNewADODB.Recordset

Dimrs2AsNewADODB.Recordset

Dimrs3AsNewADODB.Recordset

DimlsphAsInteger'声明一个整型变量

PrivateSubForm_Load()

'定义 MS1 表格的行数、列数

MS1.Rows=102

MS1.Cols=10

'定义 MS1 表格的列宽和表头信息

s=Array("300","990","3000","800","1200","800","600","1000","1200","800")

Y=Array("xh","条形码","书名","作者","出版社","单价","数量","金额","图书类别","备注")

Fori=0To9

MS1.ColWidth(i)=s(i)

MS1.TextMatrix(0,i)=Y(i)

Nexti

'定义 MS1 表格的行号

Fori=1To101

MS1.TextMatrix(i,0)=i

Nexti

rq.Caption=Date'设置借书日期

EndSub

PrivateSubForm_Unload(CancelAsInteger)

frm_main.Enabled=True

EndSub

PrivateSubDataCombo1_Change()

Adodc3.RecordSource="select*fromreadswhere 书证号='"+DataCombo1.text+"'"

Adodc3.Refresh

IfAdodc3.Recordset.RecordCount>0Then

jsr.Caption=Adodc3.Recordset.Fields("姓名")

EndIf

EndSub

PrivateSubdatacombo1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

IfKeyCode=vbKeyReturnThenTjsr.SetFocus

EndSub

PrivateSubTjsr_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

IfKeyCode=vbKeyReturnThen'按回车键

Text1.Visible=True

'到达第 1 行，第 1 列

MS1.Row=1

MS1.Col=1

Text1.SetFocus

EndIf

EndSub

PrivateSubMS1_Click()

IfMS1.Row>=1AndMS1.TextMatrix(MS1.Row-1,2)<>""Then'在 MS1 表格第 1 行或大于第 1 行时

Text1.Visible=True'text1 可见

Text1.SetFocus

EndIf

EndSub

PrivateSubMS1_entercell()

DimX,Y,pAsString

IfMS1.CellWidth<=0OrMS1.CellHeight<=0ThenExitSub

X=MS1.TextMatrix(MS1.FixedRows,MS1.Col)

Y=MS1.TextMatrix(MS1.Row,0)

IfY<>""Then

IfMS1.Col-MS1.LeftCol<=3ThenMS1.LeftCol=MS1.LeftCol+1

IfMS1.CellWidth>0AndMS1.CellHeight>0Then

Text1.Width=MS1.CellWidth:Text1.Height=MS1.CellHeight

Text1.Left=MS1.CellLeft+MS1.Left

Text1.Top=MS1.CellTop+MS1.Top

EndIf

X=MS1.TextMatrix(MS1.FixedRows,MS1.Col)

Y=MS1.TextMatrix(MS1.Row,0)

p=MS1.TextMatrix(MS1.Row,MS1.Col)

Text1.text=MS1.text

Text1.SelStart=0

Text1.SelLength=Len(Text1.text)

EndIf

EndSub

PrivateSubMS1_RowColChange()'格式化金额

Fori=1To100

IfMS1.TextMatrix(i,1)<>""Then

MS1.TextMatrix(i,5)=Format(MS1.TextMatrix(i,5),"#0.00")

MS1.TextMatrix(MS1.Row,7)=Val(MS1.TextMatrix(MS1.Row,6))*Val(MS1.TextMatrix(MS1.Row,5))

MS1.TextMatrix(i,7)=Format(MS1.TextMatrix(i,7),"#0.00")

EndIf

Nexti

EndSub

PrivateSubText1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

IfKeyCode=vbKeyReturnThen

Adodc1.RecordSource="select*fromkcbwhere 条形码='"+MS1.TextMatrix(MS1.Row,1)+"'"

Adodc1.Refresh

IfMS1.Col=1Then

WithAdodc1.Recordset

If.RecordCount>0Then'当记录大于零时

'赋值给 MS1 表格

If.Fields("条形码")<>""ThenMS1.TextMatrix(MS1.Row,1)=.Fields("条形码")

If.Fields("书名")<>""ThenMS1.TextMatrix(MS1.Row,2)=.Fields("书名")

If.Fields("作者")<>""ThenMS1.TextMatrix(MS1.Row,3)=.Fields("作者")

If.Fields("出版社")<>""ThenMS1.TextMatrix(MS1.Row,4)=.Fields("出版社")

If.Fields("单价")<>""ThenMS1.TextMatrix(MS1.Row,5)=.Fields("单价")

If.Fields("图书类别")<>""ThenMS1.TextMatrix(MS1.Row,8)=.Fields("图书类别")

MS1.Col=5

Text1.SetFocus

EndIf

EndWith

EndIf

IfMS1.Col=10Then

MS1.Row=MS1.Row+1

MS1.Col=1

Else

IfMS1.Col+1<=MS1.Cols-1Then

MS1.Col=MS1.Col+1

Else

IfMS1.Row+1<=MS1.Rows-1Then

MS1.Row=MS1.Row+1

MS1.Col=1

EndIf

EndIf

EndIf

EndIf

IfKeyCode=vbKeyUpThen

IfMS1.Row>1ThenMS1.Row=MS1.Row-1

EndIf

IfKeyCode=vbKeyDownAnd(MS1.TextMatrix(MS1.Row,2))<>""Then

IfMS1.Row<99ThenMS1.Row=MS1.Row+1

EndIf

IfKeyCode=vbKeyLeftThen

IfText1.text<>""Then

Text1.SelStart=0

Text1.SelLength=Len(Text1.text)

EndIf

IfMS1.Col-8<=MS1.Cols+1Then

MS1.Col=MS1.Col-1

IfMS1.Col=0ThenMS1.Col=1

Else

IfMS1.Row+1<=MS1.Row-1Then

MS1.Row=MS1.Row+1

MS1.Col=1

EndIf

EndIf

EndIf

IfKeyCode=vbKeyRightThen

IfText1.text<>""Then

Text1.SelStart=0

Text1.SelLength=Len(Text1.text)

EndIf

IfMS1.Col+1<=MS1.Cols-1Then

MS1.Col=MS1.Col+1

Else

IfMS1.Row+1<=MS1.Rows-1Then

MS1.Row=MS1.Row+1

MS1.Col=1

EndIf

EndIf

EndIf

EndSub

PrivateSubText1_Change()

MS1.text=Text1.text'赋值给 MS1.text

IfMS1.Col=5ThenMS1.TextMatrix(MS1.Row,7)=Val(MS1.TextMatrix(MS1.Row,6))*Val(MS1.TextMatrix(MS1.Row,5))

IfMS1.Col=6ThenMS1.TextMatrix(MS1.Row,7)=Val(MS1.TextMatrix(MS1.Row,6))*Val(MS1.TextMatrix(MS1.Row,5))

Dima,BAsSingle

Fori=1To101

a=Val(MS1.TextMatrix(i,7))+a

B=Val(MS1.TextMatrix(i,6))+B

IfMS1.TextMatrix(i,1)<>""Thenpz.Caption=i

Nexti

hjje.Caption=a

hjsl.Caption=B'计算合计金额，合计数量

EndSub

PrivateSubCmdReg_Click()

'查询所有借书数据,并按票号排序

Adodc2.RecordSource="select*fromjsborderby 票号"

Adodc2.Refresh

'创建借书票号

IfAdodc2.Recordset.RecordCount>0Then

IfNotAdodc2.Recordset.EOFThenAdodc2.Recordset.MoveLast

IfAdodc2.Recordset.Fields("票号")<>""Then

lsph=Right(Trim(Adodc2.Recordset.Fields("票号")),4)+1

PH.Caption=Date&"js"&Format(lsph,"0000")

EndIf

Else

PH.Caption=Date&"js"&"0001"

EndIf

'设置控件有效或无效

Text1.Enabled=True

'确定文本框在 MS1 表格中的位置

Text1.Width=MS1.CellWidth

Text1.Height=MS1.CellHeight

Text1.Left=MS1.CellLeft+MS1.Left

Text1.Top=MS1.CellTop+MS1.Top

MS1.Enabled=True

CmdSave.Enabled=True

CmdCancel.Enabled=True

CmdReg.Enabled=False

EndSub

PrivateSubCmdSave_Click()

Fori=1To101

WithMS1

If.TextMatrix(i,1)<>""Then

Setrs1=NewADODB.Recordset

rs1.Open"select*fromjsb",Cnn,adOpenKeyset,adLockOptimistic

'添加借书信息到"jsb"表中

rs1.AddNew

If.TextMatrix(i,1)<>""Thenrs1.Fields("条形码")=.TextMatrix(i,1)

If.TextMatrix(i,2)<>""Thenrs1.Fields("书名")=.TextMatrix(i,2)

If.TextMatrix(i,3)<>""Thenrs1.Fields("作者")=.TextMatrix(i,3)

If.TextMatrix(i,4)<>""Thenrs1.Fields("出版社")=.TextMatrix(i,4)

If.TextMatrix(i,5)<>""Thenrs1.Fields("单价")=.TextMatrix(i,5)

If.TextMatrix(i,6)<>""Thenrs1.Fields("借出数量")=.TextMatrix(i,6)

If.TextMatrix(i,7)<>""Thenrs1.Fields("金额")=.TextMatrix(i,7)

If.TextMatrix(i,8)<>""Thenrs1.Fields("图书类别")=.TextMatrix(i,8)

If.TextMatrix(i,9)<>""Thenrs1.Fields("备注")=.TextMatrix(i,9)

IfDataCombo1.text<>""Thenrs1.Fields("书证号")=Trim(DataCombo1.text)

Ifjsr.Caption<>""Thenrs1.Fields("借书人")=jsr.Caption

IfTjsr.text<>""Thenrs1.Fields("借书经手人")=Tjsr.text

Ifrq.Caption<>""Thenrs1.Fields("借书日期")=rq.Caption

IfPH.Caption<>""Thenrs1.Fields("票号")=PH.Caption

IfTjsr.text<>""Thenrs1.Fields("操作员")=frm_main.St1.Panels(3).text

rs1.Fields("是否归还")="否"

rs1.Update'更新表

rs1.Close

'查找库存图书信息

Setrs2=NewADODB.Recordset

rs2.Open"select*fromkcbwhere 条形码='"+.TextMatrix(i,1)+"'",Cnn,adOpenKeyset,adLockOptimistic

Ifrs2.RecordCount>0Then

'更新"kcb"表中的"库存"及"库存金额"

rs2.Fields("现存数量")=Val(rs2.Fields("现存数量"))-Val(.TextMatrix(i,6))

rs2.Fields("金额")=Val(rs2.Fields("现存数量"))*Val(rs2.Fields("单价"))

rs2.Fields("借出次数")=Val(rs2.Fields("借出次数"))+1

rs2.Update

Else

MsgBox"库存无此图书,不能进行借阅！"

ExitSub

EndIf

rs2.Close

DimsAsInteger

s=Val(MS1.TextMatrix(i,6))+s

Setrs3=NewADODB.Recordset

rs3.Open"select*fromreadswhere 书证号='"+DataCombo1.text+"'",Cnn,adOpenKeyset,adLockOptimistic

Ifrs3.RecordCount>0Then

'更新"kcb"表中的"库存"及"库存金额"

rs3.Fields("已借书数")=Val(rs3.Fields("已借书数"))+s

rs3.Update

Else

MsgBox"此读者不存在！"

ExitSub

EndIf

EndIf

EndWith

Nexti

'清空数据

Fori=1To101

Forj=1To9

MS1.TextMatrix(i,j)=""

Nextj

Nexti

Tjsr.text=""

pz.Caption=""

hjsl.Caption=""

hjje.Caption=""

Text1.Visible=False'设置控件不可见

MS1.Enabled=False

CmdSave.Enabled=False

CmdReg.Enabled=True

CmdCancel.Enabled=False

EndSub

PrivateSubCmdCancel_Click()'取消操作

Tjsr.text=""

pz.Caption=""

hjsl.Caption=""

hjje.Caption=""

Fori=1To100

Forj=1To9

MS1.TextMatrix(i,j)=""

Nextj

Nexti

Text1.Enabled=False

MS1.Enabled=False

CmdSave.Enabled=False

CmdCancel.Enabled=False

CmdReg.Enabled=True

CmdReg.SetFocus

EndSub

PrivateSubCmdEnd_Click()

frm_main.Enabled=True

UnloadMe

EndSub

## 应用五：酒店信息模块

酒店信息管理主要能够对酒店信息进行编辑、保存、取消等操作，其运行结果如图 1 所示。

图 1 运行结果

程序完整代码如下：

Dimi,jAsInteger

PrivateSubCmd_edit_Click()

Forj=0To7

Text1(j).Locked=False

Nextj

Text1(0).SetFocus

EndSub

PrivateSubCommand2_Click()

Callmain

Adodc1.RecordSource="select*fromTable_jdxxb"

Adodc1.Refresh

IfAdodc1.Recordset.RecordCount>0Then

Adodc1.Recordset.Delete

SetadoRs=adoCon.Execute("insertintoTable_jdxxbvalues("&Text1(0)&",'"&Text1(1)&"','"&Text1(2)&"','"&Text1(3)&"','"&Text1(4)&"','"&Text1(5)&"','"&Text1(6)&"','"&Text1(7)&"')")

MsgBox"数据保存成功",32,"酒店管理系统"

Forj=0To7

Text1(j).Locked=True

Nextj

Else

IfText1(0).Text=""Then

MsgBox"酒店编号输入不能为空"

Else

SetadoRs=adoCon.Execute("insertintoTable_jdxxbvalues("&Text1(0)&",'"&Text1(1)&"','"&Text1(2)&"','"&Text1(3)&"','"&Text1(4)&"','"&Text1(5)&"','"&Text1(6)&"','"&Text1(7)&"')")

MsgBox"数据保存成功",32,"酒店管理系统"

Forj=0To7

Text1(j).Locked=True

Nextj

EndIf

EndIf

adoCon.Close

EndSub

PrivateSubCommand3_Click()

Fori=0To7

Text1(i).Text=""

Nexti

Text1(0).SetFocus

EndSub

PrivateSubCommand4_Click()

UnloadMe

EndSub

PrivateSubForm_Load()

i=0

j=0

Me.Left=(Screen.Width-Me.Width)/2

Me.Top=(Screen.Height-Me.Height)/2

Adodc1.RecordSource="select*fromTable_jdxxb"

Adodc1.Refresh

IfAdodc1.Recordset.RecordCount>0Then

Fori=0To7

'将数据库中的记录值赋给控件数组

Text1(i).Text=Adodc1.Recordset.Fields.Item(j).Value

j=j+1

Nexti

Else

EndIf

Cmd_edit.TabIndex=0

EndSub

PrivateSubText1_GotFocus(IndexAsInteger)

Text1(0).Locked=False

EndSub

PrivateSubText1_LostFocus(IndexAsInteger)

DimStrInput,TempAsString

Dimi,LengthAsInteger

i=1

StrInput=Text1(0).Text

Length=Len(StrInput)

IfText1(0).Text=""Then

MsgBox"输入不能为空",,"提示"

Text1(0).SetFocus

Else

DoWhile(i<=Length)

Temp=Mid$(StrInput,i,1)

IfAsc(Temp)<48OrAsc(Temp)>57Then

Ifi=1Then

MsgBox"输入数据非法!!",,"提示"

Else

EndIf

Text1(0).Text=""

Text1(0).SetFocus

Else

EndIf

i=i+1

Loop

IfText1(0).Text=""Then

Text1(0).SetFocus

Else

EndIf

EndIf

EndSub

## 应用六：可任意旋转的图像

利用 PictureBox 控件的 Pset 方法，实现图像的旋转。首先，将 Picture1 坐标原点移动到控件的中心，然后，设置其移动焦点并旋转后的坐标，接着设置其恢复原点，旋转后的坐标 ，最后，在 Picture2 中绘制图片。

运行程序，在文本框中输入要旋转的角度，然后单击“执行”按钮，即可将该图片旋转为指定的角度。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Option Explicit

Const PI = 3.1415

Private Sub Command1_Click()

Dim x As Integer, y As Integer '点在 Picture1 中的坐标

Dim X1 As Integer, Y1 As Integer '过渡坐标

Dim X2 As Double, Y2 As Double '过渡坐标

Dim X3 As Double, Y3 As Double '点经过旋转后在 Picture2 中的坐标

Dim angle As Double '旋转的角度

Dim radian As Double '旋转的弧度

angle = Text1.Text '获得旋转的角度

radian = angle * PI / 180 '获得旋转的弧度

Picture2.Cls

For x = 0 To Picture1.Width

For y = 0 To Picture1.Height

X1 = x - Picture1.Width \ 2

Y1 = y - Picture1.Height \ 2

'将坐标轴原点移动到 Picture1 的中心后原来坐标为(x,y)的点的新坐标为(X1,Y1)

X2 = X1 * Cos(radian) + Y1 * Sin(radian) '获得在更改坐标原点后旋转后该点的 X 坐标

Y2 = Y1 * Cos(radian) - X1 * Sin(radian) '获得在更改坐标原点后旋转后该点的 Y 坐标

X3 = X2 + Picture1.Width \ 2 '获得恢复坐标原点后旋转后的 X 坐标

Y3 = Y2 + Picture1.Height \ 2 '获得恢复坐标原点后旋转后的 Y 坐标

If X3 > 0 And X3 < Picture2.Width - 1 And Y3 > 0 _

And Y3 < Picture2.Height - 1 Then

Picture2.PSet (X3, Y3), Picture1.Point(x, y) '将 Picture1 中(x,y)点复制到 Picture2 的(X3,Y3)点

End If

Next y

Next x

End Sub

Private Sub Form_Load()

Picture1.ScaleMode = 3

Picture2.ScaleMode = 3

Form1.ScaleMode = 3

End Sub

## 应用七：类似 Windows XP 的界面

在 Windows XP 环境下打开“我的电脑”，会发现左侧的导航界面很实用。双击展开按钮，导航栏功能显示出来，双击收缩按钮，导航按钮收缩。这里通过 VB 也实现了这样的窗体。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Const speed = 60

Dim expand As Boolean

Dim myindex As Integer

Dim doresize As Boolean

Private Sub Form_Load()

For i = 0 To MenuHeader.Count - 1

MenuHeader(i).Picture = img1.Picture

MenuHeader(i).Height = 375

MenuHeader(i).Width = XPMenu(i).Width

Next

doresize = False

End Sub

Private Sub lbl1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

lbl1(Index).Font.Underline = True

End Sub

Private Sub lblHeader_Click(Index As Integer)

MenuHeader_Click (Index)

End Sub

Private Sub MenuHeader_Click(Index As Integer)

If doresize = False Then

If XPMenu(Index).Height = MenuHeader(i).Height Then

expand = True

Else

expand = False

End If

doresize = True

myindex = Index

End If

End Sub

Private Sub Timer1_Timer()

On Error Resume Next

Dim ExpandHeight As Integer

ExpandHeight = 0

For i = 1 To XPMenu.Count - 1

XPMenu(i).Top = XPMenu(i - 1).Top + XPMenu(i - 1).Height + 120

Next

If doresize = True Then

If expand = False Then

MenuHeader(myindex).Picture = img2.Picture

XPMenu(myindex).Height = XPMenu(myindex).Height - speed

If XPMenu(myindex).Height <= MenuHeader(myindex).Height Then

doresize = False

XPMenu(myindex).Height = MenuHeader(myindex).Height

End If

Else

MenuHeader(myindex).Picture = img1.Picture

XPMenu(myindex).Height = XPMenu(myindex).Height + speed

For i = 0 To Me.Count - 1

If Controls(i).Container.Name = XPMenu(myindex).Name Then

If Controls(i).Container.Index = XPMenu(myindex).Index Then

If Controls(i).Top + Controls(i).Height > ExpandHeight Then

ExpandHeight = Controls(i).Top + Controls(i).Height

End If

End If

End If

Next

If XPMenu(myindex).Height >= ExpandHeight + 120 Then

doresize = False

XPMenu(myindex).Height = ExpandHeight + 120

End If

End If

End If

End Sub

Private Sub XPMenu_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

For i = 0 To lbl1.UBound

lbl1(i).Font.Underline = False

Next i

End Sub

## 应用八：通用商品入库窗体设计

### 实例说明

在通用的进销存管理软件或库存管理软件中，商品入库操作是最基本的功能，也是程序开发的重点和难点，那么该如何设计商品入库程序呢？

使用 MSFlexGrid 控件作为商品入库的主要录入窗口，通过 TextBox 控件向具有只读属性的 MSFlexGrid 控件的表格内输入入库商品信息，然后通过 For…Next 循环语句将 MSFlexGrid 表格内的数据保存到数据表 rkd、rkph 中，判断库存表中是否存在该商品，如果存在，将入库数量与库存中的数量相加（库存金额自动计算），用入库单价替换库存单价（先进后出法）；如果库存不存在该商品，则将该商品直接保存到库存表中。如有未付款，则将未付款保存到往来账款表中。

商品入库模块涉及 4 个表，表 rkph、rkd、kc、gys。

其中表 rkph、rkd 分别为入库主要数据表、明细数据表，主要数据表与明细数据表彼此之间具有一对多的关系，rkph 和 rkd 通过票号建立一对多关系。rkph 表主要记录入库的票号、日期、入库产品数、入库总数量、入库总金额、供应商、应付、实付、未付等主要信息，入库时无论入库产品多少，只要是一次性录入，保存时只产生一条入库信息。rkd 表主要记录入库产品的商品名称、编号、规格、单位、数量、进价、金额、保质期、票号等详细商品入库信息。入库多少商品，保存时就产生多少入库明细记录。

kc 和 gys 为库存表和供应商表，主要保存库存信息和供应商往来信息。

通用商品入库窗体，主要实现药品批量入库。运行程序，效果如图 1 所示。

图 1 通用商品入库窗体设计

### 思路与技术

For...Next

以指定次数来重复执行一组语句。For 循环使用一个叫做计数器的变量，每重复一次循环之后，计数器变量的值就会增加或者减少。For 循环语句的用法如下。

语法：

Forcounter=startToend[Stepstep]

[statements]

[ExitFor]

[statements]

Next[counter]

参数说明：

counter 必要参数，用做循环计数器的数值变量。这个变量不能是布尔或数组元素。

start 必要参数，counter 的初值。

end 必要参数，counter 的终值。

Step 可选参数，counter 的步长。如果没有指定，则 step 的缺省值为 1。

statements 可选参数，放在 For 和 Next 之间的一条或多条语句，它们将被执行指定的次数。

step 可以是正数或负数。step 值决定循环的执行情况。

当所有循环中的语句都执行后，step 的值会加到 counter 中。此时，循环中的语句可能会再次执行（基于循环开始执行时同样的测试），也可能退出循环并从 Next 语句之后的语句继续执行。

注意：在循环中改变 counter 的值，将会使程序代码的阅读和调试变得更加困难。

循环中可以在任何位置放置任意个 ExitFor 语句，随时退出循环。ExitFor 经常在条件判断之后使用，例如 If...Then，并将控制权转移到紧接在 Next 之后的语句。

可以将一个 For...Next 循环放置在另一个 For...Next 循环中，组成嵌套循环。不过在每个循环中的 counter 要使用不同的变量名。

注意：用 Exit 语句可以直接退出 For 循环、Do 循环、子过程或函数过程。Exit 语句的语法很简单：ExitFor 在 For 循环中出现的次数没有限制，ExitDo 在 Do 循环中出现的次数也没有限制。

### 开发步骤

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

（2）单击【工程】菜单下的【部件】选项，在弹出的列表中选中【MicrosoftADODataControl6.0（sp3）】和【MicrosoftFlexGridControl6.0（sp3）】选项，然后单击【确定】按钮，Adodc 控件和 MSFlexGrid 控件将被添加到工具箱中。

（3）在【Form1】窗体中放置 1 个 Adodc 控件、1 个 MSFlexGrid 控件、8 个 TextBox 控件、4 个 Label 控件、4 个 CommandButton 控件等。主要控件对象的属性如表 1 所示。

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

对象 | 属性 | 值 | 功能
Adodc1 | ConnectionString RecordSource Visible | Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurityInfo=False;DataSource=Yyjxc.mdb select*fromrkd false | 提供数据查询
MSFlexGrid1 | 名称 | Mf1 | 提供数据录入
Text1 | 名称 | gys | 提供数据录入
Text2 | 名称 | jsr | 提供数据录入
Text3 | 名称 | PH | 显示票号
Text4 | 名称 | rkrq | 显示入库日期
Text5 | 名称 | js | 显示入库品种
Text6 | 名称 | hjsl | 显示合计数量
Text7 | 名称 | hj | 显示合计金额
Command1 | 名称 | Cmddj | 登记命令
Command2 | 名称 | Cmdbc | 保存入库信息
Command3 | 名称 | Cmdqx | 取消命令
Command4 | 名称 | CmdEnd | 退出程序

（4）程序完整代码。

Dims,Y,i'定义变量

Dimrs1AsADODB.Recordset

Dimrs2AsADODB.Recordset

Dimrs3AsADODB.Recordset

DimlsphAsInteger'定义一个整型变量

DimcnnAsADODB.Connection

PrivateSubForm_Load()

'定义 mf1 表的总行数、总列数

mf1.Rows=102

mf1.Cols=12

'定义 mf1 表的列宽和表头信息

s=Array("300","1500","900","1200","900","1200","600","600","600","900","1140","850")

Y=Array("xh","商品名称","简称","批号","厂家","规格","包装","单位","数量","单价","金额","备注")

Fori=0To11

mf1.ColWidth(i)=s(i)

mf1.TextMatrix(0,i)=Y(i)

Nexti

'定义 mf1 表的固定行数、固定列数

mf1.FixedRows=1

mf1.FixedCols=1

'定义 mf1 表的列序号

Fori=1To101

mf1.TextMatrix(i,0)=i

Nexti

rkrq.Text=Date'设置入库日期

Setcnn=NewADODB.Connection

cnn.Open"Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurityInfo=False;DataSource=Yyjxc.mdb"

EndSub

PrivateSubgys_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

IfKeyCode=vbKeyReturnThenjsr.SetFocus'按回车键 jsr 获得焦点

EndSub

PrivateSubjsr_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

IfKeyCode=vbKeyReturnThen'按回车键

text1.Visible=True

mf1.Row=1

mf1.Col=1'到达第 1 行，第 1 列

text1.SetFocus

EndIf

IfKeyCode=vbKeyUpThengys.SetFocus'按向上键 gys 获得焦点

EndSub

PrivateSubmf1_Click()

Ifmf1.Row>=1Andmf1.TextMatrix(mf1.Row-1,8)<>""Then'在 mf1 表格第 1 行或大于第 1 行时

text1.Visible=True'text1 可见

text1.SetFocus

EndIf

EndSub

PrivateSubmf1_entercell()

'确定 text1 在 mf1 表格中的大小及位置

DimX,YAsString

Ifmf1.CellWidth<=0Ormf1.CellHeight<=0ThenExitSub

X=mf1.TextMatrix(mf1.FixedRows,mf1.Col)

Y=mf1.TextMatrix(mf1.Row,0)

IfY<>""Then

Ifmf1.Col-mf1.LeftCol<=3Then

mf1.LeftCol=mf1.LeftCol+1

EndIf

Ifmf1.CellWidth>0Andmf1.CellHeight>0Then

text1.Width=mf1.CellWidth

text1.Height=mf1.CellHeight

text1.Left=mf1.CellLeft+mf1.Left

text1.Top=mf1.CellTop+mf1.Top

EndIf

X=mf1.TextMatrix(mf1.FixedRows,mf1.Col)

Y=mf1.TextMatrix(mf1.Row,0)

p=mf1.TextMatrix(mf1.Row,mf1.Col)

text1.Text=mf1.Text

text1.SelStart=0

text1.SelLength=Len(text1.Text)

EndIf

EndSub

PrivateSubmf1_RowColChange()'格式化金额

Fori=1To100

Ifmf1.TextMatrix(i,1)<>""Then

mf1.TextMatrix(i,9)=Format(mf1.TextMatrix(i,9),"#0.000")

mf1.TextMatrix(mf1.Row,10)=Val(mf1.TextMatrix(mf1.Row,9))*Val(mf1.TextMatrix(mf1.Row,8))

mf1.TextMatrix(i,10)=Format(mf1.TextMatrix(i,10),"#0.00")

EndIf

Nexti

EndSub

PrivateSubText1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)

'按键盘左键，text1 向左移动

IfKeyCode=vbKeyReturnThen

Ifmf1.Col=10Then

mf1.Row=mf1.Row+1

mf1.Col=1

Else

Ifmf1.Col+1<=mf1.Cols-1Then

mf1.Col=mf1.Col+1

Else

Ifmf1.Row+1<=mf1.Rows-1Then

mf1.Row=mf1.Row+1

mf1.Col=1

EndIf

EndIf

EndIf

EndIf

'按键盘向上键，text1 向上移动

IfKeyCode=vbKeyUpThen

Ifmf1.Row>1Thenmf1.Row=mf1.Row-1

EndIf

'按键盘向下键，text1 向下移动

IfKeyCode=vbKeyDownAnd(mf1.TextMatrix(mf1.Row,2))<>""Then

Ifmf1.Row<99Thenmf1.Row=mf1.Row+1

EndIf

'按键盘左键，text1 向左移动

IfKeyCode=vbKeyLeftThen

Iftext1.Text<>""Then

text1.SelStart=0

text1.SelLength=Len(text1.Text)

EndIf

Ifmf1.Col-11<=mf1.Cols+1Then

mf1.Col=mf1.Col-1

Ifmf1.Col=0Thenmf1.Col=1

Else

Ifmf1.Row+1<=mf1.Row-1Then

mf1.Row=mf1.Row+1

mf1.Col=1

EndIf

EndIf

EndIf

'按键盘左键，text1 向右移动

IfKeyCode=vbKeyRightThen

Iftext1.Text<>""Then

text1.SelStart=0

text1.SelLength=Len(text1.Text)

EndIf

Ifmf1.Col+1<=mf1.Cols-1Then

mf1.Col=mf1.Col+1

Else

Ifmf1.Row+1<=mf1.Rows-1Then

mf1.Row=mf1.Row+1

mf1.Col=1

EndIf

EndIf

EndIf

EndSub

PrivateSubText1_Change()

mf1.Text=text1.Text'赋值给 mf1.text

Ifmf1.Col=8Thenmf1.TextMatrix(mf1.Row,10)=Val(mf1.TextMatrix(mf1.Row,8))*Val(mf1.TextMatrix(mf1.Row,9))

Ifmf1.Col=9Then

mf1.TextMatrix(mf1.Row,10)=Val(mf1.TextMatrix(mf1.Row,8))*Val(mf1.TextMatrix(mf1.Row,9))

Ifmf1.TextMatrix(mf1.Row,8)=""Then

MsgBox("数量无,请重新输入!!!")

mf1.Col=8

EndIf

EndIf

Ifmf1.Col=11Then

Ifmf1.TextMatrix(mf1.Row,9)=""Then

MsgBox("单价无,请重新输入!!!")

mf1.Col=9

EndIf

EndIf

DimA,BAsSingle

Fori=1To31

A=Val(mf1.TextMatrix(i,10))+A:B=Val(mf1.TextMatrix(i,8))+B

Ifmf1.TextMatrix(i,1)<>""Andmf1.TextMatrix(i,8)<>""Thenjs.Text=i

Nexti

hj.Text=A

hjsl.Text=B'计算合计金额，合计数量

EndSub

PrivateSubCmddj_Click()

'查询所有入库数据,并按票号排序

Adodc1.RecordSource="select*fromrkdorderby 票号"

Adodc1.Refresh

'创建入库票号

IfAdodc1.Recordset.RecordCount>0Then

IfNotAdodc1.Recordset.EOFThenAdodc1.Recordset.MoveLast

IfAdodc1.Recordset.Fields("票号")<>""Then

lsph=Right(Trim(Adodc1.Recordset.Fields("票号")),4)+1

PH.Text=Date&"rkd"&Format(lsph,"0000")

EndIf

Else

PH.Text=Date&"rkd"&"0001"

EndIf

'设置控件有效或无效

gys.Enabled=True

jsr.Enabled=True

text1.Enabled=True

mf1.Enabled=True

Cmdbc.Enabled=True

Cmdqx.Enabled=True

Cmddj.Enabled=False

'清空数据

Fori=1To100

Forj=1To11

mf1.TextMatrix(i,j)=""

Nextj

Nexti

gys.SetFocus

mf1.Row=1

mf1.Col=1'到达 mf1 表格的第 1 行，第 1 列

EndSub

PrivateSubCmdbc_Click()

Setrs1=NewADODB.Recordset

Setrs2=NewADODB.Recordset

rs1.Open"select*fromrkd",cnn,adOpenKeyset,adLockOptimistic

rs2.Open"select*fromrkph",cnn,adOpenKeyset,adLockOptimistic

Fori=1To100

Ifmf1.TextMatrix(i,1)<>""Andmf1.TextMatrix(i,8)<>""Then

'添加入库商品信息到"rkd"表中

rs1.AddNew

Ifmf1.TextMatrix(i,1)<>""Thenrs1.Fields("商品名称")=mf1.TextMatrix(i,1)

Ifmf1.TextMatrix(i,2)<>""Thenrs1.Fields("简称")=mf1.TextMatrix(i,2)

Ifmf1.TextMatrix(i,3)<>""Thenrs1.Fields("批号")=mf1.TextMatrix(i,3)

Ifmf1.TextMatrix(i,4)<>""Thenrs1.Fields("产地")=mf1.TextMatrix(i,4)

Ifmf1.TextMatrix(i,5)<>""Thenrs1.Fields("规格")=mf1.TextMatrix(i,5)

Ifmf1.TextMatrix(i,6)<>""Thenrs1.Fields("包装")=mf1.TextMatrix(i,6)

Ifmf1.TextMatrix(i,7)<>""Thenrs1.Fields("单位")=mf1.TextMatrix(i,7)

Ifmf1.TextMatrix(i,8)<>""Thenrs1.Fields("数量")=mf1.TextMatrix(i,8)

Ifmf1.TextMatrix(i,9)<>""Thenrs1.Fields("进价")=mf1.TextMatrix(i,9)

Ifmf1.TextMatrix(i,10)<>""Thenrs1.Fields("金额")=mf1.TextMatrix(i,10)

Ifmf1.TextMatrix(i,11)<>""Thenrs1.Fields("备注")=mf1.TextMatrix(i,11)

Ifgys.Text<>""Thenrs1.Fields("供应商")=gys.Text

Ifjsr.Text<>""Thenrs1.Fields("经手人")=jsr.Text

Ifrkrq.Text<>""Thenrs1.Fields("日期")=rkrq.Text

IfPH.Text<>""Thenrs1.Fields("票号")=PH.Text

rs1.Update'更新表

EndIf

Setrs3=NewADODB.Recordset

rs3.Open"select*fromkcwhere 商品名称='"+Trim(mf1.TextMatrix(i,1))+"'",cnn,adOpenKeyset,adLockOptimistic

Ifrs3.RecordCount>0Then

rs3.Fields("库存")=Val(rs3.Fields("库存"))+Val(mf1.TextMatrix(i,8))

rs3.Fields("库存金额")=Val(rs3.Fields("库存"))*Val(mf1.TextMatrix(i,9))

rs3.Update

EndIf

Nexti

rs2.AddNew

Ifgys.Text<>""Thenrs2.Fields("供应商")=gys.Text

Ifrkrq.Text<>""Thenrs2.Fields("日期")=rkrq.Text

IfPH.Text<>""Thenrs2.Fields("入库票号")=PH.Text

Ifjs.Text<>""Thenrs2.Fields("品种数")=js.Text

Ifhjsl.Text<>""Thenrs2.Fields("数量")=hjsl.Text

Ifhj.Text<>""Thenrs2.Fields("金额")=hj.Text

rs2.Update

rs1.Close

rs2.Close

rs3.Close

'清空数据

Fori=1To100

Forj=1To11

mf1.TextMatrix(i,j)=""

Nextj

Nexti

gys.Text=""

jsr.Text=""

js.Text=""

hjsl.Text=""

hj.Text=""

text1.Visible=False'设置控件不可见

'设置控件有效或无效

mf1.Enabled=False

Cmdbc.Enabled=False

Cmddj.Enabled=True

Cmdqx.Enabled=False

EndSub

PrivateSubCmdqx_Click()'取消操作

gys.Text=""

jsr.Text=""

js.Text=""

hjsl.Text=""

hj.Text=""

Fori=1To100

Forj=1To11

mf1.TextMatrix(i,j)=""

Nextj

Nexti

gys.Enabled=False

jsr.Enabled=False

text1.Enabled=False

mf1.Enabled=False

Cmdbc.Enabled=False

Cmdqx.Enabled=False

Cmddj.Enabled=True

Cmddj.SetFocus

EndSub

PrivateSubCmdEnd_Click()

End

EndSub

注意：运用 For 循环语句保存数据时，保存商品入库票号信息到数据表 rkph 中的语句应放在循环语句外。