frmejck.frm

餐饮管理系统数据库设计文档 表名：bzqbj（保质期报警表） 字段名 字段类型 字段长度 （0表示不允许NULL

               Left            =   1920
               Top             =   240
               Width           =   1275
            End
         End
      End
   End
   Begin VB.Frame fmcover 
      BackColor       =   &H00A56E3A&
      Height          =   7155
      Left            =   0
      TabIndex        =   92
      Top             =   540
      Width           =   11655
      Begin VB.PictureBox piccover1 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   1875
         Left            =   1080
         Picture         =   "frmEjck.frx":2A55D
         ScaleHeight     =   1875
         ScaleWidth      =   7695
         TabIndex        =   95
         Top             =   2400
         Width           =   7695
      End
      Begin VB.PictureBox picCover 
         Appearance      =   0  'Flat
         BackColor       =   &H00A56E3A&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   1455
         Left            =   9240
         Picture         =   "frmEjck.frx":2BE97
         ScaleHeight     =   1455
         ScaleWidth      =   975
         TabIndex        =   93
         Top             =   2940
         Width           =   975
      End
   End
   Begin VB.Menu mnuczgl 
      Caption         =   "操作管理"
      Begin VB.Menu mnuqtyy 
         Caption         =   "前台营业"
      End
      Begin VB.Menu mnucgkc 
         Caption         =   "采购库存"
      End
      Begin VB.Menu mnuEjkc 
         Caption         =   "二级库存"
      End
      Begin VB.Menu mnuyysz 
         Caption         =   "营业设置"
      End
      Begin VB.Menu mnujyfx 
         Caption         =   "经营分析"
      End
      Begin VB.Menu mnucwjk 
         Caption         =   "财务监控"
      End
      Begin VB.Menu mnujygl 
         Caption         =   "经营管理"
      End
      Begin VB.Menu mnuxtgl 
         Caption         =   "系统管理"
      End
      Begin VB.Menu mnua 
         Caption         =   "-"
      End
      Begin VB.Menu mnucxdl 
         Caption         =   "重新登录"
      End
      Begin VB.Menu mnuxgmm 
         Caption         =   "修改密码"
      End
      Begin VB.Menu mnub 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退  出"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助"
      Begin VB.Menu mnuusehelp 
         Caption         =   "使用帮助"
      End
      Begin VB.Menu mnuReg 
         Caption         =   "软件注册"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "frmEjck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private ssylid(10000) As String
Private ssylmc(10000) As String
Private sskc(10000) As Long

Private Type wptype
    hcd As String   '商品编号
    hnm As String   '商品名称
    dw As String    '移动单位
    zksl As Double  '在库库存
End Type
Private wptype_ej() As wptype

Private Sub cbock_Click()
    Screen.MousePointer = vbHourglass
    Call Initcobbh_ck(cbock.Text)
    Screen.MousePointer = vbDefault
End Sub

Private Sub cbock_gl_Click()
    Call Initcoblsjl
    Call Initfgdkcgl(cbock_gl.Text)
End Sub

Private Sub cbospbh_ej_Click()
    Call setFldval(cbospbh_ej.ListIndex)
End Sub

