mdlappendmerchandise.bas

VB数据库设计的代码。需要根据自己的数据库再作调整

Attribute VB_Name = "mdlAppendMerchandise"
Option Explicit

'***********************************************************************
'* 过程名：AppendNewApply
'* 功  能：追加补货申请
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Public Sub AppendNewApply(ByRef lvListViewCtl As ListView)
    Dim appendMerApply As clsOpAppendMerchandise
    Set appendMerApply = New clsOpAppendMerchandise
    appendMerApply.AppendNewApply g_currentUser
    UpdateListViewInApply lvListViewCtl
End Sub

'***********************************************************************
'* 过程名：EditApply
'* 功  能：编辑补货申请/核准补货
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Public Sub EditApply(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim currentSelApplyId As String               '当前选择店ID
    Dim currentSelApply As clsAppendMerchandise   '当前选择店
    Dim opApply As clsOpAppendMerchandise         '连锁店操作对象
    
    '取得当前选择
    If lvListViewCtl.SelectedItem Is Nothing Then
         MsgBox "请选择要编辑的补货申请！", vbExclamation Or vbOKOnly, "警告"
    Else
        currentSelApplyId = Trim(lvListViewCtl.SelectedItem.Text)
        Set currentSelApply = New clsAppendMerchandise
        If currentSelApply.LoadById(CInt(currentSelApplyId)) = DbOpRecExist Then
            Set opApply = New clsOpAppendMerchandise
            opApply.EditApply currentSelApply, g_currentUser
            lvListViewCtl.ListItems.Remove lvListViewCtl.SelectedItem.Index
            UpdateListViewInApply lvListViewCtl
        Else
            MsgBox "读取补货申请信息失败！", vbExclamation Or vbOKOnly, "警告"
        End If
    End If
End Sub

'***********************************************************************
'* 过程名：IniListViewInApply
'* 功  能：以补货申请列表初始化ListView
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Public Sub IniListViewInApply(ByRef lvListViewCtl As ListView)
    If g_listViewState = APPLYLIST Then
        UpdateListViewInApply lvListViewCtl
    Else
        '变量定义
        Dim applySet As clsAppendMerchandiseSet
        Dim apply As clsAppendMerchandise
        Dim curListItem As ListItem
        
        '取得补货申请集合
        Set applySet = New clsAppendMerchandiseSet
        If g_currentUser.shopId > 1 Then
            applySet.LoadSetByShopId g_currentUser.shopId
        End If
        
        '清除现有显示
        lvListViewCtl.ColumnHeaders.Clear
        lvListViewCtl.ListItems.Clear
        
        '设定表头
        lvListViewCtl.ColumnHeaders.Add , "补货申请ID", "补货申请ID"
        lvListViewCtl.ColumnHeaders.Add , "店名", "店名"
        lvListViewCtl.ColumnHeaders.Add , "商品", "商品"
        lvListViewCtl.ColumnHeaders.Add , "申请补货数量", "申请补货数量"
        lvListViewCtl.ColumnHeaders.Add , "核准补货数量", "核准补货数量"
        lvListViewCtl.ColumnHeaders.Add , "提交申请日期", "提交申请日期"
        
        '明细显示
        For Each apply In applySet
            Set curListItem = lvListViewCtl.ListItems.Add(, , CStr(apply.applyid))
            curListItem.SubItems(1) = apply.shopName
            curListItem.SubItems(2) = apply.merchandiseName
            curListItem.SubItems(3) = CStr(apply.applyCount)
            If apply.appendCount >= 0 Then
                curListItem.SubItems(4) = CStr(apply.appendCount)
            Else
                curListItem.SubItems(4) = "待核准"
            End If
            curListItem.SubItems(5) = apply.applyDate
        Next
    End If
    g_listViewState = APPLYLIST
End Sub

'***********************************************************************
'* 过程名：UpdateListViewInApply
'* 功  能：更补货申请列表
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Public Sub UpdateListViewInApply(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim applySet As clsAppendMerchandiseSet
    Dim apply As clsAppendMerchandise
    Dim curListItem As ListItem
    Dim iLoop As Integer
    
    '取得补货申请集合
    Set applySet = New clsAppendMerchandiseSet
    If g_currentUser.shopId > 1 Then
        applySet.LoadSetByShopId g_currentUser.shopId
    End If
    
    '明细更新
    For Each apply In applySet
        For iLoop = 1 To lvListViewCtl.ListItems.Count
            If apply.applyid = lvListViewCtl.ListItems.Item(iLoop).Text Then
                GoTo CHECKAGAIN
            End If
        Next
        
        Set curListItem = lvListViewCtl.ListItems.Add(, , CStr(apply.applyid))
        curListItem.SubItems(1) = apply.shopName
        curListItem.SubItems(2) = apply.merchandiseName
        curListItem.SubItems(3) = CStr(apply.applyCount)
        If apply.appendCount >= 0 Then
            curListItem.SubItems(4) = CStr(apply.appendCount)
        Else
            curListItem.SubItems(4) = "待核准"
        End If
        curListItem.SubItems(5) = apply.applyDate
CHECKAGAIN:
    Next
End Sub

'***********************************************************************
'* 过程名：RemoveApply
'* 功  能：删除补货申请
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Public Sub RemoveApply(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim currentSelApplyId As String               '当前选择补货申请ID
    Dim currentSelApply As clsAppendMerchandise   '当前选择补货申请
    Dim opApply As clsOpAppendMerchandise         '补货申请操作对象
    
    If Not lvListViewCtl.SelectedItem Is Nothing Then
        currentSelApplyId = lvListViewCtl.SelectedItem.Text
        If MsgBox("删除ID为[" & currentSelApplyId & "]的补货申请吗？", vbQuestion Or _
                vbYesNo, "询问") = vbYes Then
            Set currentSelApply = New clsAppendMerchandise
            If currentSelApply.LoadById(CInt(currentSelApplyId)) = DbOpRecExist Then
                Set opApply = New clsOpAppendMerchandise
                If opApply.RemoveApply(currentSelApply, g_currentUser) Then
                    lvListViewCtl.ListItems.Remove lvListViewCtl.SelectedItem.Index
                    Exit Sub
                End If
            End If
            MsgBox "删除补货申请失败！", vbExclamation Or vbOKOnly, "警告"
        End If
    Else
        MsgBox "请先选择要删除的补货申请！", vbExclamation Or vbOKOnly, "警告"
    End If
End Sub