VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 举例说明VB中控件数组的使用方法
发表评论(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中文企业版,测试通过.