budgetsetcard1.frm

金算盘软件代码

                Case "采购金额"
                    chkBudgetObject(1).Value = 1
                Case "销售收入"
                    chkBudgetObject(3).Value = 1
                Case "毛利"
                    chkBudgetObject(5).Value = 1
                Case "库存金额"
                    chkBudgetObject(7).Value = 1
                Case "受托金额"
                    chkBudgetObject(9).Value = 1
                Case "委托金额"
                    chkBudgetObject(11).Value = 1
                Case "分期金额"
                    chkBudgetObject(13).Value = 1
                Case "加工金额"
                    chkBudgetObject(15).Value = 1
                Case "领用金额"
                    chkBudgetObject(17).Value = 1
                Case "回款数量"
                    chkBudgetObject(18).Value = 1
                Case "回款金额"
                    chkBudgetObject(19).Value = 1
                Case "付款数量"
                    chkBudgetObject(20).Value = 1
                Case "付款金额"
                    chkBudgetObject(21).Value = 1
                Case "采购订单数量"
                    chkBudgetObject(22).Value = 1
                Case "采购订单金额"
                    chkBudgetObject(23).Value = 1
                Case "销售订单数量"
                    chkBudgetObject(24).Value = 1
                Case "销售订单金额"
                    chkBudgetObject(25).Value = 1
                End Select
            End If
        Next intIndex
    End If
    '包含税金
    intCount = intCount + 1
    If GetString(strValue, strResult, intCount) Then
        chkBudgetitem(7).Value = 1
    End If
    If SaveBudget(lngID) Then
        LoadFromString = lngID
    End If
    Unload Me
End Function

Private Function GetBudget() As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    
    strSql = "select * from Budget where lngbudgetid=" & mlngID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.RowCount > 0 Then
        tedBudget.Text = recTemp("strbudgetname")
        chkBudgetitem(0).Value = IIf(recTemp("blnIsItem"), 1, 0)
        chkBudgetitem(1).Value = IIf(recTemp("blnIsCustomer"), 1, 0)
        chkBudgetitem(2).Value = IIf(recTemp("blnIsDepartment"), 1, 0)
        chkBudgetitem(3).Value = IIf(recTemp("blnIsEmployee"), 1, 0)
        chkBudgetitem(4).Value = IIf(recTemp("blnIsJob"), 1, 0)
        chkBudgetitem(5).Value = IIf(recTemp("blnIsClass1"), 1, 0)
        chkBudgetitem(6).Value = IIf(recTemp("blnIsClass2"), 1, 0)
        chkBudgetitem(7).Value = IIf(recTemp("blnIsTax"), 1, 0)
        chkBudgetitem(8).Value = IIf(recTemp("blnIsItemType"), 1, 0)
        chkBudgetitem(9).Value = IIf(recTemp("blnIsCustomerType"), 1, 0)
        chkBudgetitem(10).Value = IIf(recTemp("blnIsArea"), 1, 0)
        chkBudgetObject(0).Value = IIf(recTemp("blnIsPurchaseQuantity"), 1, 0)
        chkBudgetObject(1).Value = IIf(recTemp("blnIsPurchaseAmount"), 1, 0)
        chkBudgetObject(2).Value = IIf(recTemp("blnIsSaleQuantity"), 1, 0)
        chkBudgetObject(3).Value = IIf(recTemp("blnIsSaleAmount"), 1, 0)
        chkBudgetObject(4).Value = IIf(recTemp("blnIsSaleCost"), 1, 0)
        chkBudgetObject(5).Value = IIf(recTemp("blnIsSaleProfit"), 1, 0)
        chkBudgetObject(6).Value = IIf(recTemp("blnIsStockQuantity"), 1, 0)
        chkBudgetObject(7).Value = IIf(recTemp("blnIsStockAmount"), 1, 0)
        chkBudgetObject(8).Value = IIf(recTemp("blnIsBorrowQuantity"), 1, 0)
        chkBudgetObject(9).Value = IIf(recTemp("blnIsBorrowAmount"), 1, 0)
        chkBudgetObject(10).Value = IIf(recTemp("blnIsLendQuantity"), 1, 0)
        chkBudgetObject(11).Value = IIf(recTemp("blnIsLendAmount"), 1, 0)
        chkBudgetObject(12).Value = IIf(recTemp("blnIsStageQuantity"), 1, 0)
        chkBudgetObject(13).Value = IIf(recTemp("blnIsStageAmount"), 1, 0)
        chkBudgetObject(14).Value = IIf(recTemp("blnIsEntrustQuantity"), 1, 0)
        chkBudgetObject(15).Value = IIf(recTemp("blnIsEntrustAmount"), 1, 0)
        chkBudgetObject(16).Value = IIf(recTemp("blnIsUseQuantity"), 1, 0)
        chkBudgetObject(17).Value = IIf(recTemp("blnIsUseAmount"), 1, 0)
        chkBudgetObject(18).Value = IIf(recTemp("blnIsReceiveQuantity"), 1, 0)
        chkBudgetObject(19).Value = IIf(recTemp("blnIsReceiveAmount"), 1, 0)
        chkBudgetObject(20).Value = IIf(recTemp("blnIsPayQuantity"), 1, 0)
        chkBudgetObject(21).Value = IIf(recTemp("blnIsPayAmount"), 1, 0)
        chkBudgetObject(22).Value = IIf(recTemp("blnIsPOQuantity"), 1, 0)
        chkBudgetObject(23).Value = IIf(recTemp("blnIsPOAmount"), 1, 0)
        chkBudgetObject(24).Value = IIf(recTemp("blnIsSOQuantity"), 1, 0)
        chkBudgetObject(25).Value = IIf(recTemp("blnIsSOAmount"), 1, 0)
        GetBudget = True
    Else
        If Visible Then ShowMsg Me.hwnd, "该预算方案已经被其他用户删除！", vbInformation, Me.Caption
        GetBudget = False
    End If
