frmcalcdisc.frm

金算盘软件代码

    Dim lngItemID As Long
    Dim lngItemUnitID As Long
    Dim i As Long
    Dim dblFactor As Double
    Dim dblPriceTax As Double
    Dim dblPriceNoDisc As Double
    Dim dblQuantity As Double
    Dim dblTmp As Double
    
    If lngGetRowNo <= 0 Then
        Exit Sub
    End If
    lngRowno = GrdCol.Rows
    GrdCol.Rows = lngRowno + 1
    ReDim Preserve RowData(lngRowno)
    GrdCol.RowData(lngRowno) = lngRowno
    
    GrdCol.TextMatrix(lngRowno, 0) = strDate
    GrdCol.TextMatrix(lngRowno, 3) = Format(dblDiscountRate, "0.00")
    
    If blnByOrder Then
        GrdCol.TextMatrix(lngRowno, 5) = frmName.GrdCol.TextMatrix(lngGetRowNo, 1)
        lngItemID = C2lng(frmName.GrdCol.TextMatrix(lngGetRowNo, 24))
        lngItemUnitID = C2lng(frmName.GrdCol.TextMatrix(lngGetRowNo, 25))
    Else
        GrdCol.TextMatrix(lngRowno, 5) = frmName.TextOfGrid(lngGetRowNo, 1)
        lngItemID = C2lng(frmName.TextOfGrid(lngGetRowNo, 28))
        lngItemUnitID = C2lng(frmName.TextOfGrid(lngGetRowNo, 31))
    End If
    dblFactor = ConvertFactor(lngItemUnitID, lngItemID)
    strSQL = "SELECT dblSalePrice1,dblNoDiscAmount1 FROM Item WHERE lngItemID=" & lngItemID
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        recTmp.Close
        Set recTmp = Nothing
        Exit Sub
    End If
    dblPriceTax = recTmp(0)
    dblPriceNoDisc = recTmp(1)

    If blnByOrder Then
        GrdCol.TextMatrix(lngRowno, 6) = frmName.GrdCol.TextMatrix(lngGetRowNo, 2)
        GrdCol.TextMatrix(lngRowno, 7) = frmName.GrdCol.TextMatrix(lngGetRowNo, 3)
    Else
        GrdCol.TextMatrix(lngRowno, 6) = frmName.TextOfGrid(lngGetRowNo, 4)
        GrdCol.TextMatrix(lngRowno, 7) = frmName.TextOfGrid(lngGetRowNo, 5)
    End If
    dblQuantity = C2Dbl(NumberConvert(GrdCol.TextMatrix(lngRowno, 7), dblFactor))
    
    GrdCol.TextMatrix(lngRowno, 8) = Format(dblPriceNoDisc * dblQuantity, strCurrDec)
    
    dblTmp = dblPriceTax * dblQuantity
    If dblPriceTax <> 0 Then
        If blnByOrder Then
            dblTmp = 1 - CalcDiscountRate(C2lng(frmName.lblHead(0).Tag), lngItemID, frmName.lblField(3).Caption, frmName.getFieldID(9), dblTmp, dblQuantity, 13, True)
        Else
            dblTmp = 1 - CalcDiscountRate(C2lng(frmName.lblHead(0).Tag), lngItemID, frmName.lblField(2).Caption, frmName.getFieldID(7), dblTmp, dblQuantity, 13, True)
        End If
    Else
        dblTmp = 1
    End If
    '应折扣金额
    dblTmp = dblPriceTax * dblQuantity * dblTmp - C2Dbl(GrdCol.TextMatrix(lngRowno, 8))
    
    GrdCol.TextMatrix(lngRowno, 9) = Format(dblTmp, strCurrDec)
    
    RowData(lngRowno).lngRowno = lngGetRowNo
    RowData(lngRowno).lngID = lngActivityDetailID
    RowData(lngRowno).lngTableID = lngTableID
    RowData(lngRowno).dblPayAmount = dblUsedAmount
    GrdCol.TextMatrix(lngRowno, 11) = Format(dblUsedAmount, strCurrDec)
    If blnByOrder Then
        GrdCol.TextMatrix(lngRowno, 12) = frmName.GrdCol.TextMatrix(lngGetRowNo, 5)
    Else
        GrdCol.TextMatrix(lngRowno, 12) = frmName.TextOfGrid(lngGetRowNo, 7)
    End If
    
    '计算以上行已付应折扣金额
    dblTmp = 0
    For i = 1 To GrdCol.Rows - 2
        If RowData(i).lngRowno = lngGetRowNo Then
            If blnDiscMethod Then
                If RowData(i).dblPayAmount > C2Dbl(GrdCol.TextMatrix(i, 9)) * C2Dbl(GrdCol.TextMatrix(i, 3)) / 100 Then
                    dblTmp = dblTmp + C2Dbl(GrdCol.TextMatrix(i, 9))
                Else
                    dblTmp = dblTmp + RowData(i).dblPayAmount * 100 / C2Dbl(GrdCol.TextMatrix(i, 3))
                End If
            Else
                If RowData(i).dblPayAmount > C2Dbl(GrdCol.TextMatrix(i, 9)) / (2 - (C2Dbl(GrdCol.TextMatrix(i, 3)) / 100)) Then
                    dblTmp = dblTmp + C2Dbl(GrdCol.TextMatrix(i, 9))
                Else
                    dblTmp = dblTmp + RowData(i).dblPayAmount * (2 - (C2Dbl(GrdCol.TextMatrix(i, 3)) / 100))
                End If
            End If
        End If
    Next
        
    If dblTmp >= C2Dbl(GrdCol.TextMatrix(lngRowno, 9)) Then
        dblTmp = 0
    Else
        dblTmp = C2Dbl(GrdCol.TextMatrix(lngRowno, 9)) - dblTmp
    End If
    GrdCol.TextMatrix(lngRowno, 9) = Format(dblTmp, strCurrDec)
    
    Select Case lngTableID
    Case 0
        If gclsBase.ControlAccount Then
            strSQL = "SELECT ReceiptType.strReceiptTypeName||'期初',dblCurrAmount,dblCurrPaymentAmount " _
                & "FROM ARAPInit,ReceiptType WHERE ARAPInit.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+) " _
                & "AND lngARAPInitID=" & lngActivityDetailID
        Else
            strSQL = "SELECT strVoucherTypeCode||' '||strVoucherTypeName||'期初',dblCurrAmount,dblCurrPaymentAmount " _
                & "FROM ARAPInit1,VoucherType WHERE ARAPInit1.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+) " _
                & "AND lngARAPInitID=" & lngActivityDetailID
        End If
    Case 1
        strSQL = "SELECT Decode(Activity.lngActivityTypeID*Activity.blnIsSpecial,39,'采购',40,'销售',' ')||ActivityType.strActivityTypeName,dblCurrAmount,dblCurrPaymentAmount " _
            & "FROM ActivityDetail,Activity,ActivityType WHERE ActivityDetail.lngActivityID=Activity.lngActivityID " _
            & "AND Activity.lngActivityTypeID=ActivityType.lngActivityTypeID(+) " _
            & "AND lngActivityDetailID=" & lngActivityDetailID
            
    Case 2
        strSQL = "SELECT ReceiptType.strReceiptTypeName||'退货',dblCurrAmount,dblCurrPaymentAmount " _
            & "FROM ItemActivityDetail,ItemActivity,ReceiptType WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
            & "AND ItemActivity.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+) " _
            & "AND lngActivityDetailID=" & lngActivityDetailID
    Case 3
        strSQL = "SELECT strVoucherTypeCode||' '||strVoucherTypeName,dblCurrencyAmount,dblCurrPaymentAmount " _
            & "FROM VoucherDetail,Voucher,VoucherType WHERE VoucherDetail.lngVoucherID=Voucher.lngVoucherID " _
            & "AND Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+) " _
            & "AND lngVoucherDetailID=" & lngActivityDetailID
    End Select
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If Not (recTmp.BOF And recTmp.EOF) Then
        GrdCol.TextMatrix(lngRowno, 1) = recTmp(0)
        GrdCol.TextMatrix(lngRowno, 2) = Format(recTmp(1), strCurrDec)
