budgetcopy.frm

金算盘软件代码

    Next
    If intCount > 10 Then
        strSql = "SELECT * FROM Budget WHERE lngBudgetID=" & mlngBudgetID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTemp.EOF Then
'            mblnBudget(0) = recTemp("blnIsAccount")
'            mblnBudget(1) = recTemp("blnIsItem")
'            mblnBudget(2) = recTemp("blnIsCustomer")
'            mblnBudget(3) = recTemp("blnIsDepartment")
'            mblnBudget(4) = recTemp("blnIsEmployee")
'            mblnBudget(5) = recTemp("blnIsJob")
'            mblnBudget(6) = recTemp("blnIsClass1")
'            mblnBudget(7) = recTemp("blnIsClass2")
'            mblnBudget(8) = recTemp("blnIsItemType")
'            mblnBudget(9) = recTemp("blnIsCustomerType")
'            mblnBudget(10) = recTemp("blnIsArea")
            mblnBudget(0) = IIf(recTemp("blnIsAccount") = 1, True, False)
            mblnBudget(1) = IIf(recTemp("blnIsItem") = 1, True, False)
            mblnBudget(2) = IIf(recTemp("blnIsCustomer") = 1, True, False)
            mblnBudget(3) = IIf(recTemp("blnIsDepartment") = 1, True, False)
            mblnBudget(4) = IIf(recTemp("blnIsEmployee") = 1, True, False)
            mblnBudget(5) = IIf(recTemp("blnIsJob") = 1, True, False)
            mblnBudget(6) = IIf(recTemp("blnIsClass1") = 1, True, False)
            mblnBudget(7) = IIf(recTemp("blnIsClass2") = 1, True, False)
            mblnBudget(8) = IIf(recTemp("blnIsItemType") = 1, True, False)
            mblnBudget(9) = IIf(recTemp("blnIsCustomerType") = 1, True, False)
            mblnBudget(10) = IIf(recTemp("blnIsArea") = 1, True, False)
            strObject1 = Abs(CInt(recTemp!blnIsNatualCurrency))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsOriginalCurrency))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsPurchaseQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsSaleQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsSaleCost))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsStockQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsBorrowQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsLendQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsStageQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsEntrustQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsUseQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsPurchaseAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsSaleAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsSaleProfit))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsStockAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsBorrowAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsLendAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsStageAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsEntrustAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsUseAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsReceiveQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsReceiveAmount))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsPayQuantity))
            strObject1 = strObject1 & Abs(CInt(recTemp!blnIsPayAmount))
        End If
        recTemp.Close
    End If
    strSql = "SELECT * FROM Budget WHERE lngBudgetID=" & lngBudgetID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
