?? frmmerchitem.frm
字號:
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 MySuperMarket.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
' **********************************************************************
' 描 述：超市銷售系統源代碼
' Play78.com : 網站導航，源碼之家，絕對開源
' 海闊天空收集整理
' 主站地址：http://www.play78.com/
' 源碼下載地址：http://www.play78.com/blog
' 圖片下在地址：http://www.play78.com/pic
' QQ：13355575
' e-mail:hglai@eyou.com
' 編寫日期：2005年08月14日
' **********************************************************************
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 + -