📄 frmproductsae.frm
字号:
Caption = "Modification History"
Height = 315
Left = 210
TabIndex = 20
Top = 6930
Width = 1680
End
Begin VB.TextBox txtEntry
Alignment = 1 'Right Justify
Height = 285
Index = 5
Left = 1500
MaxLength = 20
TabIndex = 4
Top = 1680
Width = 780
End
Begin VB.TextBox txtEntry
Height = 285
Index = 4
Left = 1500
MaxLength = 100
TabIndex = 3
Top = 1335
Width = 2415
End
Begin VB.TextBox txtEntry
Height = 285
Index = 3
Left = 1500
MaxLength = 200
TabIndex = 2
Top = 990
Width = 4125
End
Begin VB.TextBox txtEntry
Height = 285
Index = 2
Left = 1500
MaxLength = 100
TabIndex = 1
Tag = "Name"
Top = 630
Width = 7365
End
Begin VB.CommandButton cmdCancel
Caption = "Cancel"
Height = 315
Left = 8730
TabIndex = 19
Top = 6960
Width = 1335
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Default = -1 'True
Height = 315
Left = 7320
TabIndex = 18
Top = 6960
Width = 1335
End
Begin VB.TextBox txtEntry
BackColor = &H00E6FFFF&
ForeColor = &H00000000&
Height = 285
Index = 1
Left = 1500
TabIndex = 0
TabStop = 0 'False
Top = 285
Width = 1965
End
Begin Inventory.ctrlLiner ctrlLiner1
Height = 30
Left = 240
TabIndex = 21
Top = 6825
Width = 9795
_ExtentX = 17277
_ExtentY = 53
End
Begin MSDataListLib.DataCombo dcCategory
Height = 315
Left = 1500
TabIndex = 7
Top = 2400
Width = 2745
_ExtentX = 4842
_ExtentY = 556
_Version = 393216
Style = 2
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
End
Begin MSDataListLib.DataCombo dcReoderUnit
Height = 315
Left = 2790
TabIndex = 5
Top = 1680
Width = 1425
_ExtentX = 2514
_ExtentY = 556
_Version = 393216
Style = 2
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Ext Price"
Height = 240
Index = 3
Left = 210
TabIndex = 42
Top = 2040
Width = 1215
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "Unit"
Height = 285
Left = 2370
TabIndex = 29
Top = 1680
Width = 345
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Status"
Height = 240
Index = 9
Left = 210
TabIndex = 28
Top = 2760
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Category"
Height = 240
Index = 11
Left = 210
TabIndex = 27
Top = 2370
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Reorder Pt."
Height = 240
Index = 7
Left = 210
TabIndex = 26
Top = 1680
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "ICode"
Height = 240
Index = 4
Left = 210
TabIndex = 25
Top = 1365
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Short"
Height = 240
Index = 2
Left = 210
TabIndex = 24
Top = 945
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Product"
Height = 240
Index = 1
Left = 210
TabIndex = 23
Top = 600
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Barcode"
Height = 240
Index = 0
Left = 210
TabIndex = 22
Top = 285
Width = 1215
End
End
Attribute VB_Name = "frmProductsAE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public State As FormState 'Variable used to determine on how the form used
Public PK As Long 'Variable used to get what record is going to edit
Public srcText As TextBox 'Used in pop-up mode
Public srcTextAdd As TextBox 'Used in pop-up mode -> Display the customer address
Public srcTextCP As TextBox 'Used in pop-up mode -> Display the customer contact person
Public srcTextDisc As Object 'Used in pop-up mode -> Display the customer Discount (can be combo or textbox)
Dim cIRowCount As Integer
Dim HaveAction As Boolean 'Variable used to detect if the user perform some action
Dim RS As New Recordset
Dim rs1 As New Recordset
Dim RSStockUnit As New Recordset
Private Sub btnRemove_Click()
'Remove selected load product
With Grid
'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 cmdAdd_Click()
If Trim(txtOrder.Text) = "" Or Trim(txtQty.Text) = "" Or Trim(nsdUnit.Text) = "" Then Exit Sub
Dim CurrRow As Integer
Dim intUnitID As Integer
' If nsdUnit.BoundText = "" Then
CurrRow = getFlexPos(Grid, 9, nsdUnit.Tag)
' intUnitID = nsdUnit.Tag
' Else
' CurrRow = getFlexPos(Grid, 9, nsdUnit.BoundText)
' intUnitID = nsdUnit.BoundText
' End If
'Add to grid
With Grid
If CurrRow < 0 Then
'Perform if the record is not exist
If .Rows = 2 And .TextMatrix(1, 9) = "" Then
.TextMatrix(1, 1) = txtOrder.Text
.TextMatrix(1, 2) = txtQty.Text
.TextMatrix(1, 3) = nsdUnit.Text
.TextMatrix(1, 4) = toMoney(txtSalesPrice.Text)
.TextMatrix(1, 5) = toMoney(txtSupplierPrice.Text)
.TextMatrix(1, 6) = txtPending.Text
.TextMatrix(1, 7) = txtIncoming.Text
.TextMatrix(1, 8) = txtOnHand.Text
.TextMatrix(1, 9) = nsdUnit.Tag 'intUnitID
Else
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 1) = txtOrder.Text
.TextMatrix(.Rows - 1, 2) = txtQty.Text
.TextMatrix(.Rows - 1, 3) = nsdUnit.Text
.TextMatrix(.Rows - 1, 4) = toMoney(txtSalesPrice.Text)
.TextMatrix(.Rows - 1, 5) = toMoney(txtSupplierPrice.Text)
.TextMatrix(.Rows - 1, 6) = txtPending.Text
.TextMatrix(.Rows - 1, 7) = txtIncoming.Text
.TextMatrix(.Rows - 1, 8) = txtOnHand.Text
.TextMatrix(.Rows - 1, 9) = nsdUnit.Tag 'intUnitID
.Row = .Rows - 1
End If
'Increase the record count
cIRowCount = cIRowCount + 1
Else
If MsgBox("Item already added. Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
.Row = CurrRow
.TextMatrix(CurrRow, 1) = txtOrder.Text
.TextMatrix(CurrRow, 2) = txtQty.Text
.TextMatrix(CurrRow, 3) = nsdUnit.Text
.TextMatrix(CurrRow, 4) = toMoney(txtSalesPrice.Text)
.TextMatrix(CurrRow, 5) = toMoney(txtSupplierPrice.Text)
.TextMatrix(CurrRow, 6) = txtPending.Text
.TextMatrix(CurrRow, 7) = txtIncoming.Text
.TextMatrix(CurrRow, 8) = txtOnHand.Text
.TextMatrix(CurrRow, 9) = nsdUnit.Tag 'intUnitID
Else
Exit Sub
End If
End If
'Highlight the current row's column
.ColSel = 8
'Display a remove button
Grid_Click
End With
End Sub
Private Sub DisplayForEditing()
On Error GoTo err
With RS
txtEntry(1).Text = .Fields("Barcode")
txtEntry(2).Text = .Fields("Stock")
txtEntry(3).Text = .Fields("Short")
txtEntry(4).Text = .Fields("ICode")
txtEntry(5).Text = .Fields("ReorderPoint")
txtEntry(6).Text = toMoney(.Fields("ExtPrice"))
dcReoderUnit.BoundText = IIf(IsNull(.Fields![UnitID]), "", .Fields![UnitID])
cboStatus.Text = .Fields("Status")
dcCategory.BoundText = .Fields![CategoryID]
End With
'Display the details
Dim RSStockUnit As New Recordset
cIRowCount = 0
RSStockUnit.CursorLocation = adUseClient
RSStockUnit.Open "SELECT * FROM qry_Stock_Unit WHERE StockID=" & PK & " Order by [Order] ASC", CN, adOpenStatic, adLockOptimistic
If RSStockUnit.RecordCount > 0 Then
RSStockUnit.MoveFirst
While Not RSStockUnit.EOF
cIRowCount = cIRowCount + 1 'increment
With Grid
If .Rows = 2 And .TextMatrix(1, 9) = "" Then
.TextMatrix(1, 1) = RSStockUnit![Order]
.TextMatrix(1, 2) = RSStockUnit![Qty]
.TextMatrix(1, 3) = RSStockUnit![Unit]
.TextMatrix(1, 4) = toMoney(RSStockUnit![SalesPrice])
.TextMatrix(1, 5) = toMoney(RSStockUnit![SupplierPrice])
.TextMatrix(1, 6) = RSStockUnit![Pending]
.TextMatrix(1, 7) = RSStockUnit![Incoming]
.TextMatrix(1, 8) = RSStockUnit![Onhand]
.TextMatrix(1, 9) = RSStockUnit![UnitID]
Else
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 1) = RSStockUnit![Order]
.TextMatrix(.Rows - 1, 2) = RSStockUnit![Qty]
.TextMatrix(.Rows - 1, 3) = RSStockUnit![Unit]
.TextMatrix(.Rows - 1, 4) = toMoney(RSStockUnit![SalesPrice])
.TextMatrix(.Rows - 1, 5) = toMoney(RSStockUnit![SupplierPrice])
.TextMatrix(.Rows - 1, 6) = RSStockUnit![Pending]
.TextMatrix(.Rows - 1, 7) = RSStockUnit![Incoming]
.TextMatrix(.Rows - 1, 8) = RSStockUnit![Onhand]
.TextMatrix(.Rows - 1, 9) = RSStockUnit![UnitID]
End If
End With
RSStockUnit.MoveNext
Wend
Grid.Row = 1
Grid.ColSel = 8
'Set fixed cols
If State = adStateEditMode Then
Grid.FixedRows = Grid.Row: 'Grid.SelectionMode = flexSelectionFree
Grid.FixedCols = 1
End If
End If
RSStockUnit.Close
'Clear variables
Set RSStockUnit = Nothing
Exit Sub
err:
'If err.Number = 94 Then Resume Next
MsgBox "Error: " & err.Description, vbExclamation
End Sub
Private Sub cmdAdjust_Click()
With frmTransferQty
.StockID = PK
.show 1
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub ResetFields()
clearText Me
txtEntry(1).SetFocus
End Sub
Private Sub cmdSave_Click()
On Error GoTo err
'check for blank product
' If is_empty(txtEntry(2).Text) = True Then
' MsgBox "Product should not be empty.", vbExclamation
' Exit Sub
' End If
If txtEntry(2).Text = "" Then
MsgBox "Product should not be empty.", vbExclamation
Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -