发表评论(0)作者：不详, 平台：VB6.0+Win98, 阅读：14578, 日期：2002-01-23
举例说明VB中控件数组的使用方法
--------------------------------------------------------------------------------
作者:张小辉
作者语：本文中所涉及代码摘自我的进销存程序的“进货单录入、修改”模块中，其中省略了数据库绑定及打印模块。通过本例的介绍，希望能让大家了解“控件数组”在程序中的使用方法，意在抛砖引玉。
所谓控件数组可以简单理解为具有相同name属性的控件集合，如绘制10个TEXT控件，它们的NAME属性均为txtindex。通过使用控件数组，可以使这些TEXT控件共享相同的事件过程。它的最大好处是：节省代码，增加可读性，同时也减少了内存的开销。控件数组可以分为静态数组及动态数组两种，本文就是利用动态数组的特性来实现我们的目的。
设计阶段：
一、首先新建一窗体，名为：frmmain,所需控件如下：(图一)
建立一个LABEL控件数组，名为lblcolumn，属性为：Appearance:Flat,Backcolor:&H00808080&
BorderStyle:Fixed Single Caption 属性如图一所示;分别建立五个控件数组：cboproductid()、
txtdescription()、txtunitprice()、txtqty()、lbltotal(),Appearance:Flat,BorderStyle:Fixed Single,
第一行Index为1;（可用复制、粘贴方法）;绘制4个LineR控件，颜色如图,以模拟3D效果。单独建立一个
Label控件名为lblgrandtotal,用来显示总金额。别添加三个按钮控件，Name:cmdaddnew,cmddelitem,cmdquit
frmmai.frm代码：
Option Explicit
注释：功能简介：
注释：可以包含任意控件，以及和数据库绑定
注释：自由添加行及删除行，暂设最大行为12
注释：当前行自动增亮
注释：自动添加内容
注释：自动计算及进行数据验证
Private Sub cboproductid_Click(Index As Integer)
Dim i%
注释：当选择产品时，自动填充单价及描述
i = cboproductid(Index).ListIndex
If i >= 0 Then
txtdescription(Index).Text = _
productinfo(i + 1).description
txtunitprice(Index).Text = _
Format(productinfo(i + 1).unitprice, "###.00")
End If
End Sub
Private Sub cboproductid_GotFocus(Index As Integer)
newcurrentline Index注释：设置当前行增亮显示
End Sub
Private Sub cmdaddnew_Click()
Dim newline As Integer, linetop As Single, i As Integer
newline = cboproductid.UBound + 1
If newline > lines_max Then
cmdaddnew.Enabled = False
MsgBox "不能大于" & lines_max & "行！"
Exit Sub
End If
Load cboproductid(newline) 注释：添加新的一行
Load txtdescription(newline)
Load txtunitprice(newline)
Load txtqty(newline)
Load lbltotal(newline)
注释：定义位置及可视性
linetop = cboproductid(newline - 1).Top + cboproductid(newline - 1).Height
cboproductid(newline).Top = linetop
cboproductid(newline).Visible = True 注释：必须设为TRUE
cboproductid(newline).Text = ""
txtdescription(newline).Top = linetop
txtdescription(newline).Visible = True
txtdescription(newline).Text = ""
txtunitprice(newline).Top = linetop
txtunitprice(newline).Visible = True
txtunitprice(newline).Text = ""
txtqty(newline).Top = linetop
txtqty(newline).Visible = True
txtqty(newline).Text = ""
lbltotal(newline).Top = linetop
lbltotal(newline).Visible = True
lbltotal(newline).Caption = ""
For i = 1 To product_num 注释：填写充字段
cboproductid(newline).AddItem productinfo(i).id
Next
End Sub
Private Sub cmddelitem_Click()
注释：不能删除第一行，因为它不是动态添加的。
注释：应先把当前行后面所有行的内容往上移一行
Dim Index As Integer, lastline As Integer
Dim reply
lastline = txtqty.UBound
If currentline = 0 Or lastline = 1 Then
MsgBox "对不起，您不能删除第一行！"
Exit Sub
End If
reply = MsgBox("真的要删除此记录吗？", vbExclamation + vbOKCancel, "删除")
If reply = vbOK Then
For Index = currentline To lastline - 1
cboproductid(Index).Text = cboproductid(Index + 1).Text
txtdescription(Index).Text = txtdescription(Index + 1).Text
txtunitprice(Index).Text = txtunitprice(Index + 1).Text
txtqty(Index).Text = txtqty(Index + 1).Text
lbltotal(Index).Caption = lbltotal(Index + 1).Caption
Next
lbltotal(lastline).Caption = ""
If currentline = lastline Then
cboproductid(lastline - 1).SetFocus
End If
Unload cboproductid(lastline)
Unload txtdescription(lastline)
Unload txtunitprice(lastline)
Unload txtqty(lastline)
Unload lbltotal(lastline)
cmdaddnew.Enabled = True
End If
End Sub
Private Sub cmdquit_Click()
Unload Me 注释：退出
End Sub
Private Sub Form_Load()
Call addproduct 注释：调用子程序,初始化产品ID
End Sub
Private Sub newcurrentline(newline As Integer)
Dim Index As Integer
Dim focolor As Long, bkcolor As Long
currentline = newline 注释：这里改变了当前行变量，并设置前景和背景色
For Index = cboproductid.LBound To cboproductid.UBound
If Index = currentline Then
focolor = vbHighlightText
bkcolor = vbHighlight
Else
focolor = vbWindowText
bkcolor = vbWindowBackground
End If
cboproductid(Index).ForeColor = focolor
cboproductid(Index).BackColor = bkcolor
txtdescription(Index).ForeColor = focolor
txtdescription(Index).BackColor = bkcolor
txtunitprice(Index).ForeColor = focolor
txtunitprice(Index).BackColor = bkcolor
txtqty(Index).ForeColor = focolor
txtqty(Index).BackColor = bkcolor
lbltotal(Index).ForeColor = focolor
lbltotal(Index).BackColor = bkcolor
Next
End Sub
Private Sub lbltotal_Change(Index As Integer)
注释：改变总金额
Dim i As Integer, result As Currency
For i = lbltotal.LBound To lbltotal.UBound
If lbltotal(i).Caption <> "" Then
result = result + CCur(lbltotal(i).Caption)
End If
Next
lblgrandtotal.Caption = Format(result, "###,###.00")
End Sub
Private Sub lbltotal_Click(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtdescription_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtqty_Change(Index As Integer)
updatetotal Index注释：调用子程序计算金额
End Sub
Private Sub txtqty_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtqty_KeyPress(Index As Integer, KeyAscii As Integer)
注释：验证数据的合法性
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 Then
KeyAscii = 0
Beep
End If
End Sub
Private Sub txtunitprice_Change(Index As Integer)
updatetotal Index
End Sub
Private Sub txtunitprice_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub updatetotal(Index As Integer)
注释：当用户更改单价及数量字段时，自动更改金额字段
If txtqty(Index).Text <> "" And txtunitprice(Index).Text <> "" Then
注释：强制转换数据类型为货币型
lbltotal(Index).Caption = Format(CCur(txtqty(Index).Text) * CCur(txtunitprice(Index).Text), "###,###.00")
Else
lbltotal(Index).Caption = ""
End If
End Sub
(计算效果如图二)
Private Sub txtunitprice_KeyPress(Index As Integer, KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 _
And KeyAscii <> Asc(".") Then
KeyAscii = 0
Beep
End If
End Sub
========================
二，新建一模块，名为：module1。
module1代码:
Option Explicit
注释：自定义用户函数
Type proinfo
id As String
description As String 注释：规格描述
unitprice As Currency 注释：单价，货币型
End Type
Public Const lines_max = 12 注释：最大行数
Public Const product_num = 5 注释：产品数
Public currentline As Integer 注释：当前行
Public productinfo() As proinfo 注释：定义动态数组（自定义函数）
Public Sub addproduct()
注释：初始化产品分类信息，并保存。用来在用户选择注释：产品ID注释：时填充
注释：规格描述注释：及注释：单价注释：字段（可以从数据库中载入)
Dim i%
ReDim productinfo(1 To product_num) As proinfo
注释：赋值
productinfo(1).id = "Hdisk"
productinfo(1).description = "昆腾火球10G"
productinfo(1).unitprice = 650
productinfo(2).id = "Modem"
productinfo(2).description = "金浪硬猫V.90"
productinfo(2).unitprice = 150.7
productinfo(3).id = "Mouse"
productinfo(3).description = "PS/2型"
productinfo(3).unitprice = 25.5
productinfo(4).id = "Cdrom"
productinfo(4).description = "SONY 50X"
productinfo(4).unitprice = 360
productinfo(5).id = "key"
productinfo(5).description = "康柏101"
productinfo(5).unitprice = 56
For i = 1 To product_num
frmmain.cboproductid(1).AddItem productinfo(i).id 注释：模块之间通信须详细指明对象位置
Next
End Sub
依照本例，可以自由添加功能，如加上打印模块及数据库功能，完全可以替代VB自带flexgrid/dbgrid/datagrid等控件，实现它们不具备的功能。
调试环境：win9x/vb6.0中文企业版,测试通过.
--------------------------------------------------------------------------------
作者:张小辉
作者语：本文中所涉及代码摘自我的进销存程序的“进货单录入、修改”模块中，其中省略了数据库绑定及打印模块。通过本例的介绍，希望能让大家了解“控件数组”在程序中的使用方法，意在抛砖引玉。
所谓控件数组可以简单理解为具有相同name属性的控件集合，如绘制10个TEXT控件，它们的NAME属性均为txtindex。通过使用控件数组，可以使这些TEXT控件共享相同的事件过程。它的最大好处是：节省代码，增加可读性，同时也减少了内存的开销。控件数组可以分为静态数组及动态数组两种，本文就是利用动态数组的特性来实现我们的目的。
设计阶段：
一、首先新建一窗体，名为：frmmain,所需控件如下：(图一)
建立一个LABEL控件数组，名为lblcolumn，属性为：Appearance:Flat,Backcolor:&H00808080&
BorderStyle:Fixed Single Caption 属性如图一所示;分别建立五个控件数组：cboproductid()、
txtdescription()、txtunitprice()、txtqty()、lbltotal(),Appearance:Flat,BorderStyle:Fixed Single,
第一行Index为1;（可用复制、粘贴方法）;绘制4个LineR控件，颜色如图,以模拟3D效果。单独建立一个
Label控件名为lblgrandtotal,用来显示总金额。别添加三个按钮控件，Name:cmdaddnew,cmddelitem,cmdquit
frmmai.frm代码：
Option Explicit
注释：功能简介：
注释：可以包含任意控件，以及和数据库绑定
注释：自由添加行及删除行，暂设最大行为12
注释：当前行自动增亮
注释：自动添加内容
注释：自动计算及进行数据验证
Private Sub cboproductid_Click(Index As Integer)
Dim i%
注释：当选择产品时，自动填充单价及描述
i = cboproductid(Index).ListIndex
If i >= 0 Then
txtdescription(Index).Text = _
productinfo(i + 1).description
txtunitprice(Index).Text = _
Format(productinfo(i + 1).unitprice, "###.00")
End If
End Sub
Private Sub cboproductid_GotFocus(Index As Integer)
newcurrentline Index注释：设置当前行增亮显示
End Sub
Private Sub cmdaddnew_Click()
Dim newline As Integer, linetop As Single, i As Integer
newline = cboproductid.UBound + 1
If newline > lines_max Then
cmdaddnew.Enabled = False
MsgBox "不能大于" & lines_max & "行！"
Exit Sub
End If
Load cboproductid(newline) 注释：添加新的一行
Load txtdescription(newline)
Load txtunitprice(newline)
Load txtqty(newline)
Load lbltotal(newline)
注释：定义位置及可视性
linetop = cboproductid(newline - 1).Top + cboproductid(newline - 1).Height
cboproductid(newline).Top = linetop
cboproductid(newline).Visible = True 注释：必须设为TRUE
cboproductid(newline).Text = ""
txtdescription(newline).Top = linetop
txtdescription(newline).Visible = True
txtdescription(newline).Text = ""
txtunitprice(newline).Top = linetop
txtunitprice(newline).Visible = True
txtunitprice(newline).Text = ""
txtqty(newline).Top = linetop
txtqty(newline).Visible = True
txtqty(newline).Text = ""
lbltotal(newline).Top = linetop
lbltotal(newline).Visible = True
lbltotal(newline).Caption = ""
For i = 1 To product_num 注释：填写充字段
cboproductid(newline).AddItem productinfo(i).id
Next
End Sub
Private Sub cmddelitem_Click()
注释：不能删除第一行，因为它不是动态添加的。
注释：应先把当前行后面所有行的内容往上移一行
Dim Index As Integer, lastline As Integer
Dim reply
lastline = txtqty.UBound
If currentline = 0 Or lastline = 1 Then
MsgBox "对不起，您不能删除第一行！"
Exit Sub
End If
reply = MsgBox("真的要删除此记录吗？", vbExclamation + vbOKCancel, "删除")
If reply = vbOK Then
For Index = currentline To lastline - 1
cboproductid(Index).Text = cboproductid(Index + 1).Text
txtdescription(Index).Text = txtdescription(Index + 1).Text
txtunitprice(Index).Text = txtunitprice(Index + 1).Text
txtqty(Index).Text = txtqty(Index + 1).Text
lbltotal(Index).Caption = lbltotal(Index + 1).Caption
Next
lbltotal(lastline).Caption = ""
If currentline = lastline Then
cboproductid(lastline - 1).SetFocus
End If
Unload cboproductid(lastline)
Unload txtdescription(lastline)
Unload txtunitprice(lastline)
Unload txtqty(lastline)
Unload lbltotal(lastline)
cmdaddnew.Enabled = True
End If
End Sub
Private Sub cmdquit_Click()
Unload Me 注释：退出
End Sub
Private Sub Form_Load()
Call addproduct 注释：调用子程序,初始化产品ID
End Sub
Private Sub newcurrentline(newline As Integer)
Dim Index As Integer
Dim focolor As Long, bkcolor As Long
currentline = newline 注释：这里改变了当前行变量，并设置前景和背景色
For Index = cboproductid.LBound To cboproductid.UBound
If Index = currentline Then
focolor = vbHighlightText
bkcolor = vbHighlight
Else
focolor = vbWindowText
bkcolor = vbWindowBackground
End If
cboproductid(Index).ForeColor = focolor
cboproductid(Index).BackColor = bkcolor
txtdescription(Index).ForeColor = focolor
txtdescription(Index).BackColor = bkcolor
txtunitprice(Index).ForeColor = focolor
txtunitprice(Index).BackColor = bkcolor
txtqty(Index).ForeColor = focolor
txtqty(Index).BackColor = bkcolor
lbltotal(Index).ForeColor = focolor
lbltotal(Index).BackColor = bkcolor
Next
End Sub
Private Sub lbltotal_Change(Index As Integer)
注释：改变总金额
Dim i As Integer, result As Currency
For i = lbltotal.LBound To lbltotal.UBound
If lbltotal(i).Caption <> "" Then
result = result + CCur(lbltotal(i).Caption)
End If
Next
lblgrandtotal.Caption = Format(result, "###,###.00")
End Sub
Private Sub lbltotal_Click(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtdescription_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtqty_Change(Index As Integer)
updatetotal Index注释：调用子程序计算金额
End Sub
Private Sub txtqty_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub txtqty_KeyPress(Index As Integer, KeyAscii As Integer)
注释：验证数据的合法性
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 Then
KeyAscii = 0
Beep
End If
End Sub
Private Sub txtunitprice_Change(Index As Integer)
updatetotal Index
End Sub
Private Sub txtunitprice_GotFocus(Index As Integer)
newcurrentline Index
End Sub
Private Sub updatetotal(Index As Integer)
注释：当用户更改单价及数量字段时，自动更改金额字段
If txtqty(Index).Text <> "" And txtunitprice(Index).Text <> "" Then
注释：强制转换数据类型为货币型
lbltotal(Index).Caption = Format(CCur(txtqty(Index).Text) * CCur(txtunitprice(Index).Text), "###,###.00")
Else
lbltotal(Index).Caption = ""
End If
End Sub
(计算效果如图二)
Private Sub txtunitprice_KeyPress(Index As Integer, KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 _
And KeyAscii <> Asc(".") Then
KeyAscii = 0
Beep
End If
End Sub
========================
二，新建一模块，名为：module1。
module1代码:
Option Explicit
注释：自定义用户函数
Type proinfo
id As String
description As String 注释：规格描述
unitprice As Currency 注释：单价，货币型
End Type
Public Const lines_max = 12 注释：最大行数
Public Const product_num = 5 注释：产品数
Public currentline As Integer 注释：当前行
Public productinfo() As proinfo 注释：定义动态数组（自定义函数）
Public Sub addproduct()
注释：初始化产品分类信息，并保存。用来在用户选择注释：产品ID注释：时填充
注释：规格描述注释：及注释：单价注释：字段（可以从数据库中载入)
Dim i%
ReDim productinfo(1 To product_num) As proinfo
注释：赋值
productinfo(1).id = "Hdisk"
productinfo(1).description = "昆腾火球10G"
productinfo(1).unitprice = 650
productinfo(2).id = "Modem"
productinfo(2).description = "金浪硬猫V.90"
productinfo(2).unitprice = 150.7
productinfo(3).id = "Mouse"
productinfo(3).description = "PS/2型"
productinfo(3).unitprice = 25.5
productinfo(4).id = "Cdrom"
productinfo(4).description = "SONY 50X"
productinfo(4).unitprice = 360
productinfo(5).id = "key"
productinfo(5).description = "康柏101"
productinfo(5).unitprice = 56
For i = 1 To product_num
frmmain.cboproductid(1).AddItem productinfo(i).id 注释：模块之间通信须详细指明对象位置
Next
End Sub
依照本例，可以自由添加功能，如加上打印模块及数据库功能，完全可以替代VB自带flexgrid/dbgrid/datagrid等控件，实现它们不具备的功能。
调试环境：win9x/vb6.0中文企业版,测试通过.
RSS地址