budgetcard.frm

金算盘软件代码

                lstBudget(intCount).Enabled = False
                lstBudget(intCount).TabStop = False
                mlngID(intCount) = 0
            End If
        Else
            If IsShow(intCount) Then
                lstBudget(intCount + 1).Enabled = True
                lstBudget(intCount + 1).TabStop = True
                lstBudget(intCount + 1).Text = Budget(intCount)
                mlngID(intCount + 1) = ID(intCount)
            Else
                lstBudget(intCount + 1).Enabled = False
                lstBudget(intCount + 1).TabStop = False
                mlngID(intCount + 1) = 0
            End If
        End If
    Next
    If mintFlag = 0 Then
        SetListText 8
        mblnIsload(8) = True
        If Not IsOriginalCurrency And IsNatualCurrency Then
            lstBudget(8).SeekId -1
        Else
            lstBudget(8).SeekId mlngID(8)
        End If
    Else
        SetListText 1
        lstBudget(1).SeekId mlngID(1)
        mblnIsload(1) = True
    End If
    mlngBudgetID = BudgetID
    ReSetColWidth
    GetBudget mlngID
    SetListText 9
    mblnIsload(9) = True
    lstBudget(9).SeekId mlngBudgetID
    mblnIsChange = False
     On Error Resume Next
    msgBudget(0).SetFocus
    Me.Show intModal
End Function

'得到期间数
Private Sub GetPeriodNO(ByVal intYear As Integer)
    Dim recTemp As rdoResultset
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT bytPeriodNO FROM AccountYear WHERE intYear=" & intYear, rdOpenStatic)
    If Not recTemp.EOF Then
        mintPeriodNO = recTemp("bytPeriodNO")
    Else
    
    End If
    recTemp.Close
End Sub

'得到币种小数格式串
Private Function GetCurrDec(ByVal lngCurrencyID As Long) As String
    Dim recTemp As rdoResultset
    
    If lngCurrencyID = -1 Then
        GetCurrDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "#,###,###,##0." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
    Else
        Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT bytCurrencyDec FROM Currencys WHERE lngCurrencyID=" & lngCurrencyID, rdOpenStatic)
        With recTemp
            If Not .EOF Then
                GetCurrDec = IIf(!bytCurrencydec = 0, "#,###,###,###", "#,###,###,##0." + String(!bytCurrencydec, "0"))
            Else
                GetCurrDec = "Standard"
            End If
        End With
    End If
End Function

'根据商品ID找出其存货计量单位折算因子
Public Function ConvertFactor(ByVal ItemID As Long) As Double
    Dim recTmp As rdoResultset
    Dim strSql As String
    
    'strSql = " SELECT dblfactor FROM Item INNER JOIN ItemUnit" _
        & " ON Item.lngStockUnitID=ItemUnit.lngUnitID WHERE Item.lngItemID=" & ItemID
    strSql = " SELECT dblfactor FROM Item,ItemUnit" _
        & " WHERE Item.lngStockUnitID=ItemUnit.lngUnitID AND Item.lngItemID=" & ItemID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
        ConvertFactor = recTmp!dblFactor
    Else
        ConvertFactor = 0
    End If
    recTmp.Close
End Function

'初试化会计年度
Private Sub InitAccountYear()
    Dim recTemp As rdoResultset
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT intYear FROM AccountYear", rdOpenStatic)
    Do While Not recTemp.EOF
        cboYear.AddItem recTemp("intYear")
        recTemp.MoveNext
    Loop
    If cboYear.ListCount > 0 Then
        cboYear.ListIndex = 0
    End If
    recTemp.Close
End Sub

