⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmproductsae.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    End If
    
    'check for blank category
    If Trim(dcCategory.Text) = "" Then
        MsgBox "Category should not be empty.", vbExclamation
        Exit Sub
    End If
    
    'check for blank unit measures
    If cIRowCount < 1 Then
        MsgBox "Please provide at least one product measure.", vbExclamation
        Exit Sub
    End If
    
    CN.BeginTrans
      
    If State = adStateAddMode Or State = adStatePopupMode Then
        RS.AddNew
        RS.Fields("StockId") = PK
        RS.Fields("addedbyfk") = CurrUser.USER_PK
    Else
        RS.Fields("datemodified") = Now
        RS.Fields("lastuserfk") = CurrUser.USER_PK
    End If
    
    With RS
        .Fields("Barcode") = txtEntry(1).Text
        .Fields("Stock") = txtEntry(2).Text
        .Fields("Short") = txtEntry(3).Text
        .Fields("ICode") = txtEntry(4).Text
        .Fields("ReorderPoint") = toNumber(txtEntry(5).Text)
        .Fields("ExtPrice") = toMoney(txtEntry(6).Text)
        .Fields("UnitID") = dcReoderUnit.BoundText
        .Fields("Status") = cboStatus.Text
        .Fields("CategoryID") = dcCategory.BoundText
        
        .Update
    End With
  
    Dim RSStockUnit As New Recordset

    RSStockUnit.CursorLocation = adUseClient
    RSStockUnit.Open "SELECT * FROM Stock_Unit WHERE StockID=" & PK, CN, adOpenStatic, adLockOptimistic
    
    DeleteItems
    
    Dim c As Integer
    
    With Grid
        'Save the details of the records
        For c = 1 To cIRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
                'Add qty received in Local Purchase Details
                RSStockUnit.AddNew

                RSStockUnit![StockID] = PK
                RSStockUnit![Order] = toNumber(.TextMatrix(c, 1))
                RSStockUnit![UnitID] = toNumber(.TextMatrix(c, 9))
                RSStockUnit![Qty] = toNumber(.TextMatrix(c, 2))
                RSStockUnit![SalesPrice] = toNumber(.TextMatrix(c, 4))
                RSStockUnit![SupplierPrice] = toNumber(.TextMatrix(c, 5))
                RSStockUnit![Pending] = toNumber(.TextMatrix(c, 6))
                RSStockUnit![Incoming] = toNumber(.TextMatrix(c, 7))
                RSStockUnit![Onhand] = toNumber(.TextMatrix(c, 8))

                RSStockUnit.Update
            ElseIf State = adStateEditMode Then
                RSStockUnit.Filter = "UnitID = " & toNumber(.TextMatrix(c, 9))
            
                If RSStockUnit.RecordCount = 0 Then GoTo AddNew

                RSStockUnit![Order] = toNumber(.TextMatrix(c, 1))
                RSStockUnit![UnitID] = toNumber(.TextMatrix(c, 9))
                RSStockUnit![Qty] = toNumber(.TextMatrix(c, 2))
                RSStockUnit![SalesPrice] = toNumber(.TextMatrix(c, 4))
                RSStockUnit![SupplierPrice] = toNumber(.TextMatrix(c, 5))
                RSStockUnit![Pending] = toNumber(.TextMatrix(c, 6))
                RSStockUnit![Incoming] = toNumber(.TextMatrix(c, 7))
                RSStockUnit![Onhand] = toNumber(.TextMatrix(c, 8))

                RSStockUnit.Update
            End If

        Next c
    End With

    'Clear variables
    c = 0
    Set RSStockUnit = Nothing
    
    CN.CommitTrans
  
    HaveAction = True
    
    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
        Else
            Unload Me
        End If
    ElseIf State = adStatePopupMode Then
        MsgBox "New record has been successfully saved.", vbInformation
        Unload Me
    Else
        MsgBox "Changes in  record has been successfully saved.", vbInformation
        Unload Me
    End If
    
    Exit Sub
err:
    If err.Number = -2147217887 Then
        Resume Next
    Else
        CN.RollbackTrans
        prompt_err err, Name, "cmdSave_Click"
        Screen.MousePointer = vbDefault
    End If
