frmsettleinvoice.frm

金算盘软件代码

            mblnIsExpense = False
        Else
            mblnIsExpense = True
        End If
    End If
    recDetail.Close
    
    strSql = "SELECT lngCustomerID,lngCurrencyID,lngActivityTypeID,lngVoucherID FROM ItemActivity WHERE lngActivityID=" & lngActivityID
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDetail.EOF Then
        mlngCustomerID = recDetail!lngCustomerID
        mlngCurrencyID = recDetail!lngCurrencyID
        mlngActivityTypeID = recDetail!lngActivityTypeID
        mlngVoucherID = recDetail!lngVoucherID
    Else
        mlngDetailID = 0
    End If
    recDetail.Close
    Set recDetail = Nothing
    
    If mlngDetailID > 0 Then
        lblNote(1).Caption = CustomerName(mlngCustomerID)
        lblNote(3).Caption = CurrencyName(mlngCurrencyID)
        lblNote(5).Caption = ItemName(mlngItemID)
        mintCurrencyDec = CurrencyDec(mlngCurrencyID)
        If mintCurrencyDec > 0 Then
            mstrCurrFormat = "0." & String(mintCurrencyDec, "0")
        Else
            mstrCurrFormat = "0"
        End If
        strSql = "SELECT * FROM ItemUnit WHERE lngUnitID=" & lngUnitID
        Set recUnit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recUnit.EOF Then
            mdblFactor = recUnit!dblFactor
            mstrUnitName = recUnit!strUnitName
'            lblNote(7).Caption = MinToNormalQty(mdblQuantity, recUnit!dblFactor) & recUnit!strUnitName
        End If
        recUnit.Close
        Set recUnit = Nothing
        lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount, mstrCurrFormat)
        chkClose.Value = IIf(blnClose, 1, 0)
        chkClose.Enabled = (mlngVoucherID = 0)
        Select Case mlngActivityTypeID
        Case atInPurchase
            mlngViewID = 1190
        Case atInDirectPurchase
            mlngViewID = 1190
        Case atInBorrowSettlement
            mlngViewID = 1190
        Case atOutSale
            mlngViewID = 1191
        Case atOutDirectSale
            mlngViewID = 1191
        Case atOutLendSettlement
            mlngViewID = 1191
        Case atOutStageSettlement
            mlngViewID = 1191
        Case Else
            mlngViewID = 1190
        End Select
        RefreshGrid
        Me.Show vbModal
    End If
    GivemeParameter = mblnOk
End Function

Private Sub cmdOK_Click(Index As Integer)
    Select Case Index
    Case 0                                    '确定存盘
        SaveData (1)
    Case 1                                    '取消
        Unload Me
    Case 2                                   '全部核销
        mnuCheckAll_Click
    Case 3
        mnuUndoCheck_Click                    '全部取消
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub lblNote_Change(Index As Integer)
    If Index = 9 Then
        If mdblAmount <> 0 Then
            lblNote(7).Caption = MinToNormalQty(C2Dbl(mdblQuantity * C2Dbl(lblNote(9).Caption)) / mdblAmount, mdblFactor, True) & "(" & mstrUnitName & ")"
        End If
        If C2Dbl(lblNote(9).Caption) = 0 Then
            chkClose.Value = 1
            If chkClose.Enabled Then
                chkClose.Enabled = False
            End If
        Else
            If Not chkClose.Enabled Then
                chkClose.Enabled = True
            End If
            If chkClose.Value = 1 Then
                chkClose.Value = 0
            End If
        End If
    End If
End Sub

'Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'    If KeyCode = 27 Then
'        If Not txtEdit.Visible Then
'            Cmdall_Click 1
'            KeyCode = 0
'        End If
'    End If
'End Sub

Private Sub mclsGrid_AfterRefresh(lngRow As Long)
    With msgGrid
        If mintFactorCol > 0 Then
            If mintUnChkQtyCol > 0 Then
                .TextMatrix(lngRow, mintUnChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastUnChkQtyCol), mdblFactor)
            End If
            If mintChkQtyCol > 0 Then
                .TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastChkQtyCol), mdblFactor)
            End If
            If mintTotalQtyCol > 0 Then
