?? frmstock.frm
字號:
TabIndex = 18
Top = 1380
Width = 1260
End
Begin VB.Label lbName
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "商品條形碼："
Height = 180
Left = 360
TabIndex = 17
Top = 435
Width = 1080
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "計劃進貨數量："
Height = 180
Left = 360
TabIndex = 16
Top = 915
Width = 1260
End
End
Begin MySuperMarket.XPButton cmdStock
Height = 345
Left = 3360
TabIndex = 3
Top = 660
Width = 975
_ExtentX = 1720
_ExtentY = 609
Caption = "入庫(&S)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MySuperMarket.XPButton cmdCheckStock
Height = 345
Left = 6600
TabIndex = 19
Top = 660
Width = 1335
_ExtentX = 2355
_ExtentY = 609
Caption = "檢查進貨需要"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MySuperMarket.XPButton cmdPrint
Height = 345
Left = 5520
TabIndex = 20
Top = 660
Width = 975
_ExtentX = 1720
_ExtentY = 609
Caption = "報表(&R)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
End
Attribute VB_Name = "frmStock"
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 cmdAdd_Click()
freItem.Tag = "a"
freItem.caption = " 添加計劃進貨 "
txtBarCode.Text = ""
txtNum.Text = "10"
txtDate.Text = Date
ShowFP True
txtBarCode.SetFocus
End Sub
Private Sub cmdCheckStock_Click()
On Error GoTo aaaa
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "Select * From MerchInfo Where MerchNum<=CautionNum", cnMain, 1, 1
If rs.EOF Then
MsgBox "沒有檢查到需要進貨的商品。", vbInformation
Else
Dim rtn As String
Do
rtn = InputBox("找到需要 " & rs.RecordCount & " 個進貨的商品。" & vbCrLf & vbCrLf & "請設定一個計劃進貨的日期", , Format(Date, "yyyy-mm-dd"))
rtn = Trim(rtn)
If rtn = "" Then
Exit Sub
Else
If IsDate(rtn) = False Then
MsgBox "不是一個有效的日期。", vbCritical
Else
Exit Do
End If
End If
Loop
Dim Item As ListItem
With frmPlanStock
Do Until rs.EOF
Set Item = .List1.ListItems.Add(, "k" & rs("MerchID"), rs("MerchName"), , 1)
Item.SubItems(1) = rs("PlanNum")
Item.SubItems(2) = rtn
Item.SubItems(3) = rs("MerchNum")
rs.MoveNext
Loop
.Show 1
End With
End If
Exit Sub
aaaa:
If Err.Number <> 91 Then MsgBox Err.Description, vbCritical
End Sub
Private Sub cmdDel_Click()
On Error GoTo aaaa
Dim i As Long, j As Long
j = 0
For i = 1 To List1.ListItems.Count
If List1.ListItems(i).Selected = True Then j = j + 1
Next
If j = 0 Then
MsgBox "沒有選中任何計劃進貨記錄。", vbInformation
Exit Sub
End If
If MsgBox("確定刪除選中的 " & j & " 個計劃進貨記錄嗎？", vbInformation + vbOKCancel + vbDefaultButton2) = vbCancel Then Exit Sub
For i = List1.ListItems.Count To 1 Step -1
If List1.ListItems(i).Selected = True Then
cnMain.Execute "Delete From Stock Where StockID=" & MID$(List1.ListItems(i).Key, 2)
List1.ListItems.Remove i
End If
Next
SetSB 2, "刪除 " & j & " 個進貨計劃成功."
Exit Sub
aaaa:
If Err.Number <> 91 Then MsgBox Err.Description, vbCritical
End Sub
Private Sub cmdEdit_Click()
On Error GoTo aaaa
Dim Item As ListItem
Set Item = List1.SelectedItem
freItem.Tag = "b"
freItem.caption = " 修改計劃進貨 "
txtBarCode.Tag = MID$(Item.Key, 2)
txtBarCode.Text = Item.SubItems(1)
txtNum.Text = Item.SubItems(2)
txtDate.Text = Item.SubItems(3)
ShowFP True
txtBarCode.SetFocus
aaaa:
End Sub
Private Sub cmdExit_Click()
ShowFP False
End Sub
Private Sub cmdFP_Click(Index As Integer)
If cmdFP(Index).IfDraw = True Then Exit Sub
cmdFP(Index).IfDraw = True
cmdFP(Index).BackColor = 14210516
cmdFP(1 - Index).IfDraw = False
cmdFP(1 - Index).BackColor = Me.BackColor
List1.Visible = cmdFP(0).IfDraw
MG2.Visible = cmdFP(1).IfDraw
cmdAdd.Enabled = cmdFP(0).IfDraw
cmdEdit.Enabled = cmdFP(0).IfDraw
cmdDel.Enabled = cmdFP(0).IfDraw
cmdStock.Enabled = cmdFP(0).IfDraw
cmdCheckStock.Enabled = cmdFP(0).IfDraw
cmdPrint.Enabled = cmdFP(0).IfDraw
If Index = 1 Then
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "Select Top 500 * From v_Stock order by 入庫日期 desc", cnMain, 1, 1
SetSB 2, "共 " & rs.RecordCount & " 條入庫記錄."
Set MG2.DataSource = rs
MG2.Refresh
End If
End Sub
Private Sub ShowFP(ByVal b As Boolean)
freItem.Visible = b
cmdDel.Enabled = Not b
cmdEdit.Enabled = Not b
cmdStock.Enabled = Not b
cmdAdd.Enabled = Not b
cmdCheckStock.Enabled = Not b
cmdPrint.Enabled = Not b
cmdFP(0).Enabled = Not b
cmdFP(1).Enabled = Not b
If b Then
List1.Visible = False
MG2.Visible = False
Else
List1.Visible = cmdFP(0).IfDraw
MG2.Visible = cmdFP(1).IfDraw
End If
End Sub
Private Sub cmdOK_Click()
On Error GoTo aaaa
Dim j As Long, d As Date, MID As String
If txtBarCode.Text = "" Then
MsgBox "必須填寫商品的條形碼。", vbInformation
txtBarCode.SetFocus
Exit Sub
End If
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "Select MerchID,BarCode From MerchInfo where BarCode='" & txtBarCode.Text & "'", cnMain, 1, 1
If rs.EOF Then
MsgBox "找不到對應的商品，請檢查輸入的條形碼。", vbInformation
txtBarCode.SetFocus
Exit Sub
Else
MID = rs("MerchID")
End If
rs.Close
If txtNum.Text = "" Then txtNum.Text = "0"
j = CLng(txtNum.Text)
If j = 0 Then
MsgBox "計劃進貨數量必須大于0", vbInformation
txtNum.SetFocus
Exit Sub
End If
If IsDate(txtDate.Text) = False Then
MsgBox "請輸入合法的計劃進貨日期。", vbInformation
txtDate.SetFocus
Exit Sub
End If
d = CDate(txtDate.Text)
If DateDiff("d", Date, d) < 0 Then
MsgBox "計劃進貨日期不能比今天早。", vbInformation
txtDate.SetFocus
Exit Sub
End If
If freItem.Tag = "a" Then
cnMain.Execute "insert Stock values(" & MID _
& "," & txtNum.Text _
& ",NULL,NULL,'" & txtDate.Text _
& "',NULL,0)"
LoadPlanStock
SetSB 2, "添加進貨計劃成功."
Else
cnMain.Execute "UPDATE Stock SET MerchID=" & MID & _
",MerchNum=" & txtNum.Text & ",PlanDate='" & _
txtDate.Text & "' Where StockID=" & txtBarCode.Tag
LoadPlanStock
SetSB 2, "修改進貨計劃成功."
End If
cmdExit_Click
Exit Sub
aaaa:
MsgBox Err.Description, vbCritical
txtBarCode.SetFocus
End Sub
Private Sub cmdPrint_Click()
If DataEnv1.rscmdPlanStock.State <> 0 Then DataEnv1.rscmdPlanStock.Requery
drPlanStock.Show
End Sub
Private Sub cmdStock_Click()
On Error GoTo aaaa
Dim Item As ListItem
Set Item = List1.SelectedItem
With frmToStock
.Tag = MID$(Item.Key, 2)
.lbName.caption = .lbName.caption + Item.Text
.lbName.Tag = Item.Text
.txtNum.Text = Item.SubItems(2)
.txtDate.Text = Date
.Show 1
End With
aaaa:
End Sub
Private Sub Form_Load()
On Error GoTo aaaa
Me.WindowState = 2
imgIcon.Picture = frmMain.cmdLeft(4).Picture
If DataEnv1.Connection1.State = 0 Then DataEnv1.Connection1.Open cnMain.ConnectionString
LoadPlanStock
Exit Sub
aaaa:
MsgBox Err.Description, vbCritical
End Sub
Public Sub LoadPlanStock()
Dim Item As ListItem
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "Select * From v_PlanStock order by SID DESC", cnMain, 1, 1
List1.ListItems.Clear
If Not rs.EOF Then
Do Until rs.EOF
Set Item = List1.ListItems.Add(, "k" & rs("SID"), rs("商品名稱"), , 1)
Item.SubItems(1) = rs("條形碼")
Item.SubItems(2) = rs("計劃進貨數量")
Item.SubItems(3) = rs("計劃進貨日期")
Item.SubItems(4) = rs("廠商")
Item.SubItems(5) = rs("供貨商")
rs.MoveNext
Loop
End If
SetSB 2, "共 " & rs.RecordCount & " 條計劃進貨記錄."
End Sub
Private Sub Form_Resize()
On Error Resume Next
List1.Width = Width / 15 - 104
List1.Height = Height / 15 - 114
MG2.Width = Width / 15 - 104
MG2.Height = Height / 15 - 114
PicTop.Width = Width / 15 - 16
Cls
Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub
Private Sub List1_DblClick()
On Error GoTo aaaa
Dim j As Long
j = List1.SelectedItem.Index
cmdEdit_Click
aaaa:
End Sub
Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
If KeyCode = vbKeyDelete Then
Dim j As Long
j = List1.SelectedItem.Index
cmdDel_Click
End If
If KeyCode = vbKeyA And Shift = 2 Then
For j = 1 To List1.ListItems.Count
List1.ListItems(j).Selected = True
Next
End If
aaaa:
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -