frmstockreceiveae.frm

来自「Inventory control system」· FRM 代码 · 共 1,424 行 · 第 1/4 页

Dim cIRowCount              As Integer

Dim HaveAction              As Boolean 'Variable used to detect if the user perform some action
Dim rs                      As New Recordset 'Main recordset for Invoice

Private Sub btnAdd_Click()
    If nsdStock.Text = "" Then nsdStock.SetFocus: Exit Sub

    If toNumber(txtSP.Text) <= 0 Then
        MsgBox "Please enter a valid sales price.", vbExclamation
        txtSP.SetFocus
        Exit Sub
    End If

    Dim CurrRow As Integer

    CurrRow = getFlexPos(Grid, 11, nsdStock.BoundText)

    'Add to grid
    With Grid
        If CurrRow < 0 Then
            'Perform if the record is not exist
            If .Rows = 2 And .TextMatrix(1, 11) = "" Then
                .TextMatrix(1, 1) = nsdStock.getSelValueAt(1)
                .TextMatrix(1, 2) = nsdStock.Text
                .TextMatrix(1, 3) = nsdStock.getSelValueAt(5)
                .TextMatrix(1, 4) = txtQty.Text
                .TextMatrix(1, 5) = dcUnit.Text
                .TextMatrix(1, 6) = txtSP.Text
                .TextMatrix(1, 7) = toMoney(txtGross(1).Text)
                .TextMatrix(1, 8) = toNumber(cbDisc.Text)
                .TextMatrix(1, 9) = toMoney(toNumber(txtNetAmount.Text))
                .TextMatrix(1, 10) = toMoney(toNumber(txtNetPrice.Text))
                .TextMatrix(1, 11) = nsdStock.BoundText
                .TextMatrix(1, 12) = toMoney(toNumber(cbDisc.Text) / 100) * toNumber(toNumber(txtQty.Text) * toNumber(txtSP.Text))
            Else
ADD_NEW_HERE:
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 1) = nsdStock.getSelValueAt(1)
                .TextMatrix(.Rows - 1, 2) = nsdStock.Text
                .TextMatrix(.Rows - 1, 3) = nsdStock.getSelValueAt(5)
                .TextMatrix(.Rows - 1, 4) = txtQty.Text
                .TextMatrix(.Rows - 1, 5) = dcUnit.Text
                .TextMatrix(.Rows - 1, 6) = txtSP.Text
                .TextMatrix(.Rows - 1, 7) = toMoney(txtGross(1).Text)
                .TextMatrix(.Rows - 1, 8) = toNumber(cbDisc.Text)
                .TextMatrix(.Rows - 1, 9) = toMoney(toNumber(txtNetAmount.Text))
                .TextMatrix(.Rows - 1, 10) = toMoney(toNumber(txtNetPrice.Text))
                .TextMatrix(.Rows - 1, 11) = nsdStock.BoundText
                .TextMatrix(.Rows - 1, 12) = toMoney(toNumber(cbDisc.Text) / 100) * toNumber(toNumber(txtQty.Text) * toNumber(txtSP.Text))
                
                .Row = .Rows - 1
            End If
            'Increase the record count
            cIRowCount = cIRowCount + 1
        Else
            'If free option is not equal or discount is not equal or sales price is not equal then add new sold item
            'If .TextMatrix(CurrRow, 10) <> changeYNValue(ckFree.Value) Or toNumber(.TextMatrix(CurrRow, 8)) <> toNumber(cbDisc.Text) Or toNumber(.TextMatrix(CurrRow, 3)) <> toNumber(txtSP.Text) Then
            '    GoTo ADD_NEW_HERE
            'End If
            
            If MsgBox("Invoice payment already exist.Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
                .Row = CurrRow
                
                'Restore back the invoice amount and discount
                cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 7))
                txtGross(2).Text = Format$(cIGross, "#,##0.00")
                cIAmount = cIAmount - toNumber(Grid.TextMatrix(.RowSel, 9))
                txtNet.Text = Format$(cIAmount, "#,##0.00")
                cDAmount = cDAmount - toNumber(Grid.TextMatrix(.RowSel, 12))
                txtDesc.Text = Format$(cDAmount, "#,##0.00")
                
                .TextMatrix(CurrRow, 1) = nsdStock.getSelValueAt(1)
                .TextMatrix(CurrRow, 2) = nsdStock.Text
                .TextMatrix(CurrRow, 3) = nsdStock.getSelValueAt(5)
                .TextMatrix(CurrRow, 4) = txtQty.Text
                .TextMatrix(CurrRow, 5) = dcUnit.Text
                .TextMatrix(CurrRow, 6) = txtSP.Text
                .TextMatrix(CurrRow, 7) = toMoney(txtGross(1).Text)
                .TextMatrix(CurrRow, 8) = toNumber(cbDisc.Text)
                .TextMatrix(CurrRow, 9) = toMoney(toNumber(txtNetAmount.Text))
                .TextMatrix(CurrRow, 10) = toMoney(toNumber(txtNetPrice.Text))
                .TextMatrix(CurrRow, 11) = nsdStock.BoundText
                .TextMatrix(CurrRow, 12) = toMoney(toNumber(cbDisc.Text) / 100) * toNumber(toNumber(txtQty.Text) * toNumber(txtSP.Text))

            Else
                Exit Sub
            End If
        End If
        'Add the amount to current load amount
        cIGross = cIGross + toNumber(txtGross(1).Text)
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        cIAmount = cIAmount + toNumber(txtNetAmount.Text)
        cDAmount = cDAmount + toNumber(toNumber(cbDisc.Text) / 100) * (toNumber(toNumber(txtQty.Text) * toNumber(txtSP.Text)))
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        'Highlight the current row's column
        .ColSel = 11
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnRemove_Click()
    'Remove selected load product
    With Grid
        'Update grooss to current purchase amount
        cIGross = cIGross - toNumber(Grid.TextMatrix(.RowSel, 7))
        txtGross(2).Text = Format$(cIGross, "#,##0.00")
        'Update amount to current invoice amount
        cIAmount = cIAmount - toNumber(Grid.TextMatrix(.RowSel, 9))
        txtNet.Text = Format$(cIAmount, "#,##0.00")
        'Update discount to current invoice disc
        cDAmount = cDAmount - toNumber(Grid.TextMatrix(.RowSel, 12))
        txtDesc.Text = Format$(cDAmount, "#,##0.00")
        'Update the record count
        cIRowCount = cIRowCount - 1
        
        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
    
