frmcalcdiscdetail.frm

金算盘软件代码

    End If
    dblPriceTax = recTmp(0) / dblRate
    dblPriceNoDisc = recTmp(1) / dblRate
    recTmp.Close
    
    strSql = "SELECT dblDiscountRate FROM ItemPayDiscDetail,ItemPayDiscDate WHERE ItemPayDiscDetail.lngItemPayDiscID=ItemPayDiscDate.lngItemPayDiscID " _
        & "AND lngItemID=" & lngItemID & " AND strStartDate<='" & strDate & "' AND strEndDate>='" & strDate & "'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        dblNowDiscRate = 1
    Else
        dblNowDiscRate = recTmp(0) / 100
    End If
    recTmp.Close
    Set recTmp = Nothing
    
    dblPriceNoDisc = dblPriceNoDisc * dblRate
    dblCurrAmount = dblPriceTax * dblQuantity
    mlngCurrDec = CurrencyDec(lngCurrencyID)
    strCurrDec = FormatString(mlngCurrDec)
    calPrice.Digits = i
    strPriceDec = FormatString(gclsBase.PriceDec)
    GetDiscOrder bytOrder(), 13
    
    On Error Resume Next
    Me.Show vbModal
    ShowMe = blnSucceed
'    If blnSucceed Then
'        Set DiscInfosTmp = DiscInfos
'    End If
End Function

Private Sub calPrice_LostFocus()
'    calPrice_Validate False
End Sub

Private Sub ChkAdjust_Click()
   If ChkAdjust.Value = 0 Then
      reCalculate
      calPrice.Enable = 0
      Label1.Enabled = True
      OptReturn(0).Enabled = True
      OptReturn(1).Enabled = True
   Else
      calPrice.Enable = 1
      Label1.Enabled = False
      OptReturn(0).Enabled = False
      OptReturn(1).Enabled = False
      GrdCol.MousePointer = flexDefault
      Dim blnTmp As Boolean
      calPrice_Validate blnTmp
   End If
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    Dim i As Long
    Select Case Index
    Case 0
        GetLngColNO
        
        blnSucceed = True
        RemoveADiscInfo DiscInfos, lngRowno
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" And dblRowData(i, 2) <> 0 Then
               If OptReturn(0).Value = True Then
                AddADiscInfo DiscInfos, lngRowno, dblRowData(i, 0), GrdCol.RowData(i), Format(dblRowData(i, 2), strCurrDec), _
                    dblRowData(i, 1), C2Dbl(GrdCol.TextMatrix(i, xlngColNo(6))), GrdCol.TextMatrix(i, xlngColNo(4))
               Else
                AddADiscInfo DiscInfos, lngRowno, dblRowData(i, 0), GrdCol.RowData(i), Format(dblRowData(i, 2), strCurrDec), _
                    dblRowData(i, 1), C2Dbl(GrdCol.TextMatrix(i, xlngColNo(6))), GrdCol.TextMatrix(i, xlngColNo(4))
               End If
            End If
        Next
