clslistpurchase.cls

金算盘软件代码

    '从Grid中删除本行
    mfrmPurchase.ToolRefresh
End Sub

Private Sub mfrmPurchase_ListEdite()
    Dim lngActivityID As Long
    Dim lngActivityTypeID As Long
    mfrmPurchase.Enabled = False
    lngActivityID = mfrmPurchase.ListID
    
    mblnFinish = True
    If intFormType = 7 Then
        lngActivityTypeID = GetlngActivityTypeID(lngActivityID)
        Set frmEdit = Nothing
        If frmStockSales(lngActivityTypeID + 1) Is Nothing Then
            Set frmEdit = New FrmStockBill
        Else
            Set frmEdit = frmStockSales(lngActivityTypeID + 1)
        End If
    End If
    If intFormType <> 7 Then
        frmEdit.ShowAOldBill lngActivityID, , intFormType + 1  '调用接口
    Else
        frmEdit.ShowAOldBill lngActivityID, , lngActivityTypeID + 1  '调用接口
    End If
    mblnFinish = False
    mfrmPurchase.Enabled = True
End Sub

Private Sub mfrmPurchase_oListInActive()
    Dim lngActivityID As Long
    Dim blnPushOut As Boolean
    
    Dim strMsg As String
On Error GoTo TheErr
    
    lngActivityID = mfrmPurchase.ListID
    If lngActivityID = 0 Then Exit Sub
    If mfrmPurchase.IsInActive Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    If ShowMsg(mfrmPurchase.hwnd, "本张" & strTypeName & "作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Sub
    If Not mclsPurchase.DeletePurchase(lngActivityID, True, , blnPushOut) Then Exit Sub
    If blnPushOut Then
        mfrmPurchase.ToolRefresh
        Exit Sub
    End If
    mfrmPurchase.ToolRefresh
    Exit Sub
TheErr:
End Sub

Private Sub mfrmPurchase_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim lngActivityID As Long
    Dim blnPushOut As Boolean
    
    Dim strMsg As String
On Error GoTo TheErr
    blnLevel = True
    blnSuceess = False
    lngActivityID = mfrmPurchase.ListID
    If lngActivityID = 0 Then Exit Sub
    If mfrmPurchase.IsInActive Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    If ShowMsg(mfrmPurchase.hwnd, "本张" & strTypeName & "作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Sub
    If Not mclsPurchase.DeletePurchase(lngActivityID, True, , blnPushOut) Then Exit Sub
    If blnPushOut Then
        mfrmPurchase.ToolRefresh
        Exit Sub
    End If
    mfrmPurchase.ToolRefresh
    blnSuceess = True
    Exit Sub
TheErr:
End Sub

Private Sub mfrmPurchase_ListNew()
    mblnFinish = True
    If intFormType = 7 Then
        Set frmEdit = Nothing
        If frmStockSales(intFormType + 1) Is Nothing Then
            Set frmEdit = New FrmStockBill
        Else
            Set frmEdit = frmStockSales(intFormType + 1)
        End If
    End If
    frmEdit.ShowANewTypeBill intFormType + 1
    mblnFinish = False
End Sub

Private Sub mfrmPurchase_ListPrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt intFormType
End Sub

Private Sub mfrmPurchase_ListReorpt(ByVal Index As Integer)
    Select Case Index
        Case 0:
            Select Case intFormType
                Case 1      '商品采购
                    #If conVersionType = 16 Then
                         Report.ShowSumReport 1458, 670 '商品采购汇总表
                    #Else
                        Report.ShowSumReport 1568, 694
                    #End If
                Case 2      '直运采购
                    Report.ShowSumReport 1585, 710       '直运采购汇总表
                Case 3      '受托入库
                    Report.ShowSumReport 1576, 702      '受托代销商品汇总表
                Case 4      '受托结算
                    Report.ShowSumReport 1578, 704      '受托结算商品汇总表
                Case 5      '加工入库
                    Report.ShowSumReport 1555, 750      '加工入库商品汇总表
                Case 6      '加工费用
                    Report.ShowSumReport 1557, 691      '加工费用商品汇总表
                Case 7      '采购发票
                    Report.ShowStandardReport 1586, 711      '采购发票一览表
                Case 8      '自制入库
                    Report.ShowSumReport 1320, 762        '自制入库商品汇总表
                Case 9      '盘盈入库
                   ' Report.ShowSumReport 1323, 581      '商品盘盈汇总表
                Case 10     '其它入库
                    'Report.ShowSumReport 1631, 568      '其它入库商品汇总表
            End Select
        Case 1:
            Select Case intFormType
                Case 1      '商品采购
                    #If conVersionType = 16 Then
                        Report.ShowStandardReport 1460, 668
                    #Else
                         Report.ShowStandardReport 1567, 693      '单位采购汇总表
                    #End If
                Case 2      '直运采购
                    Report.ShowStandardReport 1584, 709      '直运采购明细表
                Case 3      '受托入库
                    Report.ShowStandardReport 1575, 701      '受托代销单位汇总表
                Case 4      '受托结算
                    Report.ShowStandardReport 1577, 703      '受托代销单位汇总表
                Case 5      '加工入库
                    Report.ShowStandardReport 1556, 749      '加工入库单位汇总表
                Case 6      '加工费用
                    Report.ShowStandardReport 1558, 689      '加工费用单位汇总表
                Case 7                                       '采购发票汇总表
                    Report.ShowSumReport 1588, 713
                Case 8      '自制入库
                    Report.ShowStandardReport 1302, 761       '自制入库商品明细表
                Case 9      '盘盈入库
                   ' Report.ShowStandardReport 1304, 569      '商品盘盈明细表
                Case 10     '其它入库
                    'Report.ShowStandardReport 1629, 580      '其它入库商品明细表
            End Select
        Case 2
            Select Case intFormType
                Case 7                                           '采购发票明细表
                     Report.ShowStandardReport 1587, 712
            End Select
    End Select
End Sub

Private Sub mfrmPurchase_ListShowAll()
    With mfrmPurchase
        If .chkShowALL = 0 Then
            .ShowAll(0) = "ItemActivity.blnIsVoid=0"
        Else
            .ShowAll(0) = ""
        End If
       ' .ToolRefresh
    End With
End Sub

Private Function ListIsInActive(ByVal intTab As Integer, ByVal lngID As Long, strCode As String) As Boolean
    Dim recTmp As rdoResultset
    Dim strSQL As String
    Select Case intTab
        Case 1
            strSQL = "Select blnIsInActive,strCurrencysCode  from Currencys Where lngCurrencyID=" & lngID
        Case 2
            strSQL = "Select blnIsInActive,strVoucherTypeCode  from VoucherType Where lngVoucherTypeID=" & lngID
        Case 3
            strSQL = "Select blnIsInActive,strPaymentMethodCode  from PaymentMethod Where lngPaymentMethodID=" & lngID
        Case 4
            strSQL = "Select blnIsInActive,strTermCode  from Term Where lngTermID=" & lngID
    End Select
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If Not recTmp.EOF Then
        ListIsInActive = IIf(recTmp!blnIsInActive = 1, True, False)
        strCode = recTmp!strAccountCode
    End If
End Function

Private Sub mfrmPurchase_ListUserMenu(ByVal Index As Integer)
    If mfrmPurchase.blnIsReceptionWriteoff Then
        If Index = 4 Then
            Dim lngTypeID As Long
            lngTypeID = frmWriteOffBill.WriteOffBill(intFormType + 1, mfrmPurchase.ListID, mfrmPurchase.hwnd)
            If lngTypeID > 0 Then ShowBill1 intFormType + 1, lngTypeID, True
        End If
    End If
End Sub

Private Function GetlngActivityTypeID(lngActivityID As Long) As Long
    Dim strSQL As String
    Dim recTemplete As rdoResultset
    strSQL = "SELECT lngActivityTypeID From ItemActivity where lngActivityID=" & lngActivityID
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTemplete.RowCount > 0 Then GetlngActivityTypeID = recTemplete!lngActivityTypeID
End Function
Private Function GetItemStatus(lngActivityID As Long) As Boolean
    Dim strSQL  As String
    Dim recTemp As rdoResultset
    strSQL = "SELECT ItemActivity.lngVoucherID, ItemActivity.lngOperatorID, ItemActivity.blnIsInvoice From ItemActivity" _
            & " WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "请刷新列表后再执行！"
        Exit Function
    End If
       
'    '1
'    If recTemp(0) > 0 Then
'        blnIsVouchered = True
'    Else
'        blnIsVouchered = False
'    End If
    '2
    If gclsBase.OperatorID = recTemp(1) Then
        blnChange = True
    Else
        blnChange = False
    End If
    '3
    blnIsInvoice = IIf(recTemp(2) = 1, True, False)
    
    Set recTemp = Nothing
    GetItemStatus = True
End Function

'Private Function blnIsPurch(ByVal lngActivityID As Long) As Long
'    Dim recTmp As rdoResultset
'    Dim strSQL As String
'
'    strSQL = "Select lngReceiptTypeID from itemactivity where lngActivityID=" & lngActivityID
'    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
'    If Not (recTmp.EOF And recTmp.BOF) Then
'        blnIsPurch
'    End If
'End Function