End Sub

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

'Procedure used to generate PK
Private Sub GeneratePK()
  PK = getIndex("Stock")
End Sub

Private Sub Form_Load()
    InitGrid
    InitNSD
    
    RS.CursorLocation = adUseClient
    RS.Open "SELECT * FROM Stocks WHERE StockID = " & PK, CN, adOpenStatic, adLockOptimistic
    
    rs1.CursorLocation = adUseClient
    rs1.Open "SELECT * FROM qry_Stock_Unit WHERE StockID = " & PK, CN, adOpenStatic, adLockOptimistic
    
    bind_dc "SELECT * FROM Stocks_Category order by category asc", "Category", dcCategory, "CategoryID", True
    bind_dc "SELECT * FROM Unit order by unit asc", "Unit", dcReoderUnit, "UnitID", True
        
    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        Caption = "Create New Entry"
        cmdUsrHistory.Enabled = False
        dcCategory.Text = ""
        GeneratePK
    Else
        Caption = "Edit Entry"
        DisplayForEditing
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If HaveAction = True Then
        If State = adStateAddMode Or State = adStateEditMode Then
            frmProducts.RefreshRecords
        ElseIf State = adStatePopupMode Then
            srcText.Text = txtEntry(1).Text
            srcText.Tag = PK
            On Error Resume Next
            srcTextAdd.Text = RS![DisplayAddr]
            srcTextCP.Text = txtEntry(6).Text
            'srcTextDisc.Text = toNumber(cmdDisc.Text)
        End If
    End If
    
    Set frmProductsAE = Nothing
End Sub

Private Sub Grid_Click()
    With Grid
        txtOrder.Text = .TextMatrix(.RowSel, 1)
        txtQty.Text = .TextMatrix(.RowSel, 2)
        nsdUnit.Text = .TextMatrix(.RowSel, 3)
        nsdUnit.Tag = .TextMatrix(.RowSel, 9) 'Add tag coz boundtext is empty
        txtSalesPrice.Text = .TextMatrix(.RowSel, 4)
        txtSupplierPrice.Text = .TextMatrix(.RowSel, 5)
        txtPending.Text = .TextMatrix(.RowSel, 6)
        txtIncoming.Text = .TextMatrix(.RowSel, 7)
        txtOnHand.Text = .TextMatrix(.RowSel, 8)
    
        If Grid.Rows = 2 And Grid.TextMatrix(1, 9) = "" Then '10 = StockID
            btnRemove.Visible = False
        Else
            btnRemove.Visible = True
            btnRemove.Top = (Grid.CellTop + Grid.Top) - 20
            btnRemove.Left = Grid.Left + 50
        End If
    End With
End Sub

Private Sub lvPriceHistory_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  With lvPriceHistory
    'MsgBox .ColumnHeaders(2).Width & vbCr _
    & .ColumnHeaders(3).Width & vbCr _
    & .ColumnHeaders(4).Width
  
  End With
End Sub

Private Sub nsdUnit_Change()
    nsdUnit.Tag = nsdUnit.BoundText
End Sub

Private Sub txtEntry_GotFocus(Index As Integer)
    If Index = 8 Then cmdSave.Default = False
    HLText txtEntry(Index)
End Sub

Private Sub txtEntry_KeyPress(Index As Integer, KeyAscii As Integer)
  If Index = 9 Or Index = 10 Then KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtEntry_LostFocus(Index As Integer)
    If Index = 8 Then cmdSave.Default = True
End Sub

'Procedure used to initialize the grid
Private Sub InitGrid()
    cIRowCount = 0
    With Grid
        .Clear
        .ClearStructure
        .Rows = 2
        .FixedRows = 1
        .FixedCols = 1
        .Cols = 10
        .ColSel = 9
        'Initialize the column size
        .ColWidth(0) = 315
        .ColWidth(1) = 800
        .ColWidth(2) = 800
        .ColWidth(3) = 800
        .ColWidth(4) = 900
        .ColWidth(5) = 1200
        .ColWidth(6) = 1200
        .ColWidth(7) = 1200
        .ColWidth(8) = 900
        .ColWidth(9) = 0
        'Initialize the column name
        .TextMatrix(0, 0) = ""
        .TextMatrix(0, 1) = "Order"
        .TextMatrix(0, 2) = "Qty"
        .TextMatrix(0, 3) = "Unit"
        .TextMatrix(0, 4) = "Sales Price"
        .TextMatrix(0, 5) = "Supplier Price"
        .TextMatrix(0, 6) = "Pending"
        .TextMatrix(0, 7) = "Incoming"
        .TextMatrix(0, 8) = "On Hand"
        .TextMatrix(0, 9) = "Unit ID"
        
        'Set the column alignment