End Function

'新增计划预算
Private Function InsertBudget() As Boolean
    Dim strSql As String
    Dim lngTmpID As Long
    
    On Error GoTo errhandel:
    'strSql = "INSERT INTO Budget (strBudgetName,blnIsItem,blnIsCustomer" _
        & ",blnIsDepartment,blnIsEmployee,blnIsJob,blnIsClass1,blnIsClass2" _
        & ",blnIsTax,blnIsItemType,blnIsCustomerType,blnIsArea,blnIsPurchaseQuantity" _
        & ",blnIsPurchaseAmount,blnIsSaleQuantity,blnIsSaleAmount,blnIsSaleCost,blnIsSaleProfit" _
        & ",blnIsStockQuantity,blnIsStockAmount,blnIsBorrowQuantity" _
        & ",blnIsBorrowAmount,blnIsLendQuantity,blnIsLendAmount" _
        & ",blnIsStageQuantity,blnIsStageAmount,blnIsEntrustQuantity,blnIsEntrustAmount" _
        & ",blnIsUseQuantity,blnIsUseAmount,blnIsReceiveQuantity,blnIsReceiveAmount,blnIsPayQuantity" _
        & ",blnIsPayAmount,blnIsPOQuantity,blnIsPOAmount,blnIsSOQuantity,blnIsSOAmount,bytType) VALUES('" _
        & tedBudget.Text & "'," & IIf(chkBudgetitem(0).Value = 1, True, False) & "," _
        & IIf(chkBudgetitem(1).Value = 1, True, False) & "," & IIf(chkBudgetitem(2).Value = 1, True, False) & "," _
        & IIf(chkBudgetitem(3).Value = 1, True, False) & "," & IIf(chkBudgetitem(4).Value = 1, True, False) & "," _
        & IIf(chkBudgetitem(5).Value = 1, True, False) & "," & IIf(chkBudgetitem(6).Value = 1, True, False) & "," _
        & IIf(chkBudgetitem(7).Value = 1, True, False) & "," & IIf(chkBudgetitem(8).Value = 1, True, False) & "," _
        & IIf(chkBudgetitem(9).Value = 1, True, False) & "," & IIf(chkBudgetitem(10).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(0).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(1).Value = 1, True, False) & "," & IIf(chkBudgetObject(2).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(3).Value = 1, True, False) & "," & IIf(chkBudgetObject(4).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(5).Value = 1, True, False) & "," & IIf(chkBudgetObject(6).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(7).Value = 1, True, False) & "," & IIf(chkBudgetObject(8).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(9).Value = 1, True, False) & "," & IIf(chkBudgetObject(10).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(11).Value = 1, True, False) & "," & IIf(chkBudgetObject(12).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(13).Value = 1, True, False) & "," & IIf(chkBudgetObject(14).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(15).Value = 1, True, False) & "," & IIf(chkBudgetObject(16).Value = 1, True, False) & ","
    'strSql = strSql & IIf(chkBudgetObject(17).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(18).Value = 1, True, False) & "," & IIf(chkBudgetObject(19).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(20).Value = 1, True, False) & "," & IIf(chkBudgetObject(21).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(22).Value = 1, True, False) & "," & IIf(chkBudgetObject(23).Value = 1, True, False) & "," _
        & IIf(chkBudgetObject(24).Value = 1, True, False) & "," & IIf(chkBudgetObject(25).Value = 1, True, False) & ",1)"
    lngTmpID = BillPublic.GetNewID("Budget")
    strSql = "INSERT INTO Budget (lngBudgetID,strBudgetName,blnIsItem,blnIsCustomer" _
        & ",blnIsDepartment,blnIsEmployee,blnIsJob,blnIsClass1,blnIsClass2" _
        & ",blnIsTax,blnIsItemType,blnIsCustomerType,blnIsArea,blnIsPurchaseQuantity,blnIsPurchaseAmount" _
        & ",blnIsSaleQuantity,blnIsSaleAmount,blnIsSaleCost,blnIsSaleProfit" _
        & ",blnIsStockQuantity,blnIsStockAmount,blnIsBorrowQuantity" _
        & ",blnIsBorrowAmount,blnIsLendQuantity,blnIsLendAmount" _
        & ",blnIsStageQuantity,blnIsStageAmount,blnIsEntrustQuantity" _
        & ",blnIsEntrustAmount,blnIsUseQuantity,blnIsUseAmount,blnIsReceiveQuantity,blnIsReceiveAmount,blnIsPayQuantity" _
        & ",blnIsPayAmount,blnIsPOQuantity,blnIsPOAmount,blnIsSOQuantity,blnIsSOAmount,bytType) VALUES(" & lngTmpID & ",'" _
        & tedBudget.Text & "'," & IIf(chkBudgetitem(0).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetitem(1).Value = 1, 1, 0) & "," & IIf(chkBudgetitem(2).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetitem(3).Value = 1, 1, 0) & "," & IIf(chkBudgetitem(4).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetitem(5).Value = 1, 1, 0) & "," & IIf(chkBudgetitem(6).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetitem(7).Value = 1, 1, 0) & "," & IIf(chkBudgetitem(8).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetitem(9).Value = 1, 1, 0) & "," & IIf(chkBudgetitem(10).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(0).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(1).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(2).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(3).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(4).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(5).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(6).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(7).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(8).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(9).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(10).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(11).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(12).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(13).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(14).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(15).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(16).Value = 1, 1, 0) & ","
    strSql = strSql & IIf(chkBudgetObject(17).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(18).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(19).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(20).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(21).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(22).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(23).Value = 1, 1, 0) & "," _
        & IIf(chkBudgetObject(24).Value = 1, 1, 0) & "," & IIf(chkBudgetObject(25).Value = 1, 1, 0) & ",1)"
    gclsBase.BaseDB.Execute strSql
    '发出预算方案消息
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgBudgetPlan
    InsertBudget = True
    Exit Function
errhandel:
    If InStr(UCase(Err.Description), "ORA-00001") > 1 Then
        If Visible Then ShowMsg Me.hwnd, "计划预算名称已经存在，新增失败！", vbOKOnly + vbCritical, Me.Caption
    Else
        If Visible Then ShowMsg Me.hwnd, "新增计划预算失败！", vbOKOnly + vbCritical, Me.Caption
    End If
    InsertBudget = False
    Exit Function
End Function

'修改计划预算
Private Function UpdateBudget() As Boolean
    Dim strSql As String
    Dim lngResult As Long
    Dim strSql1 As String
    Dim recTemp As rdoResultset
    Dim blnResult As Boolean
    Dim intCount As Integer
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT * FROM Budget WHERE lngBudgetID=" & mlngID, rdOpenStatic)
    With recTemp
        If Not .EOF Then
            'If !blnIsItem And chkBudgetitem(0).Value <> 1 Then blnResult = True
            'If !blnIsCustomer And chkBudgetitem(1).Value <> 1 Then blnResult = True
            'If !blnIsDepartment And chkBudgetitem(2).Value <> 1 Then blnResult = True
            'If !blnIsEmployee And chkBudgetitem(3).Value <> 1 Then blnResult = True
            'If !blnIsJob And chkBudgetitem(5).Value <> 1 Then blnResult = True
            'If !blnIsClass1 And chkBudgetitem(6).Value <> 1 Then blnResult = True
            'If !blnIsClass2 And chkBudgetitem(7).Value <> 1 Then blnResult = True
            If !blnIsItem = 1 And chkBudgetitem(0).Value <> 1 Then blnResult = True
            If !blnIsCustomer = 1 And chkBudgetitem(1).Value <> 1 Then blnResult = True
            If !blnIsDepartment = 1 And chkBudgetitem(2).Value <> 1 Then blnResult = True
            If !blnIsEmployee = 1 And chkBudgetitem(3).Value <> 1 Then blnResult = True
            If !blnIsJob = 1 And chkBudgetitem(4).Value <> 1 Then blnResult = True
            If !blnIsClass1 = 1 And chkBudgetitem(5).Value <> 1 Then blnResult = True
            If !blnIsClass2 = 1 And chkBudgetitem(6).Value <> 1 Then blnResult = True
            If !blnIsItemType = 1 And chkBudgetitem(8).Value <> 1 Then blnResult = True
            If !blnIsCustomerType = 1 And chkBudgetitem(9).Value <> 1 Then blnResult = True
            If !blnIsArea = 1 And chkBudgetitem(10).Value <> 1 Then blnResult = True
            For intCount = 18 To 26
               ' If .rdoColumns(intCount) <> IIf(chkBudgetObject((intCount - 15) * 2).Value = 1, True, False) Then
                 If .rdoColumns(intCount) <> IIf(chkBudgetObject((intCount - 15) * 2).Value = 1, 1, 0) Then
                    blnResult = True
                    Exit For
                End If
            Next
            For intCount = 27 To 35
                'If .Fields(intCount) <> IIf(chkBudgetObject((intCount - 27) * 2 + 1).Value = 1, True, False) Then
                If .rdoColumns(intCount) <> IIf(chkBudgetObject((intCount - 27) * 2 + 1).Value = 1, True, False) Then
                    blnResult = True
                    Exit For
                End If
            Next
            For intCount = 36 To 43
                'If .Fields(intCount) <> IIf(chkBudgetObject((intCount - 36)).Value = 1, True, False) Then
                If .rdoColumns(intCount) <> IIf(chkBudgetObject((intCount - 36) * 2 + 1).Value = 1, 1, 0) Then
                    blnResult = True
                    Exit For
                End If
            Next
            If blnResult Then
                lngResult = ShowMsg(Me.hwnd, "改变预算方案将清除原方案所有预算数据，你确实要改变预算方案吗？" _
                    , vbQuestion + vbYesNo + vbDefaultButton2, Me.Caption)
                If lngResult = vbNo Then
                    UpdateBudget = False
                    Exit Function
                Else
                    strSql1 = "DELETE FROM BudgetBalance WHERE lngBudgetID=" & mlngID
                End If
            End If
        End If
    End With
    'strSql = "UPDATE Budget Set strBudgetName='" & tedBudget.Text & "',blnIsItem=" _
        & IIf(chkBudgetitem(0).Value = 1, True, False) & ",blnIsCustomer=" _
        & IIf(chkBudgetitem(1).Value = 1, True, False) & ",blnIsDepartment=" _
        & IIf(chkBudgetitem(2).Value = 1, True, False) & ",blnIsEmployee=" _
        & IIf(chkBudgetitem(3).Value = 1, True, False) & ",blnIsJob=" _
        & IIf(chkBudgetitem(4).Value = 1, True, False) & ",blnIsClass1=" _
        & IIf(chkBudgetitem(5).Value = 1, True, False) & ",blnIsClass2=" _
        & IIf(chkBudgetitem(6).Value = 1, True, False) & ",blnIsTax=" _
        & IIf(chkBudgetitem(7).Value = 1, True, False) & ",blnIsPurchaseQuantity=" _
        & IIf(chkBudgetObject(0).Value = 1, True, False) & ",blnIsPurchaseAmount=" _
        & IIf(chkBudgetObject(1).Value = 1, True, False) & ",blnIsSaleQuantity=" _
        & IIf(chkBudgetObject(2).Value = 1, True, False) & ",blnIsSaleAmount=" _
        & IIf(chkBudgetObject(3).Value = 1, True, False) & ",blnIsSaleCost=" _
        & IIf(chkBudgetObject(4).Value = 1, True, False) & ",blnIsSaleProfit=" _
        & IIf(chkBudgetObject(5).Value = 1, True, False) & ",blnIsStockQuantity=" _
        & IIf(chkBudgetObject(6).Value = 1, True, False) & ",blnIsStockAmount=" _
        & IIf(chkBudgetObject(7).Value = 1, True, False) & ",blnIsBorrowQuantity=" _
        & IIf(chkBudgetObject(8).Value = 1, True, False) & ",blnIsBorrowAmount=" _
        & IIf(chkBudgetObject(9).Value = 1, True, False) & ",blnIsLendQuantity=" _
        & IIf(chkBudgetObject(10).Value = 1, True, False) & ",blnIsLendAmount=" _
        & IIf(chkBudgetObject(11).Value = 1, True, False) & ",blnIsStageQuantity=" _
        & IIf(chkBudgetObject(12).Value = 1, True, False) & ",blnIsStageAmount=" _
        & IIf(chkBudgetObject(13).Value = 1, True, False) & ",blnIsEntrustQuantity=" _
        & IIf(chkBudgetObject(14).Value = 1, True, False) & ",blnIsEntrustAmount=" _
        & IIf(chkBudgetObject(15).Value = 1, True, False) & ",blnIsUseQuantity="
    'strSql = strSql & IIf(chkBudgetObject(16).Value = 1, True, False) & ",blnIsUseAmount=" _
        & IIf(chkBudgetObject(17).Value = 1, True, False) & " WHERE lngBudgetID=" & mlngID
    strSql = "UPDATE Budget Set strBudgetName='" & tedBudget.Text & "',blnIsItem=" _
        & IIf(chkBudgetitem(0).Value = 1, 1, 0) & ",blnIsCustomer=" _
        & IIf(chkBudgetitem(1).Value = 1, 1, 0) & ",blnIsDepartment=" _
        & IIf(chkBudgetitem(2).Value = 1, 1, 0) & ",blnIsEmployee=" _
        & IIf(chkBudgetitem(3).Value = 1, 1, 0) & ",blnIsJob=" _
        & IIf(chkBudgetitem(4).Value = 1, 1, 0) & ",blnIsClass1=" _
        & IIf(chkBudgetitem(5).Value = 1, 1, 0) & ",blnIsClass2=" _
        & IIf(chkBudgetitem(6).Value = 1, 1, 0) & ",blnIsTax=" _
        & IIf(chkBudgetitem(7).Value = 1, 1, 0) & ",blnIsItemType=" _
        & IIf(chkBudgetitem(8).Value = 1, 1, 0) & ",blnIsCustomerType=" _
        & IIf(chkBudgetitem(9).Value = 1, 1, 0) & ",blnIsArea=" _
        & IIf(chkBudgetitem(10).Value = 1, 1, 0)
    strSql = strSql & ",blnIsPurchaseQuantity=" _
        & IIf(chkBudgetObject(0).Value = 1, 1, 0) & ",blnIsPurchaseAmount=" _
        & IIf(chkBudgetObject(1).Value = 1, 1, 0) & ",blnIsSaleQuantity=" _