frmconsignment_main.frm

英文版Access数据库编程

Private tempContract As TContract, currContract As TContract
Dim isAdding As Boolean
Private Sub getContracts()
Dim tempRS As Recordset
Dim tempSQL As String
lvContracts.ListItems.Clear
tempSQL = "SELECT Contracts.ContractNo, Customers.Name, Contracts.StartDate, Contracts.ExpireDate " & _
        "FROM Contracts INNER JOIN Customers ON Contracts.CustomerID = Customers.CustomerID;"

RSOpen tempRS, tempSQL, dbOpenSnapshot
While Not tempRS.EOF
    With lvContracts
        .ListItems.add , , tempRS("ContractNo")
        .ListItems(.ListItems.Count).SubItems(1) = tempRS("Name")
        .ListItems(.ListItems.Count).SubItems(2) = tempRS("StartDate")
        .ListItems(.ListItems.Count).SubItems(3) = tempRS("ExpireDate")
    End With
    tempRS.MoveNext
Wend
tempRS.Close
Set tempRS = Nothing
End Sub
Private Sub setListFormat()
With lvContracts
    .ColumnHeaders.Clear
    .ListItems.Clear
    .ColumnHeaders.add , , "Contract No", 1150
    .ColumnHeaders.add , , "Customer ID", 5200
    .ColumnHeaders.add , , "Start Date", 960
    .ColumnHeaders.add , , "Expiry Date", 1150
End With
End Sub

Private Sub setFormMode(ByVal strModeStatus As ModeStatus)
Select Case strModeStatus
    Case Editing
        txtContract.Enabled = True
        cmbCustomer.Enabled = True
        txtStart.Enabled = True
        txtEnd.Enabled = True
        lvContracts.Enabled = False
        cmdEdit.Visible = False
        cmdDelete.Visible = False
        cmdClose.Visible = False
        cmdNew.Visible = False
    Case Viewing
        txtContract.Enabled = False
        cmbCustomer.Enabled = False
        txtStart.Enabled = False
        txtEnd.Enabled = False
        lvContracts.Enabled = True
        cmdDelete.Visible = True
        cmdEdit.Visible = True
        cmdClose.Visible = True
        cmdNew.Visible = True
End Select
End Sub

Private Sub getContractValues()
txtContract.Text = lvContracts.SelectedItem.Text
cmbCustomer.Text = lvContracts.SelectedItem.SubItems(1)
txtStart.Text = lvContracts.SelectedItem.SubItems(2)
txtEnd.Text = lvContracts.SelectedItem.SubItems(3)
End Sub

Private Sub storeValues()
currContract.contractNo = txtContract.Text
currContract.customerID = cmbCustomer.Text
currContract.endDate = txtEnd.Text
currContract.startDate = txtStart.Text
End Sub

Private Sub restoreValues()
With currContract
    txtContract.Text = .contractNo
    If .customerID = "" Then
        cmbCustomer.ListIndex = 0
    Else
        cmbCustomer.Text = .customerID
    End If
    txtStart.Text = .startDate
    txtEnd.Text = .endDate
End With
End Sub

Private Sub showContract()
With currContract
    txtContract.Text = .contractNo
    cmbCustomer.Text = .customerID
    txtStart.Text = .startDate
    txtEnd.Text = .endDate
End With
End Sub
Private Function isSame(ByRef strTempVar As TContract) As Boolean
With strTempVar
    If (.contractNo <> tempContract.contractNo) Or (.customerID <> tempContract.customerID) Or _
    (.endDate <> tempContract.endDate) Or (.startDate <> tempContract.startDate) Then
        isSame = False
    Else
        isSame = True
    End If
End With
End Function

Private Sub cmbCustomer_Click()
If Not cmbCustomer.Text = "" Then
    Dim tempRS As Recordset
    RSOpen tempRS, "SELECT CustomerID FROM Customers WHERE Name='" & cmbCustomer.Text & "'", dbOpenSnapshot
    If Not tempRS.EOF Then
        cmbCustomer.Tag = tempRS("CustomerID")
    End If
    tempRS.Close
    Set tempRS = Nothing
End If
End Sub

Private Sub cmdCancel_Click()
restoreValues
setFormMode Viewing
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
If txtContract.Text <> "" Then
    If MsgBox("Are you sure you want to remove this contract?" & vbCrLf & "The entire inventory assigned to this consignment contract will be removed.", vbYesNoCancel + vbQuestion, "Delete contract") = vbYes Then
        Dim delSQL As String
        delSQL = "DELETE * FROM Contracts WHERE ContractNo='" & txtContract.Text & "'"
        MySynonDatabase.Execute delSQL
        insertLog "Consignment No: " & txtContract.Text & " has been deleted."
        InfoMsg "The contract has been successfully removed.", "Record deleted"
        getContracts
    End If