'                .TextMatrix(lngRow, mintTotalQtyCol) = MinToNormalQty(GetValue(lngRow, mintTotalQtyCol), mdblFactor)
            End If
        End If
    End With
End Sub

Private Sub mclsGrid_AfterSave()
    With msgGrid
         If mintChkAmtCol > 0 Then
            .TextMatrix(.Row, mintChkAmtCol) = strFormat(C2Dbl(.TextMatrix(.Row, mintChkAmtCol)), mintCurrencyDec)
        End If
    End With
End Sub

'响应完全核销菜单
Private Sub mnuCheckAll_Click()
    Dim lngRow As Long
        
    If mintChkAmtCol > 0 Then
        For lngRow = 1 To msgGrid.Rows - 1
'            If GetValue(lngRow, mintVoucherCol) <= 0 Then
                If msgGrid.TextMatrix(lngRow, 1) <> "√" And C2Dbl(lblNote(9).Caption) <> 0 Then
                    msgGrid.TextMatrix(lngRow, 1) = "√"
                    If Abs(C2Dbl(lblNote(9).Caption)) >= Abs(GetValue(lngRow, mintLastUnChkAmtCol)) Then
                        msgGrid.TextMatrix(lngRow, mintChkAmtCol) = msgGrid.TextMatrix(lngRow, mintUnChkAmtCol)
                        ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + GetValue(lngRow, mintUnChkAmtCol)
                        msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastUnChkQtyCol), mdblFactor)
                    Else
                        msgGrid.TextMatrix(lngRow, mintChkAmtCol) = C2Dbl(lblNote(9).Caption)
                        ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + C2Dbl(lblNote(9).Caption)
                        msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintTotalQtyCol) * GetValue(lngRow, mintChkAmtCol) / GetValue(lngRow, mintTotalAmtCol), mdblFactor)
                    End If
                End If
                lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount - C2Dbl(hlb(mintChkAmtCol).Caption), mstrCurrFormat)
'            End If
        Next lngRow
    End If
 End Sub

'响应完全取消菜单
Private Sub mnuUndoCheck_Click()
    Dim lngRow As Long
    
    If mintChkAmtCol > 0 And mintChkQtyCol > 0 Then
        For lngRow = 1 To msgGrid.Rows - 1
'            If GetValue(lngRow, mintVoucherCol) <= 0 Then
                If msgGrid.TextMatrix(lngRow, 1) = "√" Then
                    ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) - GetValue(lngRow, mintChkAmtCol)
                    msgGrid.TextMatrix(lngRow, 1) = ""
                    msgGrid.TextMatrix(lngRow, mintChkAmtCol) = ""
                    msgGrid.TextMatrix(lngRow, mintChkQtyCol) = ""
                End If
'            End If
        Next lngRow
        lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount - C2Dbl(hlb(mintChkAmtCol).Caption), mstrCurrFormat)
    End If
End Sub


'从对应视图取SQL语句并打开、初始化之
Private Function GetList() As rdoResultset
    Dim strSelect As String, strFrom As String, strWhere As String
    Dim strSql As String
    Dim QtoInvoice As String
    