'初始化FLEXGRID
Private Sub InitFlexGrid()
    Dim intCount As Integer
    Dim intCnt As Integer
    
    For intCnt = 0 To 1
        With msgBudget(intCnt)
            .Rows = mintPeriodNO + 2
            .TextMatrix(0, 0) = "期间"
            If mintFlag = 1 Then
                .TextMatrix(0, 1) = mstrObjectName(0)
                .TextMatrix(0, 2) = mstrObjectName(1)
                .TextMatrix(0, 3) = mstrObjectName(2)
            Else
                .TextMatrix(0, 1) = "原币"
                .TextMatrix(0, 2) = "本币"
                .TextMatrix(0, 3) = "数量"
            End If
            For intCount = 1 To mintPeriodNO
                .TextMatrix(intCount, 0) = intCount
            Next
            .TextMatrix(mintPeriodNO + 1, 0) = "总计"
            .ColAlignment(0) = 4
            .Row = 0
            For intCount = 1 To 3
                .col = intCount
                .CellAlignment = 4
            Next
            .ColWidth(0) = 450
            For intCount = 1 To 3
                .ColWidth(intCount) = 765
            Next
            If mintPeriodNO = 13 Then
                .RowHeightMin = 240
            Else
                .RowHeightMin = 255
            End If
        End With
    Next
End Sub

'得到预算
Private Sub GetBudget(ID() As Long)
    Dim strSql As String
    Dim intCount As Integer
    Dim recTemp As rdoResultset
    Dim dblValue As Double
    
    strSql = " SELECT * FROM BudgetBalance WHERE lngBudgetID=" & mlngBudgetID & " AND intYear=" _
        & txtBudget(0).Text & " AND lngAccountID=" & ID(0) & " AND lngItemID=" & ID(1) _
        & " AND lngCustomerID=" & ID(2) & " AND lngDepartmentID=" & ID(3) _
        & " AND lngEmployeeID=" & ID(4) & " AND lngJobID=" & ID(5) & " AND lngClassID1=" _
        & ID(6) & " AND lngClassID2=" & ID(7) & " AND lngCurrencyID=" & ID(8) _
        & " AND lngItemTypeId=" & ID(10) & " AND lngCustomerTypeID=" & ID(11) _
        & " AND lngAreaId=" & ID(12)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With msgBudget(0)
        For intCount = 1 To mintPeriodNO
            .TextMatrix(intCount, 1) = ""
            .TextMatrix(intCount, 2) = ""
            .TextMatrix(intCount, 3) = ""
        Next
        If recTemp.RowCount > 0 Then
            Do While Not recTemp.EOF
                If mintFlag = 1 Then
                    For intCount = 1 To 3
                        Select Case intCount
                            Case 1
                                dblValue = recTemp!dblCurrencyBudget
                            Case 2
                                dblValue = recTemp!dblBudget
                            Case 3
                                dblValue = recTemp!dblQuantityBudget
                        End Select
                        If Right(mstrObjectName(intCount - 1), 2) = "数量" _
                            And lstBudget(1).ID > 0 Then
                            If dblValue = 0 Then
                                .TextMatrix(recTemp("bytPeriod"), intCount) = ""
                            Else
                                .TextMatrix(recTemp("bytPeriod"), intCount) = BillPublic.DisplayData(Me.hwnd, NumberConvert(dblValue, mdblFactor, False), mdblFactor)
                            End If
                        Else
                            .TextMatrix(recTemp("bytPeriod"), intCount) = IIf(dblValue = 0, _
                                "", Format(dblValue, mstrDec))
                        End If
                    Next
                Else
                    .TextMatrix(recTemp("bytPeriod"), 1) = IIf(recTemp("dblCurrencyBudget") = 0, _
                        "", Format(recTemp("dblCurrencyBudget"), mstrCurrDec))
                    .TextMatrix(recTemp("bytPeriod"), 2) = IIf(recTemp("dblBudget") = 0, _
                        "", Format(recTemp("dblBudget"), mstrDec))
                    .TextMatrix(recTemp("bytPeriod"), 3) = IIf(recTemp("dblQuantityBudget") = 0, _
                        "", Format(recTemp("dblQuantityBudget"), mstrQuantityDec))
                    .RowData(recTemp("bytPeriod")) = 2
                End If
                recTemp.MoveNext
            Loop
            For intCount = 1 To 3
                CalSum 0, intCount
            Next
        End If
         .Refresh
    End With
    recTemp.Close
End Sub

'得到参照预算
Private Sub GetRefBudget()
    Dim strSql As String
    Dim intCnt As Integer
    Dim intCount As Integer
    Dim lngID(12) As Long
    Dim recTemp As rdoResultset
    Dim dblValue As Double
    
    getID lngID
    If cboYear.Text = "" Then
        ClearBudget 1
        Exit Sub
    End If
    strSql = " SELECT * FROM BudgetBalance WHERE lngBudgetID=" & lngID(9) & " AND intYear=" _
        & cboYear.Text & " AND lngAccountID=" & lngID(0) & " AND lngItemID=" & lngID(1) _
        & " AND lngCustomerID=" & lngID(2) & " AND lngDepartmentID=" & lngID(3) _
        & " AND lngEmployeeID=" & lngID(4) & " AND lngJobID=" & lngID(5) & " AND lngClassID1=" _
        & lngID(6) & " AND lngClassID2=" & lngID(7) & " AND lngCurrencyID=" & lngID(8) _
        & " AND lngItemTypeId=" & lngID(10) & " AND lngCustomerTypeID=" & lngID(11) _
        & " AND lngAreaID=" & lngID(12)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With msgBudget(1)
        ClearBudget 1
        If Not recTemp.EOF Then
            Do While Not recTemp.EOF
                If mintFlag = 1 Then
                    For intCount = 1 To 3
                        Select Case intCount
                            Case 1
                                dblValue = recTemp!dblCurrencyBudget
                            Case 2
                                dblValue = recTemp!dblBudget
                            Case 3
                                dblValue = recTemp!dblQuantityBudget
                        End Select
                        If Right(mstrObjectName(intCount - 1), 2) = "数量" _
                            And lstBudget(1).ID > 0 Then
                            If dblValue = 0 Then
                                .TextMatrix(recTemp("bytPeriod"), intCount) = ""
                            Else
                                .TextMatrix(recTemp("bytPeriod"), intCount) = BillPublic.DisplayData(Me.hwnd, NumberConvert(dblValue, mdblFactor, False), mdblFactor)
                            End If
                        Else
                            .TextMatrix(recTemp("bytPeriod"), intCount) = IIf(dblValue = 0, _
                            "", Format(dblValue, mstrDec))
                        End If
                    Next
                Else
                    .TextMatrix(recTemp("bytPeriod"), 1) = IIf(recTemp("dblCurrencyBudget") = 0, _
                        "", Format(recTemp("dblCurrencyBudget"), mstrCurrDec))
                    .TextMatrix(recTemp("bytPeriod"), 2) = IIf(recTemp("dblBudget") = 0, _
                        "", Format(recTemp("dblBudget"), mstrDec))
                    .TextMatrix(recTemp("bytPeriod"), 3) = IIf(recTemp("dblQuantityBudget") = 0, _
                        "", Format(recTemp("dblQuantityBudget"), mstrQuantityDec))
                End If
                recTemp.MoveNext
            Loop
            For intCount = 1 To 3
                CalSum 1, intCount
            Next
        End If
    End With
    recTemp.Close
End Sub

'得到预算数值
Private Sub GetPractice()
    Dim strSql As String
    Dim recBudget As rdoResultset
    Dim recCode As rdoResultset
    Dim strCode As String
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    Dim strSelectPO As String
    Dim strSelectSO As String
    Dim strFromPO As String
    Dim strFromSO As String
    Dim strFromCM As String
    Dim strWherePO As String
    Dim strWhereSO As String
    Dim strWhereCM As String
    Dim blnTax As Boolean
    Dim intDirection As String
    Dim intBudgetType As Integer
    Dim blnBalance(2) As Boolean
    Dim bytSource(2) As Byte
    Dim intSource As Integer
    Dim intRow As Integer
    Dim intCount As Integer
    Dim dblFactor As Double
    Dim recItem As rdoResultset
    Dim lngRow As Long
    Dim lngCol As Long
    
    ClearBudget 1
    strSql = "SELECT * FROM Budget WHERE lngBudgetID=" & mlngBudgetID
    Set recBudget = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recBudget.EOF Then
        recBudget.Close
        Set recBudget = Nothing
        Exit Sub
    End If
    
    strSelect = ""