'        blnBudget(0) = recTemp("blnIsAccount")
'        blnBudget(1) = recTemp("blnIsItem")
'        blnBudget(2) = recTemp("blnIsCustomer")
'        blnBudget(3) = recTemp("blnIsDepartment")
'        blnBudget(4) = recTemp("blnIsEmployee")
'        blnBudget(5) = recTemp("blnIsJob")
'        blnBudget(6) = recTemp("blnIsClass1")
'        blnBudget(7) = recTemp("blnIsClass2")
'        blnBudget(8) = recTemp("blnIsItemType")
'        blnBudget(9) = recTemp("blnIsCustomerType")
'        blnBudget(10) = recTemp("blnIsArea")
        blnBudget(0) = IIf(recTemp("blnIsAccount") = 1, True, False)
        blnBudget(1) = IIf(recTemp("blnIsItem") = 1, True, False)
        blnBudget(2) = IIf(recTemp("blnIsCustomer") = 1, True, False)
        blnBudget(3) = IIf(recTemp("blnIsDepartment") = 1, True, False)
        blnBudget(4) = IIf(recTemp("blnIsEmployee") = 1, True, False)
        blnBudget(5) = IIf(recTemp("blnIsJob") = 1, True, False)
        blnBudget(6) = IIf(recTemp("blnIsClass1") = 1, True, False)
        blnBudget(7) = IIf(recTemp("blnIsClass2") = 1, True, False)
        blnBudget(8) = IIf(recTemp("blnIsItemType") = 1, True, False)
        blnBudget(9) = IIf(recTemp("blnIsCustomerType") = 1, True, False)
        blnBudget(10) = IIf(recTemp("blnIsArea") = 1, True, False)
        strObject2 = Abs(CInt(recTemp!blnIsNatualCurrency))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsOriginalCurrency))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsPurchaseQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsSaleQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsSaleCost))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsStockQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsBorrowQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsLendQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsStageQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsEntrustQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsUseQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsPurchaseAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsSaleAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsSaleProfit))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsStockAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsBorrowAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsLendAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsStageAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsEntrustAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsUseAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsReceiveQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsReceiveAmount))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsPayQuantity))
        strObject2 = strObject2 & Abs(CInt(recTemp!blnIsPayAmount))
    End If
    recTemp.Close
    For intCount = 0 To 10
        If mblnBudget(intCount) <> blnBudget(intCount) Then Exit For
    Next
    If intCount > 10 Then
        If strObject1 <> strObject2 Then
            If ShowMsg(hWnd, "预算对象不一样，是否继续复制?", vbQuestion + vbYesNo, Caption) = vbNo Then
                cboBudget(0).SetFocus
                CopyBudget = False
                Exit Function
            End If
        End If
        
        If calBudget.Text = "" Then
            dblScale = 1
        Else
            dblScale = CDbl(calBudget.Text) / 100
        End If
        strSql = "SELECT * FROM AccountYear WHERE intYear=" & mintYear
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        bytPeriodNO = recTemp("bytPeriodNO")
        recTemp.Close
        strSql = "DELETE  FROM BudgetBalance WHERE lngBudgetID=" & mlngBudgetID _
            & " AND intYear=" & mintYear
        strSql1 = "INSERT INTO BudgetBalance SELECT " & mlngBudgetID & " AS lngBudgetID," _
            & mintYear & " AS intYear,bytPeriod,lngAccountID,lngItemID,lngItemTypeId,lngCurrencyID" _
            & ",lngClassID1,lngClassID2,lngJobID,lngCustomerID,lngCustomerTypeId,lngDepartmentID" _
            & ",lngEmployeeID,lngAreaID,BudgetBalance.dblCurrencyBudget*" & dblScale _
            & " AS dblCurrencyBudget,BudgetBalance.dblBudget*" _
            & dblScale & " AS dblBudget, BudgetBalance.dblQuantityBudget*" & dblScale _
            & " AS dblQuantityBudget FROM BudgetBalance" & " WHERE lngBudgetID=" & lngBudgetID _
            & " AND intYear=" & intYear & " AND bytPeriod<=" & bytPeriodNO
        On Error GoTo errhandel:
        gclsBase.BaseWorkSpace.BeginTrans
        gclsBase.BaseDB.Execute strSql
        gclsBase.BaseDB.Execute strSql1
        gclsBase.BaseWorkSpace.CommitTrans
        CopyBudget = True
        '发出计划预算消息
        gclsSys.SendMessage CStr(Me.hWnd), Message.msgBudget
    Else
        ShowMsg Me.hWnd, "复制与被复制的预算方案之间预算项目不同，不能复制！", _
            vbInformation, Me.Caption
        cboBudget(0).SetFocus
        CopyBudget = False
    End If
    Exit Function
errhandel:
    ShowMsg Me.hWnd, "复制失败！", vbInformation, Me.Caption
    gclsBase.BaseWorkSpace.RollBacktrans
    CopyBudget = False
End Function

Private Sub cboBudget_Click(Index As Integer)
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    On Error Resume Next
    If Index = 0 Then
        strSql = "SELECT DISTINCT intYear FROM BudgetBalance WHERE lngBudgetID=" & (cboBudget(0).ItemData(cboBudget(0).ListIndex))
        With cboBudget(1)
            .Clear
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTemp.EOF Then
                Do While Not recTemp.EOF
                    .AddItem recTemp("intYear")
                    recTemp.MoveNext
                Loop
                .ListIndex = 0
            End If
            recTemp.Close
            Set recTemp = Nothing
        End With
    End If
End Sub

Private Sub cmdBudget_Click(Index As Integer)
    Select Case Index
        Case 0  '确定
            If CopyBudget() Then
                Unload Me
            End If
        Case 1  '取消
            Unload Me
    End Select
End Sub

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

Private Sub Form_Load()
    SetListText
    Set Me.Icon = GetFormResPicture(139, vbResIcon)
    Set cmdBudget(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdBudget(1).Picture = GetFormResPicture(1002, vbResBitmap)
End Sub

Private Sub Form_Paint()
    FrameBox Me.hWnd, 90, 180, 3330, 2040
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture 139
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
End Sub