budgetcard.frm

金算盘软件代码

Private mblnExit As Boolean
Private mblnImport As Boolean
Private mblnImportBuget As Boolean


'新增计划预算
Public Function AddCard(ByVal intModal As Integer, ByVal BudgetName As String, ByVal Year As String _
    , IsShow() As Boolean, BudgetID As Long, IsNatualCurrency As Boolean _
    , IsOriginalCurrency As Boolean, IsQuantity As Boolean, ByVal intType As Integer, strName() As String) As Boolean
    Dim intCount As Integer
    
    mblnIsInput = False
    mintFlag = intType
    mblnImportBuget = True
    If mintFlag = 1 Then
        For intCount = 0 To 2
            mstrObjectName(intCount) = strName(intCount)
        Next
        mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
        mstrQuantityDec = mstrDec
        mstrCurrDec = mstrDec
    Else
        mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
        mstrQuantityDec = IIf(gclsBase.QuantityDec = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.QuantityDec, "0"))
    End If
    mblnIsNatualCurrency = IsNatualCurrency
    mblnIsOriginalCurrency = IsOriginalCurrency
    mblnIsQuantity = IsQuantity
    mblnIsAddNew = True
    GetPeriodNO Year
    mlngListID(9) = 0
    If intType = 1 Then
        Me.Caption = "新增经营预算"
    Else
        Me.Caption = "新增财务预算"
    End If
    lblbudget(11).Caption = BudgetName
    txtBudget(0).Text = Year
    For intCount = 0 To 11
        mlngID(intCount) = 0
        If intCount < 9 Then
            If IsShow(intCount) Then
                lstBudget(intCount).Enabled = True
                lstBudget(intCount).TabStop = True
            Else
                lstBudget(intCount).Enabled = False
                lstBudget(intCount).TabStop = False
            End If
        Else
            If IsShow(intCount) Then
                lstBudget(intCount + 1).Enabled = True
                lstBudget(intCount + 1).TabStop = True
            Else
                lstBudget(intCount + 1).Enabled = False
                lstBudget(intCount + 1).TabStop = False
            End If
        End If
    Next
    If mintFlag = 0 Then
        SetListText 8
        lstBudget(8).ReferRow = 0
        mblnIsload(8) = True
        If IsOriginalCurrency Then
            lstBudget(8).Enabled = True
        Else
            lstBudget(8).Enabled = False
        End If
    End If
    mlngBudgetID = BudgetID
    ReSetColWidth
    mblnIsChange = False
    Me.Show intModal
End Function

