frmdelivery_main.frm

英文版Access数据库编程

customer.Text = lblcust.Caption
txtPO.Text = txtPO.Tag
txtAttn.Text = txtAttn.Tag
txtREM.Text = txtREM.Tag
setFormMode Viewing
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
If lvDO.ListItems.Count < 1 Then
    InfoMsg "There are no deliveries to be deleted.", "No delivery available"
Else
    If doNum.Text <> "" Then
        If MsgBox("Are you sure you want to delete the selected delivery order?", vbYesNoCancel + vbQuestion, "Delete delivery order") = vbYes Then
            MySynonDatabase.Execute "DELETE * FROM Delivery WHERE DONumber='" & lvDO.SelectedItem.Text & "';"
            'Insert into systems log
            insertLog "DO number: " & lvDO.SelectedItem.Text & " has been deleted."
            InfoMsg "The delivery order has been successfully deleted.", "Record deleted"
            Call cmdFilter_Click
            doNum.Text = ""
            notes.Text = ""
            charges.Text = ""
            Dim k As Byte
            For k = 0 To 2
                cmbDate(k).ListIndex = -1
                cmbDelDate(k).ListIndex = -1
                If k < 2 Then
                    cmbDelTime(k).ListIndex = -1
                    employee(k).ListIndex = -1
                End If
            Next k
            customer.ListIndex = -1
            lblDel.Caption = ""
            lblEnd.Caption = ""
            lblcust.Caption = ""
            txtPO.Text = ""
            txtAttn.Text = ""
            txtREM.Text = ""
            frmMain.loadRecDeliveries
        End If
    Else
        InfoMsg "Please select a delivery order to be deleted.", "Missing selection"
    End If
End If
End Sub

Private Sub cmdEdit_Click()
If lvDO.ListItems.Count > 0 Then
    If doNum.Text <> "" Then
        Dim k As Integer
        doNum.Tag = doNum.Text
        notes.Tag = notes.Text
        charges.Tag = charges.Text
        For k = 0 To 2
            cmbDate(k).Tag = cmbDate(k).Text
            cmbDelDate(k).Tag = cmbDelDate(k).Text
            If k < 2 Then
                cmbDelTime(k).Tag = cmbDelTime(k).Text
            End If
        Next k
        
        lblDel.Caption = employee(1).Text
        lblEnd.Caption = employee(0).Text
        lblcust.Caption = customer.Text
        txtPO.Tag = txtPO.Text
        txtAttn.Tag = txtAttn.Text
        txtREM.Tag = txtREM.Text
        setFormMode Editing
    Else
        InfoMsg "Please select a deliver order first.", "No delivery order selected"
    End If
Else
    InfoMsg "There are no delivery orders available.", "No delivery order"
End If
End Sub

Private Sub cmdFilter_Click()
If (filter(0).Text <> "") And (filter(1).Text <> "") And (filter(2).Text <> "") Then
    If isDateValid(CByte(filter(0).Text), CByte(filter(1).Text), CInt(filter(2).Text)) = True Then
        getDeliveries "SELECT Delivery.DOnumber, Customers.Name, Delivery.PONumber, Delivery.DelDate, Delivery.DelTime, Delivery.Status FROM Customers INNER JOIN Delivery ON Customers.CustomerID = Delivery.CustomerID WHERE (((Delivery.Date)='" & filter(0).Text & "/" & filter(1).Text & "/" & filter(2).Text & "') AND ((Delivery.Status) <> 'INVOICED'));"
    Else
        ValidMsg "The selected date is invalid. Please try again.", "Invalid date"
    End If
End If
End Sub

Private Sub cmdNew_Click()
Dim d As frmDelivery
Set d = New frmDelivery
Load d
d.Show , frmMain

End Sub

Private Sub cmdSave_Click()
If doNum.Text = "" Then
    ValidMsg "Please enter a delivery order number.", "Missing DO Number"
    doNum.SetFocus
ElseIf isDateValid(CByte(cmbDate(0).Text), CByte(cmbDate(1).Text), CInt(cmbDate(2).Text)) = False Then
    ValidMsg "Please select a valid date for the delivery order.", "Invalid date"
    cmbDate(0).SetFocus