End Sub

Private Sub cbDisc_Change()
    txtQty_Change
End Sub

Private Sub cbDisc_Click()
    txtQty_Change
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cbDisc_Validate(Cancel As Boolean)
    cbDisc.Text = toNumber(cbDisc.Text)
End Sub

Private Sub cmdPH_Click()
    'frmInvoiceViewerPH.INV_PK = PK
    'frmInvoiceViewerPH.Caption = "Payment History Viewer"
    'frmInvoiceViewerPH.lblTitle.Caption = "Payment History Viewer"
    'frmInvoiceViewerPH.show vbModal
End Sub

Private Sub cmdSave_Click()
    'Verify the entries
    If nsdVendor.BoundText = "" Then
        MsgBox "Please select a vendor.", vbExclamation
        nsdVendor.SetFocus
        Exit Sub
    End If
   
    If cIRowCount < 1 Then
        MsgBox "Please enter item to purchase before saving this record.", vbExclamation
        nsdStock.SetFocus
        Exit Sub
    End If
       
    If MsgBox("This save the record. Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM purchase_order_detail WHERE purchase_order_id=" & PK, CN, adOpenStatic, adLockOptimistic

    Screen.MousePointer = vbHourglass

    Dim c As Integer

    On Error GoTo err

    CN.BeginTrans

    'Save the record
    With rs
        If State = adStateAddMode Or State = adStatePopupMode Then
            .AddNew
            ![purchase_order_id] = PK
            ![DateAdded] = Now
            ![AddedByFK] = CurrUser.USER_PK
        Else
            ![DateModified] = Now
            ![LastUserFK] = CurrUser.USER_PK
        End If
        ![vendor_id] = nsdVendor.BoundText
        ![po_no] = txtPONo.Text
        ![Date] = dtpDate.Value
        ![salesman] = txtSalesman.Text
        ![shipping_instructions] = txtShipping_Instructions.Text
        ![additional_instructions] = txtAdditional_Instructions.Text
        ![declared_as] = txtDeclared_as.Text
        ![declared_value] = txtDeclared_Value.Text
        ![Gross] = toNumber(txtGross(2).Text)
        ![Discount] = txtDesc.Text
        ![amount_net] = toNumber(txtNet.Text)
        ![Remarks] = txtEntry(8).Text
        
        .Update
        
    End With
  
    With Grid
        'Save the details of the records
        For c = 1 To cIRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
            
                RSDetails.AddNew

                'RSDetails![PK] = getIndex("tbl_AR_InvoiceDetails")

                RSDetails![purchase_order_id] = PK
                RSDetails![stock_id] = toNumber(.TextMatrix(c, 11))
                RSDetails![Qty] = toNumber(.TextMatrix(c, 4))
                RSDetails![Unit] = toNumber(.TextMatrix(c, 5))
                RSDetails![Price] = toNumber(.TextMatrix(c, 6))
                RSDetails![amount_gross] = toNumber(.TextMatrix(c, 7))
                RSDetails![discount_percent] = toNumber(.TextMatrix(c, 8))
                RSDetails![discount_amount] = toNumber(.TextMatrix(c, 12))
                RSDetails![amount_net] = toNumber(.TextMatrix(c, 9))
                RSDetails![net_price] = toNumber(.TextMatrix(c, 10))
                RSDetails![Date] = dtpDate.Value

                RSDetails.Update

            End If

        Next c
    End With

    'Clear variables
    c = 0
    Set RSDetails = Nothing

    CN.CommitTrans

    HaveAction = True
    Screen.MousePointer = vbDefault

    If State = adStateAddMode Then
        MsgBox "New record has been successfully saved.", vbInformation
        If MsgBox("Do you want to add another new record?", vbQuestion + vbYesNo) = vbYes Then
            ResetFields
            GeneratePK
         Else
            Unload Me
        End If
    Else
        MsgBox "Changes in  record has been successfully saved.", vbInformation
        Unload Me
    End If

    Exit Sub
err:
    CN.RollbackTrans
    prompt_err err, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tUser1 As String
    
    tDate1 = Format$(rs.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("AddedByFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: n/a" & vbCrLf & _
           "Modified By: n/a", vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tUser1 = vbNullString
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    If CloseMe = True Then
        Unload Me
    Else
        txtEntry(0).SetFocus
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys ("{tab}")
End Sub

Private Sub Form_Load()
    InitGrid
    
    bind_dc "SELECT * FROM Unit", "Unit", dcUnit, "unit_id", True
    
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        InitNSD
        
        'Set the recordset
         rs.Open "SELECT * FROM purchase_order WHERE purchase_order_id=" & PK, CN, adOpenStatic, adLockOptimistic
         dtpDate.Value = Date
         Caption = "Create New Entry"
         cmdUsrHistory.Enabled = False
         GeneratePK
         txtPONo.Text = Format(PK, "0000000000")
    Else
        Screen.MousePointer = vbHourglass
        'Set the recordset
        rs.Open "SELECT * FROM qry_PurchaseOrder WHERE purchase_order_id=" & PK, CN, adOpenStatic, adLockOptimistic
        
        cmdCancel.Caption = "Close"
        cmdUsrHistory.Enabled = True
               
        DisplayForViewing
        
        If ForCusAcc = True Then
            Me.Icon = frmCashPurchase.Icon
        Else
            
            MsgBox "This is use for viewing the record only." & vbCrLf & _
               "You cannot perform any changes in this form." & vbCrLf & vbCrLf & _
               "Note:If you have mistake in adding this record then " & vbCrLf & _
               "void this record and re-enter.", vbExclamation
        End If

        Screen.MousePointer = vbDefault
    End If
    
    'Initialize Graphics
    'With MAIN
        'cmdGenerate.Picture = .i16x16.ListImages(14).Picture
        'cmdNew.Picture = .i16x16.ListImages(10).Picture
        'cmdReset.Picture = .i16x16.ListImages(15).Picture
    'End With
 
    'Fill the discount combo
    cbDisc.AddItem "0.01"
    cbDisc.AddItem "0.02"
    cbDisc.AddItem "0.03"
    cbDisc.AddItem "0.04"
    cbDisc.AddItem "0.05"
    cbDisc.AddItem "0.06"
    cbDisc.AddItem "0.07"
    cbDisc.AddItem "0.08"
    cbDisc.AddItem "0.09"
    cbDisc.AddItem "0.1"