frmchangeproduct.frm

这是一个用VB编写的用于外贸行业的供应商信息管理系统。

VERSION 5.00
Begin VB.Form frmChangeProduct 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ChangeProduct"
   ClientHeight    =   6915
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   12060
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6915
   ScaleWidth      =   12060
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox lstProduct 
      Height          =   4560
      Left            =   5280
      TabIndex        =   8
      Top             =   1440
      Width           =   6735
   End
   Begin VB.TextBox txtProductName 
      Height          =   375
      Left            =   6720
      TabIndex        =   7
      Top             =   960
      Width           =   5295
   End
   Begin VB.CommandButton btnBack 
      Caption         =   "Back"
      Height          =   375
      Left            =   7080
      TabIndex        =   6
      Top             =   6360
      Width           =   1215
   End
   Begin VB.CommandButton btnChange 
      Caption         =   "Change"
      Default         =   -1  'True
      Height          =   375
      Left            =   4560
      TabIndex        =   4
      Top             =   6360
      Width           =   1095
   End
   Begin VB.TextBox txtCategoryName 
      Height          =   375
      Left            =   1440
      TabIndex        =   2
      Top             =   960
      Width           =   3735
   End
   Begin VB.ListBox lstCategory 
      Height          =   4560
      Left            =   0
      TabIndex        =   3
      Top             =   1440
      Width           =   5175
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      Caption         =   "Change     Product"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   14.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1920
      TabIndex        =   5
      Top             =   240
      Width           =   8415
   End
   Begin VB.Label Label2 
      Caption         =   "category_name:"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "product_name:"
      Height          =   375
      Left            =   5400
      TabIndex        =   0
      Top             =   960
      Width           =   1335
   End
End
Attribute VB_Name = "frmChangeProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public cn As New ADODB.Connection
Public rs1 As New ADODB.Recordset
Public rs2 As New ADODB.Recordset
Dim curPoint As Integer
Dim curPoint1 As Integer
Dim productName As String
Dim categoryName As String

Private Sub showCategoryData()
    Dim i As Integer
    rs1.Open "category", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    For i = 1 To rs1.RecordCount
        lstCategory.AddItem (rs1.Fields("category_name"))
        rs1.MoveNext
    Next i
    rs1.Close
End Sub

Private Sub showProductData()
    categoryName = lstCategory.List(curPoint)
    txtCategoryName.Text = categoryName
    'clear listbox
    lstProduct.Clear
    'add fit's  items
    rs2.Open "select * from product where category_name='" & categoryName & "'", cn, adOpenDynamic
    While Not rs2.EOF
        lstProduct.AddItem (rs2.Fields("product_name"))
        rs2.MoveNext
    Wend
    rs2.Close
    txtProductName.Text = lstProduct.List(curPoint1)
    productName = txtProductName.Text
End Sub

Private Sub btnBack_Click()
    Unload Me
    frmAddProduct.Show 1
End Sub

Private Sub btnChange_Click()
    Dim i As Integer
    rs1.Open "category", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    rs2.Open "product", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    If txtProductName.Text > "" Then
        If productName = "" Then
            MsgBox "you should select a product, change error!", vbExclamation, "error"
            rs1.Close
            rs2.Close
            Exit Sub
        End If
        rs2.Find "product_name='" & productName & "'"
        While Not rs2.EOF
            If rs2.Fields("category_name") = txtCategoryName.Text Then
                rs2.Fields("product_name") = txtProductName.Text
                rs2.Update
                lstProduct.List(curPoint1) = txtProductName.Text
                txtProductName.SetFocus
            End If
            rs2.MoveNext
            rs2.Find "product_name='" & productName & "'"
        Wend
    End If
    rs1.Close
    rs2.Close

End Sub

Private Sub Form_Activate()
    curPoint1 = 0
    curPoint = 0
    Set cn = New ADODB.Connection
    cn.Open strCn
    Set rs1 = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    showCategoryData
    showProductData
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cn.Close
End Sub

Private Sub lstproduct_Click()
    curPoint1 = lstProduct.ListIndex
    txtProductName.Text = lstProduct.List(curPoint1)
End Sub

Private Sub lstCategory_Click()
    curPoint = lstCategory.ListIndex
    showProductData
End Sub

Private Sub txtCategoryName_GotFocus()
    txtCategoryName.SelStart = 0
    txtCategoryName.SelLength = Len(txtCategoryName.Text)
End Sub

Private Sub txtproductName_GotFocus()
    txtProductName.SelStart = 0
    txtProductName.SelLength = Len(txtProductName.Text)
End Sub
Private Sub txtproductname_LostFocus()
    If Len(txtProductName.Text) > 50 Then
        MsgBox "the length of product name need less 50.", vbCritical, "over length error"
    End If
End Sub

Private Sub txtCategoryName_LostFocus()
    If Len(txtCategoryName.Text) > 50 Then
        MsgBox "the length of categoryname need less 50.", vbCritical, "over length error"
    End If
End Sub