ElseIf isDateValid(CByte(cmbDelDate(0).Text), CByte(cmbDelDate(1).Text), CInt(cmbDelDate(2).Text)) = False Then
    ValidMsg "Please select a valid delivery date for the delivery order.", "Invalid delivery date"
    cmbDelDate(0).SetFocus
ElseIf ((notes.Text = "") And (Val(charges.Text) > 0)) Then
    ValidMsg "Please provide a description for the charges.", "Missing description"
    notes.SetFocus
Else
    Dim dRS As Recordset
    RSOpen dRS, "SELECT * FROM Delivery WHERE DOnumber='" & doNum.Tag & "';", dbOpenDynaset
    If Not dRS.EOF Then
        dRS.Edit
        dRS("DOnumber") = doNum.Text
        dRS("Date") = cmbDate(0) & "/" & cmbDate(1).Text & "/" & cmbDate(2).Text
        dRS("CustomerID") = customer.Tag
        dRS("EmployeeID") = employee(0).Tag
        dRS("IssuedBy") = employee(1).Tag
        dRS("PONumber") = txtPO.Text
        dRS("Attn") = txtAttn.Text
        dRS("Remark") = txtREM.Text
        dRS("DelDate") = cmbDelDate(0).Text & "/" & cmbDelDate(1).Text & "/" & cmbDelDate(2).Text
        dRS("DelTime") = cmbDelTime(0).Text & ":" & cmbDelTime(1).Text
        dRS("Charges") = charges.Text
        dRS("Description") = notes.Text
        dRS.Update
        
        dRS.Close
        Set dRS = Nothing
        InfoMsg "The Delivery Order has been successfully updated.", "Record saved"
        setFormMode Viewing
        Call cmdFilter_Click
    End If
End If
End Sub


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

Private Sub doNum_GotFocus()
SelText doNum
End Sub

Private Sub doNum_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub employee_Click(Index As Integer)
If Not employee(Index).Text = "" Then
    Dim tempRS As Recordset
    RSOpen tempRS, "SELECT EmployeeID FROM Employees WHERE Name='" & employee(Index).Text & "'", dbOpenSnapshot
    If Not tempRS.EOF Then
        employee(Index).Tag = tempRS("EmployeeID")
    End If
    tempRS.Close
    Set tempRS = Nothing
End If
End Sub

Private Sub Form_Load()
DisableClose frmDelivery_Main, True
lblNotes.Caption = "Welcome to the delivery order management console. Please be careful in changing the details of these orders. " & vbCrLf & _
"Changes upon these documents may not reflect the truth in reality thus may cause undesirable outcomes and fatal errors. Ensure that you are " & _
"fully aware of what you are doing."
Dim i As Integer
'Add years
For i = 0 To 10
    cmbDate(2).addItem CStr(Year(Now()) - 5 + i)
    cmbDelDate(2).addItem CStr(Year(Now()) - 5 + i)
    filter(2).addItem CStr(Year(Now()) - 5 + i)
Next i
For i = 0 To 59
    cmbDelTime(1).addItem Format$(i, "00")
Next i

'Populate combo boxes
FillCombo customer, "SELECT Name FROM Customers", "Name"
FillCombo employee(0), "SELECT Name FROM Employees ORDER BY Name ASC", "Name"
FillCombo employee(1), "SELECT Name FROM Employees ORDER BY Name ASC", "Name"

filter(0).Text = Format$(Day(Now()), "00")
filter(1).Text = Format$(Month(Now()), "00")
filter(2).Text = Format$(Year(Now()), "0000")

'Format the list view properties
With lvDO.ColumnHeaders
    lvDO.View = lvwReport
    .Clear
    .add , , "DO No.", 800
    .add , , "Customer", 5000
    .add , , "PO Number"
    .add , , "Delivery Date"
    .add , , "Delivery Time"
    .add , , "Status"
End With
Call cmdFilter_Click
setFormMode Viewing
'Me.WindowState = vbMaximized

End Sub

Private Sub Form_Resize()
On Error Resume Next
Shape1.width = Me.width
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set frmDelivery_Main = Nothing
End Sub