Private Sub cmddjck_Click()
On Error GoTo err_cmddjck
    Dim strsql As String
    
    If Val(txtsl_ck) <= 0 Then
        MsgBox "出库数量不能小于或者等于零,请重新输入!", vbInformation, "提示信息"
        Exit Sub
    End If
    
    If ValidateComboBox(cobbh_ck) = False Then
        MsgBox "商品编号不能随便输入!", vbInformation, "提示信息"
        Exit Sub
    End If

    If ValidateComboBox(cbock) = False Then
        MsgBox "仓库名称不能随便输入!", vbInformation, "提示信息"
        Exit Sub
    End If

    If Val(txtsl_ck) > Val(txtkcl_ck) Then
        MsgBox "出库数量不能大于当前库存量!", vbInformation, "提示信息"
        Exit Sub
    End If
    
    If cbock.Text = "吧台酒库" Then
        strsql = "update jkkcb set sl=sl-" & Val(txtsl_ck) & " where ylid='" & cobbh_ck & "'"
    ElseIf cbock.Text = "厨房库存" Then
        strsql = "update lkkcb set sl=sl-" & Val(txtsl_ck) & " where ylid='" & cobbh_ck & "'"
    End If
    If ExeSQLByCmd(strsql) = False Then GoTo err_cmddjck
    
    strsql = "insert into ckb (ckid,ylbm,ylmc,cksl,dskc,lqrid,glyid,cksj,kid) values ('"
    strsql = strsql & GetCKDH & "','"
    strsql = strsql & cobbh_ck.Text & "','"
    strsql = strsql & txtylmc.Text & "',"
    strsql = strsql & Val(txtsl_ck.Text) & ","
    strsql = strsql & Val(txtkcl_ck.Text) & ",'"
    strsql = strsql & g_susername & "','"
    strsql = strsql & g_susername & "','"
    strsql = strsql & dtpcksj.Value & " " & CStr(Format(time, "hh:mm:ss")) & "','"
    
    If cbock.Text = "吧台酒库" Then
        strsql = strsql & "1')"
    ElseIf cbock.Text = "厨房库存" Then
        strsql = strsql & "2')"
    End If
    
    If ExeSQLByCmd(strsql) = False Then GoTo err_cmddjck
    
    Call SetValuefgdlsckd
Exit Sub
err_cmddjck:
    MsgBox "库存数量更新失败!请稍后重试!", vbInformation, "提示信息"
End Sub

Private Sub cmdEjkcgl_Click()
On Error Resume Next
    
    Screen.MousePointer = vbHourglass
    
    Call Initcbock_gl
    Call Initcoblsjl
    Call Initfgdkcgl(cbock_gl.Text)
    Call SetPropFgd(fgdkcgl)

    famEjkc.Visible = False
    famEjck.Visible = False
    famKcyd.Visible = False
    fmcover.Visible = False
    famEjkcgl.Visible = True
    
    Screen.MousePointer = vbDefault
End Sub
'*************************************************************************************
'*************************************************************************************
'初始化库存管理coblsjl
'*************************************************************************************
Private Sub Initcoblsjl()
On Error Resume Next
    Dim rs As ADODB.Recordset
    Dim strsql As String
    Dim i As Long
    
    coblsjl.Clear
    
    If cbock_gl = "吧台酒库" Then
        strsql = "select distinct kcdh from lskcb where ckid='1' order by kcdh"
    ElseIf cbock_gl = "厨房库存" Then
        strsql = "select distinct kcdh from lskcb where ckid='2' order by kcdh"
    End If
    
    Set rs = GetRsBySQL(strsql)
    
    With coblsjl
        .AddItem "当前库存"
        .Text = .List(0)
        
        If rs.RecordCount = 0 Then Exit Sub
        
        For i = 0 To rs.RecordCount - 1
            .AddItem rs("kcdh")
            rs.MoveNext
        Next
        
    End With
    
    rs.Close
    Set rs = Nothing