'引入
'预算项目(8)+期间(年.月)+预算数据(1,2,3)
'格式：单位=?;部门=?;... chr(9) 1998.01 100.00;200.00;300
Public Function LoadFromString(ByVal BudgetID As Long, ByVal strValue As String) As Boolean
    Dim intCount As Integer
    Dim strResult As String
    Dim strData1 As String
    Dim strData2 As String
    Dim mstrName(25) As String
    Dim strObj As String
    Dim intCnt As Integer
    Dim intIndex As Integer
    Dim strSql As String
    Dim recBudget As rdoResultset
    
    mblnImportBuget = True
    If Trim$(lblbudget(11).Caption) = "" Then
        strSql = "Select * From Budget Where lngBudgetID=" & BudgetID
        Set recBudget = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recBudget.EOF Then
            mintFlag = recBudget!bytType
            'mblnIsNatualCurrency = recBudget!blnIsNatualCurrency
            mblnIsNatualCurrency = IIf(recBudget!blnIsNatualCurrency = 1, True, False)
            'mblnIsOriginalCurrency = recBudget!blnIsOriginalCurrency
            mblnIsOriginalCurrency = IIf(recBudget!blnIsOriginalCurrency = 1, True, False)
            'mblnIsQuantity = recBudget!blnIsQuantity
            mblnIsQuantity = IIf(recBudget!blnIsQuantity = 1, True, False)
            lblbudget(11).Caption = recBudget!strBudgetName
            txtBudget(0).Text = gclsBase.AccountYear
            If mintFlag = 1 Then
                mstrName(0) = "采购数量"
                mstrName(1) = "销售数量"
                mstrName(2) = "销售成本"
                mstrName(3) = "库存数量"
                mstrName(4) = "受托数量"
                mstrName(5) = "委托数量"
                mstrName(6) = "分期数量"
                mstrName(7) = "加工数量"
                mstrName(8) = "领用数量"
                mstrName(9) = "采购金额"
                mstrName(10) = "销售收入"
                mstrName(11) = "毛利"
                mstrName(12) = "库存金额"
                mstrName(13) = "受托金额"
                mstrName(14) = "委托金额"
                mstrName(15) = "分期金额"
                mstrName(16) = "加工金额"
                mstrName(17) = "领用金额"
                mstrName(18) = "回款数量"
                mstrName(19) = "回款金额"
                mstrName(20) = "付款数量"
                mstrName(21) = "付款金额"
                mstrName(22) = "采购订单数量"
                mstrName(23) = "采购订单金额"
                mstrName(24) = "销售订单数量"
                mstrName(25) = "销售订单金额"
                intCnt = 0
                For intCount = 18 To 43
                    'If recBudget.rdoColumns(intCount).Value Then
                    If recBudget.rdoColumns(intCount).Value = 1 Then
                        mstrObjectName(intCnt) = mstrName(intCount - 18)
                        intCnt = intCnt + 1
                    End If
                    If intCnt > 2 Then
                        Exit For
                    End If
                Next intCount
                mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
                mstrQuantityDec = mstrDec
                mstrCurrDec = mstrDec
            Else
                mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
                mstrQuantityDec = IIf(gclsBase.QuantityDec = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.QuantityDec, "0"))
            End If
        End If
        GetPeriodNO gclsBase.AccountYear
        InitFlexGrid
        If mintFlag = 0 Then
            SetListText 8
            lstBudget(8).ReferRow = 0
            mblnIsload(8) = True
            If mblnIsOriginalCurrency Then
                lstBudget(8).Enabled = True
            Else
                lstBudget(8).Enabled = False
            End If
        End If
        mblnIsInput = False
        mblnIsAddNew = True
        mlngListID(9) = 0
        If mintFlag = 1 Then
            Me.Caption = "新增经营预算"
        Else
            Me.Caption = "新增财务预算"
        End If
        For intCount = 0 To 12
            mlngID(intCount) = 0
            If intCount <> 9 Then
                lstBudget(intCount).Enabled = True
                lstBudget(intCount).TabStop = True
            End If
        Next
        mlngBudgetID = BudgetID
        ReSetColWidth
        mblnIsChange = False
    End If
    
    intCount = 2
    If GetString(strValue, strResult, intCount) Then
        For intIndex = 1 To 12
            If GetString(strResult, strObj, intIndex, Asc(";")) Then
                If GetString(strObj, strData1, 1, Asc("=")) Then
                    If GetString(strObj, strData2, 2, Asc("=")) Then
                        Select Case strData1
                        Case "科目"
                            lstBudget_GotFocus 0
                            lstBudget(0).SeekId CodeToID("Account", "strAccountCode", "lngAccountID", strData2)
                        Case "商品"
                            lstBudget_GotFocus 1
                            lstBudget(1).SeekId CodeToID("Item", "strItemCode", "lngItemID", strData2)
                        Case "单位"
                            lstBudget_GotFocus 2
                            lstBudget(2).SeekId CodeToID("Customer", "strCustomerCode", "lngCustomerID", strData2)
                        Case "部门"
                            lstBudget_GotFocus 3
                            lstBudget(3).SeekId CodeToID("Department", "strDepartmentCode", "lngDepartmentID", strData2)
                        Case "职员"
                            lstBudget_GotFocus 4
                            lstBudget(4).SeekId CodeToID("Employee", "strEmployeeCode", "lngEmployeeID", strData2)
                        Case "工程"
                            lstBudget_GotFocus 5
                            lstBudget(5).SeekId CodeToID("Job", "strJobCode", "lngJobID", strData2)
                        Case "统计"
                            lstBudget_GotFocus 6
                            lstBudget(6).SeekId CodeToID("Class1", "strClassCode", "lngClassID", strData2)
                        Case "项目"
                            lstBudget_GotFocus 7
                            lstBudget(7).SeekId CodeToID("Class2", "strClassCode", "lngClassID", strData2)
                        Case "币种"
                            lstBudget_GotFocus 8
                            lstBudget(8).SeekId CodeToID("Currencys", "strCurrencyName", "lngCurrencyID", strData2)
                        Case "商品类型"
                            lstBudget_GotFocus 10
                            lstBudget(10).SeekId CodeToID("ItemType", "strItemTypeCode", "lngItemTypeID", strData2)
                        Case "单位类型"
                            lstBudget_GotFocus 11
                            lstBudget(11).SeekId CodeToID("CustomerType", "strCustomerTypeCode", "lngCustomerTypeID", strData2)
                        Case "地区"
                            lstBudget_GotFocus 12
                            lstBudget(12).SeekId CodeToID("Area", "strAreaCode", "lngAreaID", strData2)
                        End Select
                    End If
                End If
            End If
        Next intIndex
    End If

    intCount = intCount + 1
    If GetString(strValue, strResult, intCount) Then
        If GetString(strResult, strData1, 1, Asc(".")) Then
            If CLng(strData1) <> CLng(txtBudget(0).Text) Then
                txtBudget(0).Text = strData1
                GetPeriodNO CLng(strData1)
                InitFlexGrid
            End If
            If GetString(strResult, strData2, 2, Asc(".")) Then
                msgBudget(0).Row = CLng(strData2)
            End If
        End If
    End If
    
    intCount = intCount + 1
    If GetString(strValue, strResult, intCount) Then
        For intIndex = 1 To 3
            If GetString(strResult, strData1, intIndex, Asc(";")) Then
                If mintFlag = 1 And mdblFactor > 0 And Right(msgBudget(0).TextMatrix(0, intIndex), 2) = "数量" Then
                    msgBudget(0).TextMatrix(msgBudget(0).Row, intIndex) = MinToNormalQty(C2Dbl(strData1), mdblFactor)
                Else
                    msgBudget(0).TextMatrix(msgBudget(0).Row, intIndex) = C2Dbl(strData1)
                End If
            End If
        Next intIndex
    End If
    mblnImport = True