'        grdCol.TextMatrix(lngRowno, 4) = Format(recTmp(1) - recTmp(2)+dblsavedamount, strCurrDec)

      dblTmp = 0
      For i = DiscInfos.Count To 1 Step -7
         If DiscInfos.Item(i - 6) > 0 Then
            dblTmp = dblTmp + DiscInfos.Item(i - 2)
         End If
      Next
      For i = 1 To (lngRowno - 1) * 7 Step 7
         If DiscInfos.Item(i) > 0 Then
            If DiscInfos.Item(i + 1) = lngTableID And DiscInfos.Item(i + 2) = lngActivityDetailID Then
                dblTmp = dblTmp - DiscInfos.Item(i + 3)
            End If
         End If
      Next
      GrdCol.TextMatrix(lngRowno, 4) = Format(recTmp(1) - recTmp(2) + dblTmp, strCurrDec)
      dblTmp = 0
    End If
    
    dblTmp = C2Dbl(GrdCol.TextMatrix(lngRowno, 9))
    If blnDiscMethod Then
        If dblTmp > C2Dbl(GrdCol.TextMatrix(lngRowno, 4)) * 100 / dblDiscountRate Then
            dblTmp = C2Dbl(GrdCol.TextMatrix(lngRowno, 4)) * 100 / dblDiscountRate
        End If
    Else
        If dblTmp > C2Dbl(GrdCol.TextMatrix(lngRowno, 4)) * (2 - dblDiscountRate / 100) Then
            dblTmp = C2Dbl(GrdCol.TextMatrix(lngRowno, 4)) * (2 - dblDiscountRate / 100)
        End If
    End If
    If dblTmp <> 0 Then
        If blnDiscMethod Then
            GrdCol.TextMatrix(lngRowno, 10) = Format(dblTmp * (1 - dblDiscountRate / 100), strCurrDec)
        Else
            GrdCol.TextMatrix(lngRowno, 10) = Format(dblTmp * (1 - dblDiscountRate / 100) / (2 - dblDiscountRate / 100), strCurrDec)
        End If
    Else
        GrdCol.TextMatrix(lngRowno, 10) = Format(0, strCurrDec)
    End If
    GrdCol.TextMatrix(lngRowno, 13) = Format(C2Dbl(GrdCol.TextMatrix(lngRowno, 4)) - RowData(lngRowno).dblPayAmount, strCurrDec)
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                GrdCol.Row = 0
                GrdCol.col = i
                GrdCol.ColSel = i
                If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                    If InStr(GrdCol.TextMatrix(0, i), "额") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "价") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                        Next
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = strColName(i) & "↓"
                        GrdCol.Sort = flexSortNumericDescending
                        
                    Else
                        GrdCol.TextMatrix(0, i) = strColName(i) & "↑"
                        GrdCol.Sort = flexSortNumericAscending

                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                        Next
                    ElseIf InStr(GrdCol.TextMatrix(0, i), "价") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), FormatString(gclsBase.PriceDec))
                        Next
                    End If
                Else
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = strColName(i) & "↓"
                        GrdCol.Sort = flexSortStringNoCaseDescending
                    Else
                        GrdCol.TextMatrix(0, i) = strColName(i) & "↑"
                        GrdCol.Sort = 5
                    End If
                End If
                GrdCol.Row = 1
            Else
                GrdCol.TextMatrix(0, i) = strColName(i)
            End If
        Next
    Else
'        If grdCol.Row >= grdCol.FixedRows Then
'            If grdCol.TextMatrix(grdCol.Row, 0) = "" Then
'                grdCol.TextMatrix(grdCol.Row, 0) = "√"
'            Else
'                grdCol.TextMatrix(grdCol.Row, 0) = ""
'            End If
'        End If
    End If
End Sub

Private Function dblTotalUsable() As Double
'    Dim strSQL As String
'    Dim recTmp As rdoResultset
'    Dim lngAccountID As Long
'
'    If blnByOrder Then
'        strSQL = "SELECT lngARAccountID FROM Customer WHERE lngCustomerID=" & lngCustomerID
'        Set recTmp = gclsBase.BaseDB.openResultset(strSQL, rdOpenForwardOnly)
'        If recTmp.BOF And recTmp.EOF Then
'            recTmp.Close
'            Set recTmp = Nothing
'            Exit Function
'        End If
'        lngAccountID = recTmp(0)
'        recTmp.Close
'    Else
'        lngAccountID = frmName.getFieldID(5)
'    End If
'
'    Set recTmp = Nothing
End Function