'    On Error Resume Next
    
    If mlngViewID = 1190 Then
        QtoInvoice = "(SELECT lngInvoiceDetailID, dblQuantity, dblCurrAmount " _
            & "FROM PurchaseToInvoice " _
            & "WHERE lngReceiptDetailID=" & mlngDetailID & ")"
    Else
        QtoInvoice = "(SELECT lngInvoiceDetailID, dblQuantity, dblCurrAmount " _
            & "FROM SaleToInvoice " _
            & "WHERE lngReceiptDetailID=" & mlngDetailID & ")"
    End If
    
    With mclsGrid.ListSet
        strFrom = .FromOfSql
        If mlngViewID = 1190 Then
            strFrom = Replace(strFrom, "[QPURCHASETOINVOICE]", QtoInvoice)
        Else
            strFrom = Replace(strFrom, "[QSALETOINVOICE]", QtoInvoice)
        End If
        strSelect = .SelectOfSql
        strWhere = .WhereOfSql
    End With
    
    
    strWhere = " WHERE " & strWhere & " AND ItemActivity.lngCustomerID=" & mlngCustomerID _
        & " AND ItemActivity.lngActivityTypeID=" & IIf(mlngViewID = 1190, atInPurchaseInvoice, atOutSaleInvoice) _
        & " AND ItemActivity.lngCurrencyID=" & mlngCurrencyID _
        & " AND ItemActivityDetail.lngItemID=" & mlngItemID _
        & " AND (blnIsVoid=0) AND (ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount)<>0 " _
        & " AND (NVL(ToInvoice.lngInvoiceDetailID,0)>0 OR (ItemActivityDetail.dblQuantity<>ItemActivityDetail.dblInvoiceQuantity " _
        & "OR (ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount)<>ItemActivityDetail.dblCurrInvoiceAmount))"

    strSelect = "SELECT ItemActivityDetail.lngActivityDetailID As ID," _
        & "DECODE(NVL(ToInvoice.lngInvoiceDetailID,0),0,'','√') As 选择," _
        & "DECODE(NVL(ToInvoice.dblCurrAmount,0),0,0,ToInvoice.dblCurrAmount) AS 原核销金额," _
        & "DECODE(NVL(ToInvoice.dblQuantity,0),0,0,ToInvoice.dblQuantity) AS 原核销数量, " _
        & "ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount-ItemActivityDetail.dblCurrInvoiceAmount" _
        & "+DECODE(NVL(ToInvoice.dblCurrAmount,0),0,0,ToInvoice.dblCurrAmount) AS 原未核销金额," _
        & "ItemActivityDetail.dblQuantity-ItemActivityDetail.dblInvoiceQuantity+DECODE(NVL(ToInvoice.dblQuantity,0),0,0,ToInvoice.dblQuantity) AS 原未核销数量, " _
        & "ItemActivityDetail.dblQuantity As 总数量," _
        & "ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount As 总金额," _
        & "dblFactor As 原换算因子,ItemActivity.lngVoucherID," _
        & strSelect

    strSql = strSelect & " " & strFrom & " " & strWhere
    Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function

'初始化各text框中数据
Private Sub ShowTotalRow()
    Dim dblUnChkAmount As Double
    Dim dblChkAmount As Double
    Dim dblAmount As Double
    Dim lngRow As Long
    
    On Error Resume Next
    
    dblUnChkAmount = 0
    dblChkAmount = 0
    
    For lngRow = 1 To msgGrid.Rows - 1
        dblAmount = GetValue(lngRow, mintChkAmtCol)
        If mlngVoucherID = 0 Or dblAmount <> 0 Then
            dblUnChkAmount = dblUnChkAmount + GetValue(lngRow, mintUnChkAmtCol)
            dblChkAmount = dblChkAmount + dblAmount
        Else
            msgGrid.RowHeight(lngRow) = 0
        End If
    Next lngRow
    
    mdblInvoiceAmount = mdblInvoiceAmount - dblChkAmount
    hlb(mintUnChkAmtCol).Caption = strFormat(dblUnChkAmount, mintCurrencyDec)
    hlb(mintChkAmtCol).Caption = strFormat(dblChkAmount, mintCurrencyDec)
    lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount - dblChkAmount, mstrCurrFormat)
End Sub

