frmlistsales.frm

金算盘软件代码

    End With
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0: '修改
        mclsMainControl_EditEdit
    Case 1: '新增
        mclsMainControl_EditNew
    Case 2: '删除
        mclsMainControl_EditDel
    Case 4
'       ShowBill1 intFormType + 2, GetlngActivityID, True
       Dim lngTypeID As Long
       lngTypeID = frmWriteOffBill.WriteOffBill(intFormType + 2, GetlngActivityID, Me.hwnd)
       If lngTypeID > 0 Then ShowBill1 intFormType + 2, lngTypeID, True
    Case 6: '作废
        mclsMainControl_EditInActive
    Case 7: '全部显示
        mclsMainControl_EditShowAll
    Case 9: '筛选
        mclsMainControl_EditFilter
    Case 10: '栏目设置
        mclsMainControl_EditColumn
    Case 12: '打印
        mclsMainControl_ToolRefresh
    Case 13: '打印
        mclsMainControl_FilePrintReceipt
    Case 14
        mclsMainControl_FilePrint
    End Select
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑
Private Sub mclsMainControl_EditEdit()
    Dim lngActivityID As Long
    Me.Enabled = False
    lngActivityID = GetlngActivityID()
'    If lngFormHwnd(intFormType + 2) > 0 Then
'        BringWindowToTop lngFormHwnd(intFormType + 2)
'    Else
        mblnFinish = True
        frmEdit.ShowAOldBill (lngActivityID) '调用接口
        mblnFinish = False
   'End If
   Me.Enabled = True
End Sub

'新增
Private Sub mclsMainControl_EditNew()
'    If lngFormHwnd(intFormType + 2) > 0 Then
'        BringWindowToTop lngFormHwnd(intFormType + 2)
'    Else
        mblnFinish = True
        frmEdit.ShowANewTypeBill intFormType + 2
        mblnFinish = False
'    End If
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngActivityID As Long
    Dim lngActivityTypeID As Long
    Dim blnPushOut As Boolean
    lngActivityID = GetlngActivityID()
    lngActivityTypeID = GetlngActivityTypeID(lngActivityID)
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If lngFormHwnd(intFormType + 2) > 0 Then
        If lngActivityID = frmEdit.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    If Not mclsSales.DeleteSales(lngActivityID, , , blnPushOut) Then Exit Sub
    If blnIsInvoice Then
        If intFormType = 18 And lngActivityTypeID <> 18 Then
            gclsSys.SendMessage CStr(Me.hwnd), 32 + lngActivityTypeID
        ElseIf intFormType = 11 Or intFormType = 12 Or intFormType = 14 Then
            gclsSys.SendMessage CStr(Me.hwnd), 50
        End If
    End If
    If blnPushOut Then
        mclsMainControl_ChildActive
        Exit Sub
    End If
    '从Grid中删除本行
    With grdList
        If .Rows = 2 Then '要删除的行是GRID 的最后一行
'            mclsMainControl_ToolRefresh
            .RowHeight(.Row) = 0
            If chkShowAll.Value = 1 Then
                chkShowAll.Value = 0
                chkShowAll.Enabled = False
            End If
        Else
            .RemoveItem (.Row)
        End If
    End With
    UpdateMenuStatus
End Sub

'作废
Private Sub mclsMainControl_EditInActive()
    Dim strSql As String
    Dim blnPushOut As Boolean
    Dim recTemp As rdoResultset
    Dim lngActivityID As Long
    Dim strMsg As String
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    lngActivityID = GetlngActivityID()
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    If ShowMsg(Me.hwnd, "本张" & strTypeName & "作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Sub
    If blnIsVoid Then Exit Sub
    
'    '1）不能作废
'    If blnIsInvoice Then
'        cMsgBox "本张" & strTypeName & "已开票，不能作废"
'        Exit Sub
'    End If
'    If blnIsVouchered Then
'        cMsgBox "本张" & strTypeName & "已生成凭证，不能作废！"
'        Exit Sub
'    End If
'    Select Case intFormType
'    Case 11 '商品销售：已开票
'    Case 12 '直运销售：已开票
'    Case 13 '代销出库：已结算
'        strSql = "SELECT Sum(ItemActivityDetail.dblCurrSettlementAmount) AS dblCurrSettlementAmountOfSum FROM ItemActivityDetail Where (((ItemActivityDetail.lngActivityID) = " & lngActivityID & ")) GROUP BY ItemActivityDetail.lngActivityID"
'        Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If Not recTemp.EOF Then
'            If Not IsNull(recTemp(0)) Then
'                If recTemp(0) <> 0 Then
'                    Set recTemp = Nothing
'                    cMsgBox "本张" & strTypeName & "已结算，不能作废！"
'                    Exit Sub
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 14 '代销结算：已开票
'    Case 15 '加工出库：已加工入库
'        strSql = "SELECT Sum(ItemActivityDetail.dblEntrustQuantity) AS dblEntrustQuantityOfSum FROM ItemActivityDetail Where (((ItemActivityDetail.lngActivityID) = " & lngActivityID & ")) GROUP BY ItemActivityDetail.lngActivityID"
'        Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If Not recTemp.EOF Then
'            If Not IsNull(recTemp(0)) Then
'                If recTemp(0) <> 0 Then
'                    Set recTemp = Nothing
'                    cMsgBox "本张加工出库单中的商品已入库，不能作废！"
'                    Exit Sub
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 16 '分期出库：已结算
'        strSql = "SELECT Sum(ItemActivityDetail.dblCurrSettlementAmount) AS dblCurrSettlementAmountOfSum FROM ItemActivityDetail Where (((ItemActivityDetail.lngActivityID) = " & lngActivityID & ")) GROUP BY ItemActivityDetail.lngActivityID"
'        Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If Not recTemp.EOF Then
'            If Not IsNull(recTemp(0)) Then
'                If recTemp(0) <> 0 Then
'                    Set recTemp = Nothing
'                    cMsgBox "本张" & strTypeName & "已结算，不能作废！"
'                    Exit Sub
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 17 '分期结算：已开票
'    Case 18 '销售发票
'    Case 19 '领用出库
'    Case 20 '成本调整：不能
'        'Exit Sub
'    Case 21 '盘亏出库：非手工填制
'         '算法：本张盘亏出库单非手工添制 则在 StockTakingToReceipt 有对应记录
'        strSql = "SELECT lngActivityDetailID FROM ItemActivityDetail WHERE lngOrderDetailID>0 AND lngActivityID=" & lngActivityID
'        Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If Not recTemp.EOF Then
'            Set recTemp = Nothing
'            cMsgBox "本张盘亏出库单由商品盘点表生成，不能作废！"
'            Exit Sub
'        End If
'        Set recTemp = Nothing
'    Case 22 '其它出库
'    End Select
'
'    '2）作废报警
'    strMsg = ""
'    Select Case intFormType
'    Case 11 '商品销售：已收款               -- 判断“原币付款金额”是否 <> 0
'        strSql = "SELECT Sum(ItemActivityDetail.dblCurrPaymentAmount) AS dblCurrPaymentAmountOfSum FROM ItemActivityDetail Where (((ItemActivityDetail.lngActivityID) = " & lngActivityID & ")) GROUP BY ItemActivityDetail.lngActivityID"
'        Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If recTemp.BOF And recTemp.EOF Then
'            Set recTemp = Nothing
'            cMsgBox "请刷新列表后再操作！"
'            Exit Sub
'        Else
'            If IsNull(recTemp(0)) Then
'                Set recTemp = Nothing
'                cMsgBox "请刷新列表后再操作！"
'                Exit Sub
'            Else
'                If recTemp(0) <> 0 Then
'                    strMsg = "已收款"
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 12 '直运销售
'    Case 13 '代销出库
'    Case 14 '代销结算
'    Case 15 '加工出库
'    Case 16 '分期出库
'    Case 17 '分期结算：已收款               -- 判断“原币付款金额”是否 <> 0
'        If recTemp.BOF And recTemp.EOF Then
'            Set recTemp = Nothing
'            cMsgBox "请刷新列表后再操作！"
'            Exit Sub
'        Else
'            If IsNull(recTemp(0)) Then
'                Set recTemp = Nothing
'                cMsgBox "请刷新列表后再操作！"
'                Exit Sub
'            Else
'                If recTemp(0) <> 0 Then
'                    strMsg = "已收款"
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 18 '销售发票
'    Case 19 '领用出库
'    Case 20 '成本调整
'    Case 21 '盘亏出库
'    Case 22 '其它出库
'    End Select
'
'    If strMsg <> "" Then
'        If ShowMsg(Me.hwnd, "要作废的" & strTypeName & "，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Sub
'    End If
    
    If Not mclsSales.DeleteSales(lngActivityID, True, , blnPushOut) Then Exit Sub
    If blnPushOut Then
        mclsMainControl_ChildActive
        Exit Sub
    End If
    With grdList
        If chkShowAll.Value = 1 Then
            If .TextMatrix(.Row, 1) = "" Then
                .TextMatrix(.Row, 1) = "√"
            End If
        Else
            .TextMatrix(.Row, 1) = "√"
            .RowHeight(.Row) = 0
            mclsList.SetFlexRow
            chkShowAll.Enabled = True
            frmMain.mnuEditShowAll.Enabled = True
        End If
    End With
    'UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If frmMain.mnuEditShowAll.Checked Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub
'栏目设置
Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With grdList
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            grdList.Cols = 0
            Set datGrid.Resultset = GetList()
            If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
            datGrid.Resultset.Close
            mclsList.SetFlexGrid
'            HideColOfMe Me
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtFind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub
'筛选
Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
   '执行过滤
    If mclsList.ListSet.ListID < 1 Then
        mclsList.ListSet.SaveList
        DefaultWhere intFormType, mclsList.ListSet.ListID
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    grdList.Redraw = False
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    grdList.Cols = 0
    Set datGrid.Resultset = GetList()
    If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
    datGrid.Resultset.Close
    mclsList.SetFlexGrid
'    HideColOfMe Me
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    grdList.Redraw = True
End Sub

'刷新