Else
    ValidMsg "There are no existing contracts to be deleted.", "No contract available"
End If

ErrHandler:
If Err.Number <> 0 Then
    ErrorNotifier Err.Number, Err.description
End If
End Sub

Private Sub cmdEdit_Click()
If lvContracts.ListItems.Count > 0 Then
    If lvContracts.SelectedItem.Selected = True Then
        storeValues
        setFormMode Editing
        isAdding = False
    End If
End If
End Sub

Private Sub cmdNew_Click()
setFormMode Editing
storeValues
txtContract.Enabled = False
'cmbCustomer.Text = ""
txtStart.Text = ""
txtEnd.Text = ""
isAdding = True
End Sub

Private Sub cmdSave_Click()
If cmbCustomer.Text = "" Then
    Err.Clear
    ValidMsg "Please select a customer.", "Missing selection"
    cmbCustomer.SetFocus
ElseIf txtStart.Text = "" Then
    Err.Clear
    ValidMsg "Please enter a beginning date.", "Missing value"
    txtStart.SetFocus
Else
    Dim conRS As Recordset, tmpRS As Recordset
    Dim newID As Long
    BeginTrans
    Set tmpRS = MySynonDatabase.OpenRecordset("SELECT DataValue FROM Misc WHERE DataType='CONSIGN'", dbOpenDynaset, dbDenyRead + dbDenyWrite)
    newID = tmpRS("DataValue")
    If isAdding = True Then
        Set conRS = MySynonDatabase.OpenRecordset("SELECT * FROM Contracts", dbOpenDynaset, dbDenyWrite)
        conRS.AddNew
        conRS("ContractNo") = newID
    Else
        Set conRS = MySynonDatabase.OpenRecordset("SELECT * FROM Contracts WHERE ContractNo='" & lblHidden.Caption & "';", dbOpenDynaset, dbDenyWrite)
        conRS.Edit
        conRS("ContractNo") = txtContract.Text
    End If
    conRS("CustomerID") = cmbCustomer.Tag
    conRS("StartDate") = txtStart.Text
    conRS("ExpireDate") = txtEnd.Text
    conRS.Update
    'Update new key
    tmpRS.Edit
    tmpRS("DataValue") = newID + 1
    tmpRS.Update
    
    'Insert into systems log
    insertLog "Consignment contract no: " & newID & IIf((isAdding = True), " created.", " updated.")
    'Close recordsets and free memory
    tmpRS.Close
    conRS.Close
    CommitTrans
    Set tmpRS = Nothing
    Set conRS = Nothing
    If isAdding = True Then
        InfoMsg "Contract No: " & newID & vbCrLf & "The new contract has been successfully created.", "Record saved"
    Else
        InfoMsg "The contract has been successfully updated.", "Record saved"
    End If
    setFormMode Viewing
    getContracts
End If

ErrHandler:
If Err.Number <> 0 Then
    Rollback
    ErrorNotifier Err.Number, "An error has occurred while saving the data. Record has not been added into the database. Please try again." & _
    "The error might have occurred because another person has just updated the same record or table."
End If
End Sub

Private Sub Form_Load()
setFormMode Viewing
cmbCustomer.addItem ""
FillCombo cmbCustomer, "SELECT Name FROM Customers", "Name"
setListFormat
getContracts
lblNotes.Caption = "It is strongly advised that these settings are left as default. Only administrators are aware of the changes made here."
End Sub

Private Sub lvContracts_ItemClick(ByVal Item As MSComctlLib.ListItem)
If Item.Selected Then
    getContractValues
    lblHidden.Caption = Item.Text
Else
    lblHidden.Caption = ""
End If
End Sub

Private Sub txtContract_GotFocus()
SelText txtContract
End Sub
Private Sub cmbCustomer_GotFocus()
SelText cmbCustomer
End Sub

Private Sub txtContract_KeyPress(KeyAscii As Integer)
OnlyAlpha KeyAscii
End Sub

Private Sub txtEnd_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc("/") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtStart_GotFocus()
SelText txtStart
End Sub
Private Sub txtEnd_GotFocus()
SelText txtEnd
End Sub

Private Sub txtStart_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc("/") Then
    OnlyNum KeyAscii
End If
End Sub