frmstock.frm

超市销售管理系统 4) 文档里面有完整的需求说明书

         BackStyle       =   0  'Transparent
         Caption         =   "计划进货日期："
         Height          =   180
         Left            =   360
         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 SuperMarket.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 SuperMarket.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 SuperMarket.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
'超市销售系统
'程序开发：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'个人主页：http://www.3lsoft.com
'邮箱：[e-mail]
'注：此代码禁止用于商业用途。有修改者发我一份，谢谢！
'---------------- 开源世界，你我更进步 ----------------
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