📄 frmmerchitem.frm
字号:
Height = 180
Left = 120
TabIndex = 26
Top = 300
Width = 630
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起日期:"
Height = 180
Left = 120
TabIndex = 25
Top = 660
Width = 630
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "止日期:"
Height = 180
Left = 120
TabIndex = 23
Top = 1020
Width = 630
End
End
Begin SuperMarket.FTextBox txtPlanNum
Height = 300
Left = 1320
TabIndex = 5
Top = 2700
Width = 1575
_ExtentX = 2778
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
FontName = "宋体"
FontSize = 9
Text = "10"
AutoSelAll = -1 'True
isNumber = -1 'True
MaxLength = 6
afterdecimal = 0
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "进货计划数:"
Height = 180
Left = 240
TabIndex = 27
Top = 2760
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "库存数:"
Height = 180
Left = 240
TabIndex = 19
Top = 1320
Width = 630
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "报警数:"
Height = 180
Left = 240
TabIndex = 18
Top = 1680
Width = 630
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "条形码:"
Height = 180
Left = 240
TabIndex = 17
Top = 240
Width = 630
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "名 称:"
Height = 180
Left = 240
TabIndex = 16
Top = 600
Width = 630
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "厂 商:"
Height = 180
Left = 240
TabIndex = 15
Top = 2040
Width = 630
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "供货商:"
Height = 180
Left = 240
TabIndex = 14
Top = 2400
Width = 630
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "价 格:"
Height = 180
Left = 240
TabIndex = 13
Top = 960
Width = 630
End
End
Attribute VB_Name = "frmMerchItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'超市销售系统
'程序开发：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'个人主页：http://www.3lsoft.com
'邮箱：3lsoft@163.com
'注：此代码禁止用于商业用途。有修改者发我一份，谢谢！
'---------------- 开源世界，你我更进步 ----------------
Private Sub ChCX_Click()
On Error Resume Next
Frame1.Enabled = (ChCX.value = 1)
If ChCX.value = 1 Then txtSPrice.SetFocus
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo aaaa
Dim s1 As String, s2 As String, s3 As String
Dim Item As ListItem
If txtBarCode.Text = "" Then
MsgBox "必须填写条形码。", vbInformation
txtBarCode.SetFocus
Exit Sub
End If
If txtName.Text = "" Then
MsgBox "必须填写商品名称。", vbInformation
txtName.SetFocus
Exit Sub
End If
If CCur(txtPrice.Text) = 0 Then
MsgBox "商品价格必须大于0。", vbInformation
txtPrice.SetFocus
Exit Sub
End If
If txtMerchNum.Text = "" Then
MsgBox "必须填写库存数量。", vbInformation
txtMerchNum.SetFocus
Exit Sub
End If
If txtCautionNum.Text = "" Then
MsgBox "必须填写库存报警数量。", vbInformation
txtCautionNum.SetFocus
Exit Sub
End If
If ChCX.value = 1 Then
If txtSPrice.Text = "" Then
MsgBox "必须填写促销价格。", vbInformation
txtSPrice.SetFocus
Exit Sub
End If
If txtDateS.Text = "" Or IsDate(txtDateS.Text) = False Then
MsgBox "必须填写正确的促销起日期。", vbInformation
txtDateS.SetFocus
Exit Sub
End If
If txtDateE.Text = "" Or IsDate(txtDateE.Text) = False Then
MsgBox "必须填写正确的促销止起日期。", vbInformation
txtDateE.SetFocus
Exit Sub
End If
s1 = txtSPrice.Text
s2 = "'" & txtDateS.Text & "'"
s3 = "'" & txtDateE.Text & "'"
Else
s1 = "NULL"
s2 = "NULL"
s3 = "NULL"
End If
If CLng(txtPlanNum.Text) = 0 Then
MsgBox "进货计划数必须大于0。", vbInformation
txtPlanNum.SetFocus
Exit Sub
End If
If Me.Tag = "" Then '添加模式
cnMain.Execute "Insert MerchInfo Values(" & _
"'" & txtName.Text & "'," & _
txtPrice.Text & "," & _
txtMerchNum.Text & "," & _
txtCautionNum.Text & "," & _
txtPlanNum.Text & "," & _
"'" & txtBarCode.Text & "'," & _
s1 & "," & _
s2 & "," & _
s3 & "," & _
Ch2.value & "," & _
Ch1.value & "," & _
"'" & frmMerch.lstFactory.List(cboFactory.ListIndex) & "'," & _
"'" & frmMerch.lstProvide.List(cboProvide.ListIndex) & "')"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "Select MerchID From MerchInfo order by MerchID DESC", cnMain, 1, 1
Set Item = frmMerch.List1.ListItems.Add(1, "k" & rs("MerchID"), txtName.Text, , 1)
rs.Close
Else
cnMain.Execute "UPDATE MerchInfo SET " & _
"MerchName='" & txtName.Text & "',MerchPrice=" & _
txtPrice.Text & ",MerchNum=" & _
txtMerchNum.Text & ",CautionNum=" & _
txtCautionNum.Text & ",PlanNum=" & _
txtPlanNum.Text & ",BarCode=" & _
"'" & txtBarCode.Text & "',SalesProPrice=" & _
s1 & ",SalesProDateS=" & _
s2 & ",SalesProDateE=" & _
s3 & ",AllowAbate=" & _
Ch2.value & ",AllowSale=" & _
Ch1.value & ",FactoryID=" & _
"'" & frmMerch.lstFactory.List(cboFactory.ListIndex) & "',ProvideID=" & _
"'" & frmMerch.lstProvide.List(cboProvide.ListIndex) & "' Where BarCode='" & Me.Tag & "'"
Set Item = frmMerch.List1.SelectedItem
End If
With Item
.Text = txtName.Text
.SubItems(1) = txtPrice.Text
.SubItems(2) = txtBarCode.Text
.SubItems(3) = txtMerchNum.Text
.SubItems(4) = IIf(Ch2.value = 1, "允许", "")
.SubItems(5) = frmMerch.GetMerchState(Item, CLng(txtMerchNum.Text), CLng(txtCautionNum.Text), IIf(s1 = "NULL", "", s1), txtDateS.Text, txtDateE.Text, CLng(Ch1.value))
.SubItems(6) = cboFactory.Text
.SubItems(7) = cboProvide.Text
.Tag = txtPlanNum.Text
End With
If Me.Tag = "" Then '添加模式
SetSB 2, "添加商品 " & txtName.Text & " 成功."
txtBarCode.Text = ""
txtBarCode.SetFocus
Else
SetSB 2, "修改商品 " & txtName.Text & " 成功."
Unload Me
End If
Exit Sub
aaaa:
MsgBox "添加商品出错，可能是该商品名称或条形码已经存在。", vbCritical
txtBarCode.SetFocus
End Sub
Private Sub Form_Load()
txtDateS.Text = Date
Move frmMain.Left + frmMain.Width - Me.Width - 400, frmMain.Top + (frmMain.Height - Me.Height) / 2
Dim i As Long
For i = 1 To frmMerch.cboFactory.ListCount - 1
cboFactory.AddItem frmMerch.cboFactory.List(i)
Next
cboFactory.ListIndex = 0
For i = 1 To frmMerch.cboProvide.ListCount - 1
cboProvide.AddItem frmMerch.cboProvide.List(i)
Next
cboProvide.ListIndex = 0
'如果是修改商品模式
If frmMerch.xChangeItem <> "" Then
Dim s1$, s2$, s3$
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Me.Tag = frmMerch.xChangeItem
Me.caption = "修改商品"
s1 = "SELECT MerchID,MerchName,MerchPrice,BarCode,MerchNum,CautionNum,PlanNum,SalesProPrice,SalesProDateS,SalesProDateE,AllowAbate,AllowSale,Factory.FactoryName,Provide.ProvideName From MerchInfo, Provide, Factory "
s2 = "Where BarCode='" & Me.Tag & "' and "
s3 = "MerchInfo.FactoryID = Factory.FactoryID And MerchInfo.ProvideID = Provide.ProvideID order by MerchID Desc"
rs.Open s1 & s2 & s3, cnMain, 1, 1
If Not rs.EOF Then
txtBarCode.Text = rs("BarCode")
txtName.Text = rs("MerchName")
txtPrice.Text = rs("MerchPrice")
txtMerchNum.Text = rs("MerchNum")
txtCautionNum.Text = rs("CautionNum")
txtPlanNum.Text = rs("PlanNum")
For i = 0 To cboFactory.ListCount - 1
If StrComp(cboFactory.List(i), rs("FactoryName"), 1) = 0 Then cboFactory.ListIndex = i: Exit For
Next
For i = 0 To cboProvide.ListCount - 1
If StrComp(cboProvide.List(i), rs("ProvideName"), 1) = 0 Then cboProvide.ListIndex = i: Exit For
Next
Ch1.value = CLng(rs("AllowSale"))
Ch2.value = CLng(rs("AllowAbate"))
If rs("SalesProPrice") & "" <> "" Then
ChCX.value = 1
txtSPrice.Text = rs("SalesProPrice") & ""
txtDateS.Text = rs("SalesProDateS") & ""
txtDateE.Text = rs("SalesProDateE") & ""
End If
End If
End If
End Sub
Private Sub txtBarCode_Change()
cmdOK.Enabled = (Trim(txtBarCode.Text) <> "")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -