frmlistpurchase.frm

金算盘软件代码

    Case 1: '新增
        mclsMainControl_EditNew
    Case 2: '删除
        mclsMainControl_EditDel
    Case 4
       ' frmEdit.ShowAOldBill intFormType + 1
       Dim lngTypeID As Long
       lngTypeID = frmWriteOffBill.WriteOffBill(intFormType + 1, GetlngActivityID, Me.hwnd)
       If lngTypeID > 0 Then ShowBill1 intFormType + 1, 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 + 1) > 0 Then
'        BringWindowToTop lngFormHwnd(intFormType + 1)
'    Else
        mblnFinish = True
        frmEdit.ShowAOldBill (lngActivityID)  '调用接口
'    End If
        mblnFinish = False
    Me.Enabled = True
End Sub

'新增
Private Sub mclsMainControl_EditNew()
    
'    If lngFormHwnd(intFormType + 1) > 0 Then
'        BringWindowToTop lngFormHwnd(intFormType + 1)
'    Else
        Me.Enabled = False
        mblnFinish = True
        frmEdit.ShowANewTypeBill intFormType + 1
        mblnFinish = False
        Me.Enabled = True
'    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 + 1) > 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 mclsPurchase.DeletePurchase(lngActivityID, , , blnPushOut) Then Exit Sub
        If blnIsInvoice Then
            If intFormType = 7 And lngActivityTypeID <> 7 Then '在采购发票列表中
                 'Select Case lngActivityTypeID
                     'Case 1
                     gclsSys.SendMessage CStr(Me.hwnd), 31 + lngActivityTypeID
                        
                     'Case 2
                 'End Select
             ElseIf intFormType = 1 Or intFormType = 2 Or intFormType = 4 _
                      Or intFormType = 7 Then '在其他单据中并且也是一张发票
                 gclsSys.SendMessage CStr(Me.hwnd), 38
             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
    
End Sub

'作废
Private Sub mclsMainControl_EditInActive()
    Dim lngActivityID As Long
    Dim strSql As String
    Dim blnPushOut As Boolean
    Dim recTemp As rdoResultset
    Dim strMsg As String
On Error GoTo TheErr
    
    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 1 '商品采购单：已开票
''    Case 2 '直运采购单：已销售、已开票
''        strSql = "SELECT PurchaseToSale.lngPurchaseActivityDetailID FROM PurchaseToSale INNER JOIN ItemActivityDetail ON PurchaseToSale.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID WHERE (((ItemActivityDetail.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 3 '受托入库单：已结算
''        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 4 '受托结算单：已开票
'    Case 5 '加工入库单
'    Case 6 '加工费用单：已开票
'    Case 7 '采购发票
'    Case 8 '自制入库单
''    Case 9 '盘盈入库单：非手工添制
''        '算法：本张盘盈入库单非手工添制 则在 StockTakingToReceipt 有对应记录
''        strSql = "SELECT StockTakingToReceipt.lngStockTakingID FROM StockTakingToReceipt WHERE (((StockTakingToReceipt.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 10 '其他入库单
'    End Select
'
'    '2）作废报警
'    strMsg = ""
'    Select Case intFormType
'    Case 1 '商品采购单：已分摊费用、已付款 -- 判断“本币采购费用”是否 <> 0, “原币付款金额”是否 <> 0
'        strSql = "SELECT Sum(ItemActivityDetail.dblExpenseAmount) AS dblExpenseAmountOfSum, 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
'        Else
'            If IsNull(recTemp(0)) Then
'
'            Else
'                If recTemp(0) <> 0 Then
'                    strMsg = "已分摊费用"
'                End If
'                If recTemp(1) <> 0 Then
'                    If strMsg = "" Then
'                        strMsg = "已付款"
'                    Else
'                        strMsg = strMsg & "并且已付款"
'                    End If
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 2 '直运采购单
'    Case 3 '受托入库单
''    Case 4 '受托结算单：已付款               -- 判断“原币付款金额”是否 <> 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 5 '加工入库单：已分摊费用         -- 判断“本币加工金额”是否 <> 0
'        strSql = "SELECT Sum(ItemActivityDetail.dblEntrustAmount) AS dblEntrustAmountOfSum 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 6 '加工费用单：已分摊费用、已付款 -- 判断“本币加工金额”是否 <> 0, “原币付款金额”是否 <> 0
'        strSql = "SELECT Sum(ItemActivityDetail.dblEntrustAmount) AS dblEntrustAmountOfSum, 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
'        Else
'            If IsNull(recTemp(0)) Then
'
'            Else
'                If recTemp(0) <> 0 Then
'                    strMsg = "已分摊费用"
'                End If
'                If recTemp(1) <> 0 Then
'                    If strMsg = "" Then
'                        strMsg = "已付款"
'                    Else
'                        strMsg = strMsg & "并且已付款"
'                    End If
'                End If
'            End If
'        End If
'        Set recTemp = Nothing
'    Case 7 '采购发票
'    Case 8 '自制入库单
'    Case 9 '盘盈入库单
'    Case 10 '其他入库单
'    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 mclsPurchase.DeletePurchase(lngActivityID, True, , blnPushOut) Then Exit Sub
    If blnPushOut Then
        mclsMainControl_ChildActive
        Exit Sub
    End If
    With grdList
        If chkShowAll.Value = 1 Then
            .TextMatrix(.Row, 1) = "√"
        Else
            .TextMatrix(.Row, 1) = "√"
            .RowHeight(.Row) = 0
            mclsList.SetFlexRow
            chkShowAll.Enabled = True
            frmMain.mnuEditShowAll.Enabled = True
        End If
    End With
    
    'UpdateMenuStatus
    Exit Sub
TheErr:
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