End Sub
'*************************************************************************************
'*************************************************************************************
'初始化库存管理fgdkcgl
'*************************************************************************************
Private Sub Initfgdkcgl(ByVal strckid As String)
On Error Resume Next

    Dim rs As ADODB.Recordset
    Dim bIsNow As Boolean
    Dim strsql As String
    Dim i As Long
    
    If strckid = "吧台酒库" Then
        If coblsjl <> "当前库存" Then
            bIsNow = False
            strsql = "select distinct lskcb.kcdh,lskcb.ylid,lskcb.sl as lssl,jkkcb.sl," 'ylmcb.ylid,,jkkcb.ylid
            strsql = strsql & "ylmcb.ylmc,ylmcb.dw,ylmcb.cgj,lsminalert,lsmaxalert "
            strsql = strsql & "from lskcb,jkkcb,ylmcb "
            strsql = strsql & "where lskcb.ylid=jkkcb.ylid and lskcb.ylid=ylmcb.ylid"
            strsql = strsql & " and lskcb.kcdh='" & coblsjl & "'"
        Else
            bIsNow = True
            strsql = "select distinct jkkcb.ylid,jkkcb.sl,minalert,maxalert," 'ylmcb.ylid,"
            strsql = strsql & "ylmcb.ylmc,ylmcb.dw,ylmcb.cgj "
            strsql = strsql & "from jkkcb,ylmcb "
            strsql = strsql & "where jkkcb.ylid=ylmcb.ylid"
        End If
    ElseIf strckid = "厨房库存" Then
        If coblsjl <> "当前库存" Then
            bIsNow = False
            strsql = "select distinct lskcb.kcdh,lskcb.ylid,lskcb.sl as lssl,lkkcb.sl," 'ylmcb.ylid,,lkkcb.ylid
            strsql = strsql & "ylmcb.ylmc,ylmcb.dw,ylmcb.cgj,lsminalert,lsmaxalert "
            strsql = strsql & "from lskcb,lkkcb,ylmcb "
            strsql = strsql & "where lskcb.ylid=lkkcb.ylid and lskcb.ylid=ylmcb.ylid"
            strsql = strsql & " and lskcb.kcdh='" & coblsjl & "'"
        Else
            bIsNow = True
            strsql = "select distinct lkkcb.ylid,lkkcb.sl,minalert,maxalert," 'ylmcb.ylid,"
            strsql = strsql & "ylmcb.ylmc,ylmcb.dw,ylmcb.cgj "
            strsql = strsql & "from lkkcb,ylmcb "
            strsql = strsql & "where lkkcb.ylid=ylmcb.ylid"
        End If
    End If
'    If bIsNow Then
'        cmdslhs.Enabled = True
'    Else
'        cmdslhs.Enabled = False
'    End If
    With fgdkcgl
        .Rows = 1
        .Cols = 6
        .ColWidth(0) = 300
        .TextMatrix(0, 0) = ""
        .TextMatrix(0, 1) = "原料编码"
        .TextMatrix(0, 2) = "原料名称"
        .TextMatrix(0, 3) = "数    量"
        .TextMatrix(0, 4) = "单    位"
        .TextMatrix(0, 5) = "采购价格"
'        .TextMatrix(0, 6) = "最低警戒"
'        .TextMatrix(0, 7) = "最高警戒"
    End With
    
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount = 0 Then
        fgdkcgl.Rows = 1
        Exit Sub
    End If
    
    With fgdkcgl
        .Rows = rs.RecordCount + 1
        
        For i = 0 To rs.RecordCount - 1
            .TextMatrix(i + 1, 0) = ""
            .TextMatrix(i + 1, 1) = rs("ylid")
            .TextMatrix(i + 1, 2) = rs("ylmc")
            If bIsNow Then
                .TextMatrix(i + 1, 3) = Format(rs("sl"), "0.00")
            Else
                .TextMatrix(i + 1, 3) = Format(rs("lssl"), "0.00")
            End If
            .TextMatrix(i + 1, 4) = rs("dw")
            .TextMatrix(i + 1, 5) = Format(rs("cgj"), "#,##0.00")
'            If bIsNow Then
'                .TextMatrix(i + 1, 6) = rs("minalert")
'                .TextMatrix(i + 1, 7) = rs("maxalert")
'            Else
'                .TextMatrix(i + 1, 6) = rs("lsminalert")
'                .TextMatrix(i + 1, 7) = rs("lsmaxalert")
'            End If
            rs.MoveNext
        Next
    End With
    
    rs.Close
    Set rs = Nothing
End Sub

Private Sub Initcbock_gl()
    With cbock_gl
        .Clear
        .AddItem "吧台酒库"
        .AddItem "厨房库存"
        .Text = .List(0)
    End With
End Sub

Private Sub cmdExit_ckgl_Click()