'        If Format(C2Dbl(calPrice.Text), strPriceDec) = Format((dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity, strPriceDec) Then
        If ChkAdjust.Value = 0 Then
            If OptReturn(0).Value = True Then
                If blnByOrder Then
                    frmName.WriteGrd dblCurrAmount - dblDiscAmount, lngRowno, 9
                    frmName.Calculate lngRowno, 9, False, False, True
                Else
                    frmName.WriteGrd dblCurrAmount - dblDiscAmount, lngRowno, 14
                    frmName.Calculate lngRowno, 14, False, False, True
                End If
            Else
                If blnByOrder Then
                    frmName.WriteGrd Format((dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity, strPriceDec), lngRowno, 5
                    frmName.Calculate lngRowno, 5, False, False, True
                Else
                    frmName.WriteGrd Format((dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity, strPriceDec), lngRowno, 7
                    frmName.Calculate lngRowno, 7, False, False, True
                End If
            End If
        Else
            If blnByOrder Then
                frmName.WriteGrd calPrice.Text, lngRowno, 5
                frmName.Calculate lngRowno, 5, False, False, True
            Else
                frmName.WriteGrd calPrice.Text, lngRowno, 7
                frmName.Calculate lngRowno, 7, False, False, True
            End If
        End If
        Unload Me
    Case 1
        blnSucceed = False
        Unload Me
    Case 2
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" Then
                GrdCol.TextMatrix(i, 1) = ""
            End If
        Next
        reCalculate
    End Select
End Sub

Private Sub Form_Activate()
    If m_blnFirst Then
      m_blnFirst = False
      GridList
    End If
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
End Sub

Private Sub Form_Load()
'    Dim i As Long
'    Dim j As Long
'    Dim lngID As Long
'    Dim lngTabID As Long
'    Dim DiscInfoTmp As PayMentDiscInfo
'    Dim dblUsableAmount As Double
    Me.HelpContextID = 700001
    m_blnFirst = True
'    Me.Enabled = False

    lblTitle(0).Caption = lblTitle(0).Caption & " " & frmName.lblHead(1).Caption
    If blnByOrder Then
        lblTitle(1).Caption = lblTitle(1).Caption & " " & frmName.lblField(9).Caption
    Else
        lblTitle(1).Caption = lblTitle(1).Caption & " " & frmName.lblField(7).Caption
    End If
    lblTitle(0).Visible = True
    lblTitle(1).Left = GrdCol.Left + GrdCol.width - lblTitle(1).width
    lblTitle(1).Visible = True
    
    blnCanAdjustDisc = IsCanDo(226)
    calPrice.Digits = gclsBase.PriceDec
    ChkAdjust.Visible = True
    lblPrice.Visible = True
    calPrice.Visible = True
    If ChkAdjust.Value <> 0 Then ChkAdjust.Value = 0
    calPrice.Enable = 0
    If blnCanAdjustDisc Then
        ChkAdjust.Enabled = True
    Else
        ChkAdjust.Enabled = False
    End If
    Utility.LoadFormResPicture Me
    calPrice.Text = Format(dblPriceTax, strPriceDec)
End Sub
Private Sub GridList()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Long
    Dim j As Long
    Dim lngID As Long
    Dim lngTabID As Long
    Dim dblUsableAmount As Double
    Dim DiscInfoTmp As PayMentDiscInfo
    
    Screen.MousePointer = vbHourglass
    GrdCol.Redraw = False
    
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
    mclsGrid.ColOfs = 1

'    With gclsBase.BaseDB.QueryDefs("QItemPayDisc")
'        .Parameters("CustomerID") = lngCustomerID
'        .Parameters("AccountID") = lngAccountID
'        .Parameters("CurrencyID") = lngCurrencyID
'        .Parameters("ItemID") = lngItemID
''        .Parameters("EndDate") = strDate
'        .Parameters("StrCurrDec") = strCurrDec
'        Set Data1.Recordset = .OpenResultset(rdOpenStatic)
'    End With
    strSql = "SELECT lngARAPInitID  As 选择," & _
        " ReceiptType.strReceiptTypeName||'期初' AS 打款类型," & _
        " Ltrim(strReceiptNO)||LPAD(lngReceiptNO,4,'0') AS 单据号,strDate AS 打款日期," & _
        " ConvertAmount(dblCurrAmount-dblCurrPaymentAmount," & mlngCurrDec & ",0) As 可用金额," & _
        " Ltrim(Rtrim(to_char(NVL(ItemPayDiscDate.dblDiscountRate,100),'990.00')))  As 贴息扣率," & _
        " 0 AS lngTabID "
    strSql = strSql & _
        " FROM ARAPInit, ItemPayDiscDate, ItemPayDiscDetail, ReceiptType " & _
        " WHERE ARAPInit.strDate>=ItemPayDiscDate.strStartDate(+) " & _
        " AND ARAPInit.strDate<=ItemPayDiscDate.strEndDate(+) " & _
        " AND ItemPayDiscDate.lngItemPayDiscID=ItemPayDiscDetail.lngItemPayDiscID(+) " & _
        " AND ARAPInit.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+) " & _
        " AND lngCustomerID=" & lngCustomerID & _
        " AND lngAccountID=" & lngAccountID & _
        " AND lngCurrencyID=" & lngCurrencyID & _
        " AND ARAPInit.lngReceiptTypeID IN (40,37) " & _
        " AND (ItemPayDiscDetail.lngItemID=" & lngItemID & " OR NVL(ItemPayDiscDetail.lngItemID,-1)=-1)"
    
    strSql = strSql & " Union All " & _
        " SELECT lngARAPInitID As 选择," & _
        " strVoucherTypeCode||' '||strVoucherTypeName||'期初' As 打款类型," & _
        " LPAD(intVoucherNO,4,'0') AS 单据号,strDate AS 打款日期," & _
        " ConvertAmount(dblCurrAmount-dblCurrPaymentAmount,2,0) As 可用金额," & _
        " Ltrim(Rtrim(to_char(NVL(ItemPayDiscDate.dblDiscountRate,100),'990.00')))  As 贴息扣率," & _
        " 0 AS lngTabID "
    strSql = strSql & _
        " FROM ARAPInit1, ItemPayDiscDate, ItemPayDiscDetail, VoucherType " & _
        " WHERE ARAPInit1.strDate>=ItemPayDiscDate.strStartDate(+)" & _
        " AND ARAPInit1.strDate<=ItemPayDiscDate.strEndDate(+)" & _
        " AND ItemPayDiscDate.lngItemPayDiscID=ItemPayDiscDetail.lngItemPayDiscID(+)" & _
        " AND ARAPInit1.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+)" & _
        " AND lngCustomerID=" & lngCustomerID & _
        " AND lngAccountID=" & lngAccountID & _
        " AND lngCurrencyID=" & lngCurrencyID & _
        " AND intDirection=-1" & _
        " AND (ItemPayDiscDetail.lngItemID=" & lngItemID & " OR NVL(ItemPayDiscDetail.lngItemID,-1)=-1)"

    strSql = strSql & " Union All " & _
        " SELECT lngActivityDetailID As 选择," & _
        " Decode(Activity.lngActivityTypeID*Activity.blnIsSpecial,39,'采购',40,'销售',' ')||ActivityType.strActivityTypeName As 打款类型," & _
        " Ltrim(strReceiptNO)||LPAD(lngReceiptNO,4,'0') AS 单据号,strDate As 打款日期," & _
        " ConvertAmount(dblCurrAmount-dblCurrPaymentAmount,2,0) As 可用金额," & _
        " Ltrim(Rtrim(to_char(NVL(ItemPayDiscDate.dblDiscountRate,100),'990.00')))  As 贴息扣率," & _
        " 1 AS lngTabID "
    strSql = strSql & _
        " FROM ActivityDetail, Activity, ItemPayDiscDate, ItemPayDiscDetail, ActivityType " & _
        " WHERE ActivityDetail.lngActivityID=Activity.lngActivityID(+)" & _
        " AND Activity.strDate>=ItemPayDiscDate.strStartDate(+)" & _
        " AND Activity.strDate<=ItemPayDiscDate.strEndDate(+)" & _
        " AND ItemPayDiscDate.lngItemPayDiscID=ItemPayDiscDetail.lngItemPayDiscID(+)" & _
        " AND Activity.lngActivityTypeID=ActivityType.lngActivityTypeID(+)" & _
        " AND lngCustomerID=" & lngCustomerID & _
        " AND lngAccountID=" & lngAccountID & _
        " AND lngCurrencyID=" & lngCurrencyID & _
        " AND Activity.lngActivityTypeID IN (40,37)" & _
        " AND (ItemPayDiscDetail.lngItemID=" & lngItemID & " OR NVL(ItemPayDiscDetail.lngItemID,-1)=-1)"

    strSql = strSql & " Union All " & _
        " SELECT lngActivityDetailID As 选择," & _
        " ReceiptType.strReceiptTypeName||'退货'As 打款类型," & _
        " Ltrim(strReceiptNO)||LPAD(lngReceiptNO,4,'0') AS 单据号,strDate AS 打款日期," & _
        " ConvertAmount(dblCurrPaymentAmount-dblCurrAmount,2,0) As 可用金额," & _
        " Ltrim(Rtrim(to_char(NVL(ItemPayDiscDate.dblDiscountRate,100),'990.00')))  As 贴息扣率," & _
        " 2 AS lngTabID "
    strSql = strSql & _
        " FROM ItemActivityDetail, ItemActivity, ItemPayDiscDate, ItemPayDiscDetail, ReceiptType " & _
        " WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID(+)" & _
        " AND ItemActivity.strDate>=ItemPayDiscDate.strStartDate(+)" & _
        " AND ItemActivity.strDate<=ItemPayDiscDate.strEndDate(+)" & _
        " AND ItemPayDiscDate.lngItemPayDiscID=ItemPayDiscDetail.lngItemPayDiscID(+)" & _
        " AND ItemActivity.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+)" & _
        " AND lngCustomerID=" & lngCustomerID & _
        " AND lngAccountID=" & lngAccountID & _
        " AND lngCurrencyID=" & lngCurrencyID & _
        " AND dblCurrAmount<0" & _
        " AND ItemActivity.lngActivityTypeID IN (11,12,14,17)" & _
        " AND (ItemPayDiscDetail.lngItemID=" & lngItemID & " OR NVL(ItemPayDiscDetail.lngItemID,-1)=-1)"

    strSql = strSql & " Union All " & _
        " SELECT lngVoucherDetailID As 选择," & _
        " strVoucherTypeCode||' '||strVoucherTypeName As 打款类型," & _
        " LPAD(intVoucherNO,4,'0') AS 单据号,strDate AS 打款日期," & _
        " ConvertAmount(dblCurrencyAmount-dblCurrPaymentAmount,2,0) As 可用金额," & _
        " Ltrim(Rtrim(to_char(NVL(ItemPayDiscDate.dblDiscountRate,100),'990.00')))  As 贴息扣率," & _
        " 3 AS lngTabID"
    strSql = strSql & _
        " FROM VoucherDetail, Voucher, ItemPayDiscDate, ItemPayDiscDetail, VoucherType" & _
        " WHERE VoucherDetail.lngVoucherID = Voucher.lngVoucherID" & _
        " AND Voucher.strDate>=ItemPayDiscDate.strStartDate(+)" & _
        " AND Voucher.strDate<=ItemPayDiscDate.strEndDate(+)" & _
        " AND ItemPayDiscDate.lngItemPayDiscID=ItemPayDiscDetail.lngItemPayDiscID(+)" & _
        " AND Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+)" & _
        " AND lngCustomerID=" & lngCustomerID & _
        " AND lngAccountID=" & lngAccountID & _
        " AND lngCurrencyID=" & lngCurrencyID & _
        " AND intDirection=-1  AND lngVoucherSourceID=1" & _
        " AND (ItemPayDiscDetail.lngItemID=" & lngItemID & " OR NVL(ItemPayDiscDetail.lngItemID,-1)=-1)"

    strSql = strSql & " ORDER BY 打款日期"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set DATA1.Resultset = recTmp
    
    If Not DATA1.Resultset.EOF Then
        DATA1.Resultset.MoveLast
    End If
    
    
    If gclsBase.ControlAccount Then
        For i = GrdCol.Rows - 1 To 1 Step -1
            If C2lng(GrdCol.TextMatrix(i, 7)) = 3 Then
                GrdCol.RemoveItem (i)
            End If
        Next
    End If
    mclsGrid.ListSet.Columns = GrdCol.Cols - 2
    
    For i = 1 To GrdCol.Rows - 1
        GrdCol.RowData(i) = C2lng(GrdCol.TextMatrix(i, 1))
        GrdCol.TextMatrix(i, 1) = ""
    Next
    GrdCol.Cols = GrdCol.Cols + 2
    GrdCol.ColWidth(GrdCol.Cols - 3) = 0
    GrdCol.ColWidth(GrdCol.Cols - 2) = 0
    GrdCol.ColWidth(GrdCol.Cols - 1) = 0
    If DiscInfos.Count <> 0 Then
        For i = 1 To GrdCol.Rows - 1
            lngID = GrdCol.RowData(i)
            lngTabID = C2lng(GrdCol.TextMatrix(i, 7))
            dblUsableAmount = C2Dbl(GrdCol.TextMatrix(i, 5))
            For j = 1 To DiscInfos.Count
                DiscInfoTmp.lngRowno = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.lngTableID = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.lngActivityDetailID = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.dblUsedAmount = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.dblSavedAmount = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.dblDiscountRate = DiscInfos.Item(j)
                j = j + 1
                DiscInfoTmp.strDate = DiscInfos.Item(j)
                
                If DiscInfoTmp.lngTableID = lngTabID And DiscInfoTmp.lngActivityDetailID = lngID Then
                    If DiscInfoTmp.lngRowno = lngRowno Then
                        dblUsableAmount = dblUsableAmount + DiscInfoTmp.dblSavedAmount
                        GrdCol.TextMatrix(i, GrdCol.Cols - 1) = DiscInfoTmp.dblSavedAmount
                        If DiscInfoTmp.dblUsedAmount > 0 Then
                            GrdCol.TextMatrix(i, 1) = "√"