Private Sub lvDO_DblClick()
With lvDO.SelectedItem
    If lvDO.ListItems.Count > 0 Then
        If .Selected Then
            Load frmDelivery_Details
            frmDelivery_Details.getDetails .Text
            frmDelivery_Details.Show vbModal
            frmDelivery_Details.Left = Me.Left + Me.width
        End If
    End If
End With
End Sub

Private Sub lvDO_ItemClick(ByVal Item As MSComctlLib.ListItem)
With Item 'If a delivery order is selected, get its details from the DB and display
    If .Selected Then
        Dim lRS As Recordset, eRS As Recordset
        'On Error GoTo ErrHandler
        RSOpen lRS, "SELECT Delivery.DOnumber, Delivery.Date, Delivery.EmployeeID, Delivery.IssuedBy, Delivery.PONumber, Customers.Name, Delivery.Remark, Delivery.Attn, Delivery.DelDate, Delivery.DelTime, Delivery.Status, Delivery.Charges, Delivery.Description " & _
                    "FROM Customers INNER JOIN Delivery ON Customers.CustomerID = Delivery.CustomerID WHERE Delivery.DOnumber='" & .Text & "';", dbOpenSnapshot
        
        If Not lRS.EOF Then
            doNum.Text = lRS("DOnumber")
            customer.Text = lRS("Name")
            RSOpen eRS, "SELECT Name FROM Employees WHERE EmployeeID='" & lRS("EmployeeID") & "';", dbOpenSnapshot
            employee(0).Text = eRS("Name")
            RSOpen eRS, "SELECT Name FROM Employees WHERE EmployeeID='" & lRS("IssuedBy") & "';", dbOpenSnapshot
            employee(1).Text = eRS("Name")
            cmbDate(0).Text = Left$(lRS("Date"), 2)
            cmbDate(1).Text = Right$(Left$(lRS("Date"), 5), 2)
            cmbDate(2).Text = Right$(lRS("Date"), 4)
            cmbDelDate(0).Text = Left$(lRS("DelDate"), 2)
            cmbDelDate(1).Text = Right$(Left$(lRS("DelDate"), 5), 2)
            cmbDelDate(2).Text = Right$(lRS("DelDate"), 4)
            cmbDelTime(0).Text = Left$(lRS("DelTime"), 2)
            cmbDelTime(1).Text = Right$(lRS("DelTime"), 2)
            txtAttn.Text = IIf(IsNull(lRS("Attn")), "", lRS("Attn"))
            txtPO.Text = IIf(IsNull(lRS("PONumber")), "", lRS("PONumber"))
            txtREM.Text = IIf(IsNull(lRS("Remark")), "", lRS("Remark"))
        End If
        eRS.Close
        lRS.Close
        Set eRS = Nothing
        Set lRS = Nothing
    End If
End With
ErrHandler:
If Err.Number <> 0 Then
    CriticalMsg "Unable to load the delivery orders. Please close this window and try again." & vbCrLf & _
    "If you see this message again, please contact your system administrator.", "Error found"
    Exit Sub
End If
End Sub

Private Sub lvDO_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    If lvDO.ListItems.Count > 0 Then
        If doNum.Text <> "" Then
            PopupMenu mnu_Options, vbPopupMenuLeftAlign
        End If
    End If
End If
End Sub

Private Sub mnu_Print_Blank_Click()
If ((lvDO.SelectedItem.Selected = True) And (doNum.Text <> "")) Then
    If MsgBox("Are you sure you want to print the following Delivery Order?" & vbCrLf & "DO Number: " & doNum.Text, vbQuestion + vbYesNoCancel, "Print DO") = vbYes Then
        printDO lvDO.SelectedItem.Text
    End If
End If

End Sub

Private Sub mnu_Print_pre_Click()
If ((lvDO.SelectedItem.Selected = True) And (doNum.Text <> "")) Then
    If MsgBox("Are you sure you want to print the following Delivery Order?" & vbCrLf & "DO Number: " & doNum.Text, vbQuestion + vbYesNoCancel, "Print DO") = vbYes Then
        prePrintDO lvDO.SelectedItem.Text
    End If
End If
End Sub

Private Sub txtAttn_GotFocus()
SelText txtAttn
End Sub

Private Sub txtPO_GotFocus()
SelText txtPO
End Sub

Private Sub txtREM_GotFocus()
SelText txtREM
End Sub