发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:14807, 日期: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中文企业版,测试通过.