'核销内容筛选
Private Sub FilterData()
    Dim lngRow As Long
    Dim blnOK As Boolean
    
    If mblnModify Then
        If ShowMsg(Me.hWnd, "筛选操作后，你刚刚做的核销将被取消，需要先存盘吗?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "发票核销") = IDYES Then
            If Not SaveData(0) Then Exit Sub
        End If
    End If
    If mclsGrid.ListSet.ListID < 1 Then
       mclsGrid.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1, , , , , blnOK
    If blnOK Then
        RefreshGrid
    End If
End Sub

'存盘
'入参 ： kkk=0是存盘不关闭窗体，kkk=1是存盘关闭窗体
'功能 ： 响应存盘操作
Private Function SaveData(intQuit As Integer) As Boolean
    Dim strSql As String
    Dim lngRow As Long
    Dim dblQuantity As Double
    Dim dblSumQuantity As Double
    Dim dblAmount As Double
    Dim blnSucceed As Boolean
    Dim lngVoucherID  As Long
    
    If C2Dbl(lblNote(9).Caption) * mdblAmount < 0 Then
        If mdblAmount > 0 Then
            ShowMsg hWnd, "核销金额不能大于单据核销前的未开票金额：" & Format(mdblAmount - mdblInvoiceAmount, mstrCurrFormat), vbOKOnly + vbExclamation, Caption
        Else
            ShowMsg hWnd, "核销金额的绝对值不能大于单据核销前的未开票金额的绝对值：" & Format(mdblAmount - mdblInvoiceAmount, mstrCurrFormat), vbOKOnly + vbExclamation, Caption
        End If
        Exit Function
    End If
    
    On Error GoTo Err
    gclsBase.BaseWorkSpace.BeginTrans

    For lngRow = 1 To msgGrid.Rows - 1
        If (GetValue(lngRow, mintLastChkAmtCol) <> GetValue(lngRow, mintChkAmtCol) Or GetValue(lngRow, mintLastChkQtyCol) <> GetValue(lngRow, mintChkQtyCol)) Then     '前后有否变化
            dblQuantity = NormalToMinQty(GetValue(lngRow, mintChkQtyCol), mdblFactor)
            dblSumQuantity = dblSumQuantity + dblQuantity
            dblAmount = GetValue(lngRow, mintChkAmtCol)
            
            If mlngViewID = 1191 Or mblnIsExpense Then
                lngVoucherID = GetValue(lngRow, mintVoucherCol)
            Else
                lngVoucherID = 0
            End If
            If mblnIsExpense And lngVoucherID = 0 Then
                lngVoucherID = mlngVoucherID
            End If
            
            '新增情况
            If (GetValue(lngRow, mintLastChkAmtCol) = 0 And GetValue(lngRow, mintLastChkQtyCol) = 0) And (dblAmount <> 0 Or dblQuantity <> 0) Then
                strSql = "INSERT INTO " & IIf(mlngViewID = 1190, "PurchaseToInvoice", "SaleToInvoice") _
                    & " (lngReceiptDetailID,lngInvoiceDetailID,dblQuantity,dblCurrAmount,lngVoucherID) " _
                    & " Values(" & mlngDetailID & "," & GetValue(lngRow, 0) & "," & dblQuantity & "," _
                    & dblAmount & "," & lngVoucherID & ")"
            Else
                strSql = "UPDATE " & IIf(mlngViewID = 1190, "PurchaseToInvoice", "SaleToInvoice") _
                    & " SET dblQuantity=" & dblQuantity & ",dblCurrAmount =" & dblAmount _
                    & ",lngVoucherID=" & lngVoucherID _
                    & " WHERE lngInvoiceDetailID =" & GetValue(lngRow, 0) & " And lngReceiptDetailID =" & mlngDetailID & ""
            End If
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
            strSql = "UPDATE ItemActivityDetail SET dblInvoiceQuantity=dblInvoiceQuantity + " & dblQuantity & "-" & GetValue(lngRow, mintLastChkQtyCol) & ", " _
                & "dblCurrInvoiceAmount = dblCurrInvoiceAmount + " & dblAmount & "-" & GetValue(lngRow, mintLastChkAmtCol) _
                & " WHERE lngActivityDetailID=" & GetValue(lngRow, 0) & ""