frmcustomer.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

    If Not Trim(txtFields(3)) = Trim(itsLastName) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(4)) = Trim(itsStreetAddress) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(5)) = Trim(itsCity) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(6)) = Trim(itsStateProvCode) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(7)) = Trim(itsZipPostalCode) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(8)) = Trim(itsPhoneNumber) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(9)) = Trim(itsEntryDate) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(10)) = Trim(itsCustTypeCode) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(11)) = Trim(itsActiveCode) Then
        Changed = True
        Exit Function
    End If
    Changed = False
End Function
Private Function Save()
    Save = True
    If Changed Then
        If RecordOK Then
            If MsgBox("Save changes?", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
                SaveRecord
            End If
        Else
            MsgBox itsErrorMsg, vbCritical, Me.Caption
        End If
    End If
End Function
Private Sub GetRecord(ID As Long)
    Dim cnnConnection As ADODB.Connection
    Dim strQry As String
    
    On Error GoTo VBError
    strQry = "select * from Customers " & "where Cust_id=" & Trim(CStr(ID))
    On Error GoTo ADOError
    Set cnnConnection = New Connection
    cnnConnection.ConnectionString = itsConnectionString
    cnnConnection.Open
    
    Dim rstCustomers As Recordset
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    NewRecord '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    If rstCustomers.EOF = True And rstCustomers.BOF = True Then
        
    Else
        itsCust_id = rstCustomers!Cust_id
        If Not IsNull(rstCustomers!CompanyName) Then
            itsCompanyName = rstCustomers!CompanyName
        End If
        If Not IsNull(rstCustomers!FirstName) Then
            itsFirstName = rstCustomers!Firs_Name
        End If
        If Not IsNull(rstCustomers!Las_Name) Then
            itsLastName = rstCustomers!LastName
        End If
        If Not IsNull(rstCustomers!StreetAddress) Then
            itsStreetAddress = rstCustomers!StreetAddress
        End If
        If Not IsNull(rstCustomers!City) Then
            itsCity = rstCustomers!City
        End If
        If Not IsNull(rstCustomers!StateProvCode) Then
            itsStateProvCode = rstCustomers!StateProvCode
        End If
        If Not IsNull(rstCustomers!ZipPostalCode) Then
            itsZipPostalCode = rstCustomers!ZipPostalCode
        End If
        If Not IsNull(rstCustomers!Phon_Number) Then
            itsPhoneNumber = rstCustomers!PhoneNumber
        End If
        If Not IsNull(rstCustomers!EntryDate) Then
            itsEntryDate = rstCustomers!EntryDate
        End If
        If Not IsNull(rstCustomers!Cus_TypeCode) Then
            itsCustTypeCode = rstCustomers!CustTypeCode
        End If
        If Not IsNull(rstCustomers!ActiveFlag) Then
            itsActiveCode = rstCustomers!Activ_Flag
        End If
    End If
    DisplayRecord
    On Error GoTo VBError
        
    rstCustomers.Close
    cnnConnection.Close
Done:
    Set rstCustomers = Nothing
    Set cnnConnection = Nothing
    Exit Sub
ADOError:
    DisplayADOErrors cnnConnection
VBError:
    DisplayVBError
    GoTo Done
End Sub
Private Sub SaveRecord()
    Dim cnnConnection As ADODB.Connection
    Dim rstCustomers As ADODB.Recordset
    Dim bRefreshNeeded As Boolean
    Dim strQry As String
    
    On Error GoTo VBError
    strQry = "select * from customers where Cust_id=" & Trim(CStr(itsCust_id))
    
    On Error GoTo ADOError
    Set cnnConnection = New Connection
    cnnConnection.ConnectionString = itsConnectionString
    cnnConnection.Open
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    'MsgBox rstCustomers.RecordCount
    If itsCust_id <> 0 Then
        If rstCustomers.EOF = True And rstCustomers.BOF = True Then
            bRefreshNeeded = True
        Else
            bRefreshNeeded = False
        End If
    Else
        rstCustomers.AddNew
        'MsgBox rstcustomers!Cust_id
        itsCust_id = rstCustomers!Cust_id
        bRefreshNeeded = True
    End If
    If Len(Trim(itsCompanyName)) > 0 Then
        rstCustomers!Company_Name = Trim(itsCompanyName)
    End If
    If Len(Trim(itsFirstName)) > 0 Then
        rstCustomers!First_Name = Trim(itsFirstName)
    End If
    If Len(Trim(itsLastName)) > 0 Then
        rstCustomers!Last_Name = Trim(itsLastName)
    End If
    If Len(Trim(itsStreetAddress)) > 0 Then
        rstCustomers!Street_Address = Trim(itsStreetAddress)
    End If
    If Len(Trim(itsCity)) > 0 Then
        rstCustomers!City = Trim(itsCity)
    End If
    If Len(Trim(itsStateProvCode)) > 0 Then
        rstCustomers!State_Prov_Code = Trim(itsStateProvCode)
    End If
    If Len(Trim(itsZipPostalCode)) > 0 Then
        rstCustomers!Zip_Postal_Code = Trim(itsZipPostalCode)
    End If
    If Len(Trim(itsPhoneNumber)) > 0 Then
        rstCustomers!Phone_Number = Trim(itsPhoneNumber)
    End If
    If Len(Trim(itsEntryDate)) > 0 Then
        rstCustomers!Entry_Date = Trim(itsEntryDate)
    End If
    If Len(Trim(itsCustTypeCode)) > 0 Then
        rstCustomers!Cust_Type_Code = Trim(itsCustTypeCode)
    End If
    If Len(Trim(itsActiveCode)) > 0 Then
        rstCustomers!Active_Flag = Trim(itsActiveCode)
    End If
    
    rstCustomers.Update
    'rstCustomers.MoveLast
    'MsgBox rstCustomers!Company_Name
    On Error GoTo VBError
    
    rstCustomers.Close
    If bRefreshNeeded Then
        GoLastRecord
    End If
Done:
    Set rstCustomers = Nothing
    Set cnnConnection = Nothing
    Exit Sub
ADOError:
    DisplayADOErrors cnnConnection
VBError:
    DisplayVBError
    GoTo Done
End Sub
Private Sub DeleteRecord()
    Dim cnnConnection As ADODB.Connection
    Dim rstCustomers As ADODB.Recordset
    Dim strQry As String
    
    On Error GoTo VBError
    strQry = "select * from Customers " & "where Cust_id=" & Trim(CStr(itsCust_id))
    
    On Error GoTo ADOError
    Set cnnConnection = New Connection
    cnnConnection.ConnectionString = itsConnectionString
    cnnConnection.Open
    
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    If itsCust_id <> 0 Then
        If rstCustomers.EOF = True And rstCustomers.BOF = True Then
        Else
            rstCustomers.Delete
            GoFirstRecord
        End If
    Else
    End If
    rstCustomers.Close
    cnnConnection.Close
Done:
    Set rstCustomers = Nothing
    Set cnnConnection = Nothing
    Exit Sub
ADOError:
    DisplayADOErrors cnnConnection
VBError:
    DisplayVBError
    GoTo Done
End Sub
Private Function RecordOK() As Boolean
    ReadRecord
    RecordOK = True
    If Trim(itsCompanyName) = "" Then
        RecordOK = False
        itsErrorMsg = "Company Name must be filled in."
        txtFields(1).SetFocus
    End If
End Function
Private Sub GoFirstRecord()
    FillListBox
    
    If itsRecCount > 0 Then
        GoRecord 0
    Else
        EmptyRecord
    End If
End Sub
Private Sub GoLastRecord()
    FillListBox

    If itsRecCount > 0 Then
        GoRecord lstCustomers.ListCount - 1
    Else
        EmptyRecord
    End If
End Sub
Private Sub GoRecord(theListIndex As Long)
    lstCustomers.Visible = True
    lstCustomers.ListIndex = theListIndex
    
    cmdDelete.Enabled = True
    cmdNew.Enabled = True
End Sub
Private Function GetRecordSet(cnnConnection As ADODB.Connection, sQry As String) As ADODB.Recordset
    Dim rstCustomers As Recordset
    Set rstCustomers = New Recordset
    '下面的记录锁类型，因为CursorLocation设为adUseClient
    '实际当打开记录集时，记录锁类型已设为adOpenStatic
    rstCustomers.CursorType = adOpenKeyset
    rstCustomers.LockType = adLockOptimistic
    rstCustomers.CursorLocation = adUseClient
    '设置记录集的数据来源为一个SQL串
    rstCustomers.Source = sQry
    '设置记录集的连接字符串
    Set rstCustomers.ActiveConnection = cnnConnection
    rstCustomers.Open
    
    Set GetRecordSet = rstCustomers
End Function
Private Sub FillListBox()
    Dim cnnConnection As ADODB.Connection
    Dim rstCustomers As ADODB.Recordset
    Dim strQry As String
    
    On Error GoTo VBError
    strQry = "select * from Customers order by Cust_id ASC"
    
    On Error GoTo ADOError
    Set cnnConnection = New Connection
    cnnConnection.ConnectionString = itsConnectionString
    cnnConnection.Open
    
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    itsRecCount = rstCustomers.RecordCount
    If itsRecCount > 0 Then
        itsProcessClickFlag = False
        lstCustomers.Clear
        'rstCustomers.MoveLast
        'MsgBox rstCustomers!Cust_id
        rstCustomers.MoveFirst
        Do Until rstCustomers.EOF
            lstCustomers.AddItem rstCustomers!Company_Name
            lstCustomers.ItemData(lstCustomers.NewIndex) = rstCustomers!Cust_id
            rstCustomers.MoveNext
        Loop
        rstCustomers.Close
        
        itsProcessClickFlag = True
    End If
    cnnConnection.Close
Done:
    Set rstCustomers = Nothing
    Set cnnConnection = Nothing
    Exit Sub
ADOError:
    DisplayADOErrors cnnConnection
VBError:
    DisplayVBError
    GoTo Done
End Sub
Private Sub EmptyRecord()
    lblRecNo.Caption = "<New Record>"
    lstCustomers.Visible = False
    
    NewRecord
    
    cmdDelete.Enabled = False
    cmdNew.Enabled = False
    
    DisplayRecord
End Sub
Private Sub ReadRecord()
    '读取文本框各记录字段的值
    itsCompanyName = Trim(txtFields(1))
    itsFirstName = Trim(txtFields(2))
    itsLastName = Trim(txtFields(3))
    itsStreetAddress = Trim(txtFields(4))
    itsCity = Trim(txtFields(5))
    itsStateProvCode = Trim(txtFields(6))
    itsZipPostalCode = Trim(txtFields(7))
    itsPhoneNumber = Trim(txtFields(8))
    itsEntryDate = Trim(txtFields(9))
    itsCustTypeCode = Trim(txtFields(10))
    itsActiveCode = CLng(Trim(txtFields(11)))
End Sub
Private Sub DisplayRecord()
    txtFields(0) = Trim(CStr(itsCust_id))
    txtFields(1) = Trim(itsCompanyName)
    txtFields(2) = Trim(itsFirstName)
    txtFields(3) = Trim(itsLastName)
    txtFields(4) = Trim(itsStreetAddress)
    txtFields(5) = Trim(itsCity)
    txtFields(6) = Trim(itsStateProvCode)
    txtFields(7) = Trim(itsZipPostalCode)
    txtFields(8) = Trim(itsPhoneNumber)
    txtFields(9) = Trim(CStr(itsEntryDate))
    txtFields(10) = Trim(itsCustTypeCode)
    txtFields(11) = Trim(CStr(itsActiveCode))
End Sub
Private Sub NewRecord()
    itsCust_id = 0
    itsCompanyName = ""
    itsFirstName = ""
    itsLastName = ""
    itsStreetAddress = ""
    itsCity = ""
    itsStateProvCode = ""
    itsZipPostalCode = ""
    itsPhoneNumber = ""
    itsEntryDate = Date
    itsCustTypeCode = "A1"
    itsActiveCode = 1
End Sub
Private Sub DisplayADOErrors(cnnConnection As ADODB.Connection)
    Dim errLoop As ADODB.Error
    Dim strHelp As String
    
    For Each errLoop In cnnConnection.Errors
        If errLoop.HelpFile = "" Then
            strHelp = "No Helpfile available"
        Else
            strHelp = "Helpfile: " & errLoop.HelpFile & "; HelpContext: " & errLoop.HelpContext
        End If
        MsgBox "ADO Error #" & errLoop.Number & vbCrLf & "Source: " & errLoop.Source & vbCrLf & "SQL State: " & errLoop.SQLState & ";Native Error: " & errLoop.NativeError & vbCrLf & vbCrLf & "Description: " & errLoop.Description & vbCrLf & vbCrLf & strHelp, vbCritical, "ADO Error"
    Next
End Sub
Private Sub DisplayVBError()
    If CBool(Err) Then
        MsgBox "VB Error #" & Err.Number & vbCrLf & "Source: " & Err.Source & vbCrLf & vbCrLf & "Description: " & Err.Description, vbCritical, "VB Runtime Error"
        Err.Clear
    End If
End Sub