End Function

Private Function CodeToID(ByVal strTable As String, ByVal strField As String, _
    ByVal strIDField As String, ByVal strCode As String) As Long
    Dim strSql As String
    Dim recX As rdoResultset
    
    On Error Resume Next
    
    strSql = "SELECT " & strIDField & " As ID FROM " & strTable & " WHERE  " & strField & "='" & strCode & "'"
    Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recX.EOF Then
        CodeToID = recX.rdoColumns(0)
    End If
    recX.Close
End Function


'修改计划预算
Public Function EditCard(ByVal intModal As Integer, ByVal BudgetName As String, ByVal Year As String _
    , IsShow() As Boolean, Budget() As String, ID() As Long, BudgetID As Long, IsNatualCurrency As Boolean _
    , IsOriginalCurrency As Boolean, IsQuantity As Boolean, ByVal intType As Integer, strName() As String) As Boolean
    Dim intCount As Integer
    
    mblnIsInput = False
    mintFlag = intType
    mblnImportBuget = True
    If mintFlag = 1 Then
        For intCount = 0 To 2
            mstrObjectName(intCount) = strName(intCount)
        Next
        mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
        mstrQuantityDec = mstrDec
        mstrCurrDec = mstrDec
    Else
        mstrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
        mstrQuantityDec = IIf(gclsBase.QuantityDec = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.QuantityDec, "0"))
    End If
    mblnIsNatualCurrency = IsNatualCurrency
    mblnIsOriginalCurrency = IsOriginalCurrency
    mblnIsQuantity = IsQuantity
    mblnIsAddNew = False
    mlngListID(9) = 0
    GetPeriodNO Year
    If intType = 1 Then
        Me.Caption = "修改经营预算"
    Else
        Me.Caption = "修改财务预算"
    End If
    cmdBudget(2).Visible = False
    lblbudget(11).Caption = BudgetName
    txtBudget(0).Text = Year
    For intCount = 0 To 11
        If intCount < 9 Then
            If IsShow(intCount) Then
                lstBudget(intCount).Enabled = True
                lstBudget(intCount).TabStop = True
                lstBudget(intCount).Text = Budget(intCount)
                mlngID(intCount) = ID(intCount)
            Else