form1.frm

VB源码,是初学者的福因.让你很快掌握VB编程

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2550
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7200
   LinkTopic       =   "Form1"
   ScaleHeight     =   2550
   ScaleWidth      =   7200
   Begin VB.TextBox txtQTY 
      Height          =   270
      Index           =   1
      Left            =   3960
      TabIndex        =   6
      Text            =   "0"
      Top             =   240
      Width           =   975
   End
   Begin VB.TextBox txtUnitPrice 
      Height          =   270
      Index           =   1
      Left            =   2760
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   240
      Width           =   1095
   End
   Begin VB.TextBox txtDescription 
      Height          =   270
      Index           =   1
      Left            =   1440
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   240
      Width           =   1215
   End
   Begin VB.ComboBox cboProductID 
      Height          =   300
      Index           =   1
      Left            =   240
      TabIndex        =   3
      Text            =   "Combo1"
      Top             =   240
      Width           =   1095
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "Quit"
      Height          =   375
      Left            =   6120
      TabIndex        =   2
      Top             =   2040
      Width           =   975
   End
   Begin VB.CommandButton cmdDelItem 
      Caption         =   "Del Item"
      Height          =   375
      Left            =   6120
      TabIndex        =   1
      Top             =   1440
      Width           =   975
   End
   Begin VB.CommandButton cmdAddNew 
      Caption         =   "Add New"
      Height          =   375
      Left            =   6120
      TabIndex        =   0
      Top             =   840
      Width           =   975
   End
   Begin VB.Label lblGrandTotal 
      Caption         =   "0"
      Height          =   375
      Left            =   6120
      TabIndex        =   8
      Top             =   240
      Width           =   735
   End
   Begin VB.Label lblTotal 
      Caption         =   "0"
      Height          =   255
      Index           =   1
      Left            =   5040
      TabIndex        =   7
      Top             =   240
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
     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