'        .ColAlignment(0) = vbLeftJustify
'        .ColAlignment(1) = vbLeftJustify
'        .ColAlignment(2) = vbLeftJustify
'        .ColAlignment(3) = flexAlignGeneral
'        .ColAlignment(4) = flexAlignGeneral
'        .ColAlignment(5) = vbRightJustify
'        .ColAlignment(6) = vbRightJustify
'        .ColAlignment(7) = vbRightJustify
'        .ColAlignment(8) = vbRightJustify
    End With
End Sub

Private Sub InitNSD()
    'For Vendor
    With nsdUnit
        .ClearColumn
        .AddColumn "Unit ID", 1794.89
        .AddColumn "Unit", 2264.88
        .Connection = CN.ConnectionString
        
        '.sqlFields = "VendorID, Company, Location"
        .sqlFields = "UnitID, Unit"
        .sqlTables = "Unit"
        .sqlSortOrder = "Unit ASC"
        
        .BoundField = "UnitID"
        .PageBy = 25
        .DisplayCol = 2
        
        .setDropWindowSize 7000, 4000
        .TextReadOnly = True
        .SetDropDownTitle = "Units Record"
    End With
    
End Sub

Private Sub DeleteItems()
    Dim CurrRow As Integer
    Dim rsUnit As New Recordset
    
    If State = adStateAddMode Then Exit Sub
    
    rsUnit.CursorLocation = adUseClient
    rsUnit.Open "SELECT * FROM Stock_Unit WHERE StockID=" & PK, CN, adOpenStatic, adLockOptimistic
    If rsUnit.RecordCount > 0 Then
        rsUnit.MoveFirst
        While Not rsUnit.EOF
            CurrRow = getFlexPos(Grid, 9, rsUnit!UnitID)
        
            'Add to grid
            With Grid
                If CurrRow < 0 Then
                    'Delete record if doesnt exist in flexgrid
                    DelRecwSQL "Stock_Unit", "StockUnitID", "", True, rsUnit!StockUnitID
                End If
            End With
            rsUnit.MoveNext
        Wend
    End If
End Sub

Private Sub txtIncoming_GotFocus()
    HLText txtIncoming
End Sub

Private Sub txtIncoming_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtIncoming_Validate(Cancel As Boolean)
    txtIncoming.Text = toNumber(txtIncoming.Text)
End Sub

Private Sub txtOnHand_GotFocus()
    HLText txtOnHand
End Sub

Private Sub txtOnHand_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtOnHand_Validate(Cancel As Boolean)
    txtOnHand.Text = toNumber(txtOnHand.Text)
End Sub

Private Sub txtOrder_GotFocus()
    HLText txtOrder
End Sub

Private Sub txtOrder_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtPending_GotFocus()
    HLText txtPending
End Sub

Private Sub txtPending_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtPending_Validate(Cancel As Boolean)
    txtPending.Text = toNumber(txtPending.Text)
End Sub

Private Sub txtQty_GotFocus()
    HLText txtQty
End Sub

Private Sub txtQty_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtSalesPrice_GotFocus()
    HLText txtSalesPrice
End Sub

Private Sub txtSalesPrice_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtSalesPrice_Validate(Cancel As Boolean)
    txtSalesPrice.Text = toMoney(toNumber(txtSalesPrice.Text))
End Sub

Private Sub txtSupplierPrice_GotFocus()
    HLText txtSupplierPrice
End Sub

Private Sub txtSupplierPrice_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtSupplierPrice_Validate(Cancel As Boolean)
    txtSupplierPrice.Text = toMoney(toNumber(txtSupplierPrice.Text))
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -