frmfixedalterinfo.frm

金算盘软件代码

Private mlngFixedAlterID As Long
Private mlngFixedCardID As Long
Private mclsList As Grid                'Grid类

Function GetAux(ByVal lngCardID As Long) As Recordset
    Dim strSql As String
    
    strSql = "SELECT lngFixedAuxID," & mclsList.ListSet.SelectOfSql & " FROM FixedAux WHERE lngFixedCardID=" & lngCardID
    Set GetAux = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
End Function

'显示固资信息
Private Sub DispCard(ByVal lngAlterID As Long, ByVal lngCardID As Long)
    Dim strSql As String
    Dim recCard As Recordset
    Dim recType As Recordset
    Dim recAlter As Recordset
    Dim recMethod As Recordset
    Dim recFixDpm As Recordset
    Dim recFixAcc As Recordset
    Dim recFixAux As Recordset
    Dim recCost As Recordset
    
    On Error Resume Next
    Me.MousePointer = vbHourglass
    
    strSql = "SELECT * FROM FixedAlter WHERE lngFixedAlterID=" & lngAlterID
    Set recAlter = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    If Not recAlter.EOF Then
        cboUseStatus.Text = UseStatus(recAlter!strFixedState)
        lngCardID = recAlter!lngFixedCardID
        mlngFixedCardID = recAlter!lngFixedCardID
        mlngFixedAlterID = recAlter!lngFixedAlterID
        cboAddMethod.Text = FixedMethodName(recAlter!lngFixedMethodID)
        cboDate = recAlter!strDate

        strSql = "SELECT Department.* FROM FixedDepartment INNER JOIN Department ON " _
            & "FixedDepartment.lngDepartmentID=Department.lngDepartmentID " _
            & "WHERE lngFixedAlterID=" & lngAlterID
        Set recFixDpm = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        If Not recFixDpm.EOF Then
            recFixDpm.MoveLast
        End If
        With recFixDpm
            If .RecordCount = 1 Then
                optSngDpm.Value = True
                ltxtDpm.Text = !strDepartmentCode & " " & !strDepartmentName
            Else
                optMutiDpm.Value = True
                cmdMutiDpm.Enabled = True
                frmMutiDpm.AlterID = lngAlterID
                ltxtDpm.Text = ""
            End If
        End With
        recFixDpm.Close
        
        strSql = "SELECT Account.* FROM FixedAccount INNER JOIN Account ON " _
            & "FixedAccount.lngAccountID=Account.lngAccountID " _
            & "WHERE lngFixedAlterID=" & lngAlterID
        Set recFixAcc = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        With recFixAcc
            If Not recFixAcc.EOF Then
                .MoveLast
            End If
            If .RecordCount = 1 Then
                optSngAccount.Value = True
                ltxtAcc.Text = !strAccountCode & " " & !strAccountName
            Else
                optMutiAccount.Value = True
                ltxtAcc.Text = ""
                frmMutiAccount.AlterID = lngAlterID
                cmdMutiAccount.Enabled = True
            End If
        End With
        
        strSql = "SELECT FixedCost.lngCurrencyID As lngCurrencyID,FixedCost.*,Currencys.* " _
            & "FROM FixedCost INNER JOIN Currencys ON FixedCost.lngCurrencyID=Currencys.lngCurrencyID " _
            & "WHERE lngFixedAlterID=" & lngAlterID
        Set recCost = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        With recCost
            If Not .EOF Then .MoveLast
                If .RecordCount = 1 Then
                    optSngCurr.Value = True
                    ltxtCurr.Text = !strCurrencyCode & " " & !strCurrencyName
                    TEdit2(0).Text = Format(!dblRate, "0." & String(!bytRateDec, "0"))
                    TEdit2(1).Text = Format(!dblCurrAmount, "0." & String(!bytCurrencyDec, "0"))
                    TEdit2(2).Text = Format(!dblAmount, "0.00")
                Else
                    optMutiCurr.Value = True
                    ltxtCurr.Text = ""
                    TEdit2(2).Text = Format(recAlter!dblAmount, "0.00")
                    frmMutiCurr.AlterID = lngAlterID
                    cmdMutiCurr.Enabled = True
                End If
        End With

        tEdit1(8).Text = recAlter!strNote
        TEdit4(0).Text = Format(recAlter!dblDeprection, "0.00")
        TEdit4(1).Text = Format(C2Dbl(TEdit2(2).Text) - recAlter!dblDeprection, "0.00")
        cboDepreMethod.Text = DeprectionMethod(recAlter!strDepreciationMethod)

        If cboDepreMethod.Text = "工作量法" Then
            Label18(0).Visible = False
            Label18(1).Visible = True
            Label18(2).Visible = False
            Label18(3).Visible = False
            Label18(4).Visible = False
            Label18(5).Visible = False
            SpinYears.Visible = False
            SpinPeriods.Visible = False
            lblPerYear.Visible = False
            lblPerPeriod.Visible = False
            lblRateOfyear.Visible = False
            lblRateOfMonth.Visible = False

            Label2(2).Visible = True
            Label2(0).Visible = True
            Label2(1).Visible = True
            txtTotalWork.Visible = True
            txtTotalWork.Text = recAlter!dblTotalWork
            lblUnitWork.Visible = True
            txtUnit.Visible = True
            txtWorkofUsed.Visible = True
        ElseIf cboDepreMethod.Text = "不计提折旧" Then
            Label18(0).Visible = False
            Label18(1).Visible = True
            Label18(2).Visible = False
            Label18(3).Visible = False
            Label18(4).Visible = False
            Label18(5).Visible = False
            SpinYears.Visible = False
            SpinPeriods.Visible = False
            lblPerYear.Visible = False
            lblPerPeriod.Visible = False
            lblRateOfyear.Visible = False
            lblRateOfMonth.Visible = False

            Label2(2).Visible = False
            Label2(0).Visible = False
            Label2(1).Visible = False
            txtTotalWork.Visible = False
            lblUnitWork.Visible = False
            txtUnit.Visible = False
            txtWorkofUsed.Visible = False
        Else
            Label18(0).Visible = True
            Label18(1).Visible = True
            Label18(2).Visible = True
            Label18(3).Visible = True
            Label18(4).Visible = True
            Label18(5).Visible = True
            SpinYears.Visible = True
            SpinYears.Text = recAlter!intUseAge
            lblPerYear.Visible = True
            lblPerPeriod.Visible = True
            lblRateOfyear.Visible = True
            lblRateOfMonth.Visible = True

            Label2(2).Visible = False
            Label2(0).Visible = False
            Label2(1).Visible = False
            txtTotalWork.Visible = False
            lblUnitWork.Visible = False
            txtUnit.Visible = False
            txtWorkofUsed.Visible = False
            SpinPeriods.Visible = True
        End If
        txtNet.Text = Format(recAlter!dblNetWorth, "0.00")

        If recAlter!strDeprectionFactor = "2" Then
            opt1.Value = True
        Else
            opt2.Value = True
        End If
    End If
    
    If lngCardID > 0 Then
        strSql = "SELECT * FROM FixedCard WHERE lngFixedCardID=" & lngCardID
        Set recCard = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        If Not recCard.EOF Then
            With recCard
                cboFixCode.Text = !strFixedCode & " " & !strFixedName
                tEdit1(4).Text = !strFixedCardCode
                tEdit1(1).Text = !strFixedName
                tEdit1(5).Text = !strFixedStyle
                tEdit1(2).Text = !strMadeIn
                tEdit1(6).Text = !strFeatures
                tEdit1(3).Text = !strPurpose
                tEdit1(7).Text = !strStock
    
                strSql = "SELECT * FROM FixedAlter WHERE lngFixedAlterID=" & !lngCreateFixedAlterID
                Set recAlter = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                If Not recAlter.EOF Then
                    lblOperator.Caption = OperatorName(recAlter!lngOperatorID)
                End If
                strSql = "SELECT * FROM FixedType WHERE lngFixedTypeID=" & !lngFixedTypeID
                Set recType = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                If Not recType.EOF Then
                    ltxtFixedType.Text = recType!strFixedTypeName
                End If
                recType.Close
                Set recType = Nothing
                If cboDepreMethod.Text = "工作量法" Then
                    Label27.Caption = "已提折旧工作量"
                    txtWorkofUsed.Text = !intStartWork
                    txtUnit.Text = !strWorkUnit
                Else
                    Label27.Caption = "已提折旧期间数"
                    SpinPeriods.Text = !intStartPeriod
                End If
                cldDateOfUse.Text = !strStartDate
                If IsDate(cldDateOfUse.Text) Then
                    chkDate.Value = True
                Else
                    chkDate.Value = False
                End If
            End With
        End If
        RefreshAuxList
    End If
    CalcDeprection
    
    recCard.Close
    recAlter.Close
    recCost.Close
    Set recCard = Nothing
    Set recType = Nothing
    Set recAlter = Nothing
    Set recMethod = Nothing
    Set recFixDpm = Nothing
    Set recFixAcc = Nothing
    Set recFixAux = Nothing
    Set recCost = Nothing
    Me.MousePointer = vbDefault
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdMutiAccount_Click()
    frmMutiAccount.EditCard mlngFixedAlterID, True
End Sub

Private Sub cmdMutiCurr_Click()
    frmMutiCurr.EditCard mlngFixedAlterID, True
End Sub

Private Sub cmdMutiDpm_Click()
    frmMutiDpm.EditCard mlngFixedAlterID, True
End Sub

Private Sub Form_Load()
    
    Set mclsList = New Grid
    mclsList.ListSet.ViewId = 652
    Set mclsList.Grid = grdAux
        
    Utility.LoadFormResPicture Me
    SetHelpID Me.hwnd, 20002
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.UnLoadFormResPicture Me
    Unload frmMutiCurr
    Unload frmMutiAccount
    Unload frmMutiDpm
    Set frmFixedAlterInfo = Nothing
End Sub

Private Sub CalcDeprection()
    Dim dblAmount As Double
    Dim dblDeprection As Double
    Dim dblNet As Double
    Dim lngPeriods As Integer
    Dim IntAges As Integer
    Dim lngTotalAges As Long
    Dim intUseAges As Integer
    Dim lngCnt As Long
    Dim dblAccuma As Double
    
    On Error Resume Next
    
    If cboDepreMethod.Text <> "工作量法" Then
        If opt1.Value Then
            dblAmount = TEdit4(1).Value
            dblDeprection = 0
            dblNet = txtNet.Value
            lngPeriods = CInt(SpinYears.Text) * 12 - CInt(SpinPeriods.Text)
            IntAges = -Int(-lngPeriods / 12)
            intUseAges = Int((IntAges * 12 - lngPeriods) / 12)
        Else
            dblAmount = TEdit2(2).Value
            dblDeprection = TEdit4(0).Value
            dblNet = txtNet.Value
            lngPeriods = CInt(SpinPeriods.Text)
            IntAges = CInt(SpinYears.Text)
            intUseAges = Int(lngPeriods / 12)
        End If
    Else
        dblAmount = TEdit2(2).Value
        dblNet = txtNet.Value
    End If
    
    Select Case cboDepreMethod.Text
    Case "平均年限法"
        If IntAges > 0 And dblAmount > 0 Then
            lblPerYear.Caption = Format((dblAmount - dblNet) / IntAges, "0.00")
            lblPerPeriod.Caption = Format(C2Dbl(lblPerYear.Caption) / 12, "0.00")
            lblRateOfyear.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount, "0.00%")
            lblRateOfMonth.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount / 12, "0.00%")
        Else
            lblPerYear.Caption = "0.00"
            lblPerPeriod.Caption = "0.00"
            lblRateOfyear.Caption = "0.00%"
            lblRateOfMonth.Caption = "0.00%"
        End If
    Case "工作量法"
        If txtTotalWork.Value > 0 And (dblAmount - dblNet) > 0 Then
            lblUnitWork.Caption = Format((dblAmount - dblNet) / txtTotalWork.Value, "0.00")
        Else
            lblUnitWork.Caption = "0.00"
        End If
    Case "年数总和法"
        If IntAges > 0 And dblAmount > 0 Then
            lngTotalAges = (1 + IntAges) * IntAges / 2
            lblPerYear.Caption = Format((dblAmount - dblNet) * (IntAges - intUseAges) / lngTotalAges, "0.00")
            lblPerPeriod.Caption = Format(C2Dbl(lblPerYear.Caption) / 12, "0.00")
            lblRateOfyear.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount, "0.00%")
            lblRateOfMonth.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount / 12, "0.00%")
        Else
            lblPerYear.Caption = "0.00"
            lblPerPeriod.Caption = "0.00"
            lblRateOfyear.Caption = "0.00%"
            lblRateOfMonth.Caption = "0.00%"
        End If
    Case "双倍余额递减法"
        If IntAges > 0 And dblAmount > 0 Then
            dblAccuma = 0
            For lngCnt = 1 To intUseAges
                dblAccuma = dblAccuma + (dblAmount - dblAccuma) * 2 / IntAges
            Next lngCnt
            lblPerYear.Caption = Format((dblAmount - dblAccuma) / IntAges * 2, "0.00")
            lblPerPeriod.Caption = Format(C2Dbl(lblPerYear.Caption) / 12, "0.00")
            lblRateOfyear.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount, "0.00%")
            lblRateOfMonth.Caption = Format(C2Dbl(lblPerYear.Caption) / dblAmount / 12, "0.00%")
        Else
            lblPerYear.Caption = "0.00"
            lblPerPeriod.Caption = "0.00"
            lblRateOfyear.Caption = "0.00%"
            lblRateOfMonth.Caption = "0.00%"
        End If
    End Select
End Sub

Private Sub RefreshAuxList()
    grdAux.FixedCols = 0
    If Not mclsList.Grid Is Nothing Then
        Set mclsList.Grid = Nothing
    End If
    mclsList.ColOfs = 0
    Set mclsList.Grid = grdAux
    Set datAux.Recordset = GetAux(mlngFixedCardID)
    mclsList.SetupStyle
    mclsList.ListSetToGrid
End Sub

Public Sub EditCard(ByVal lngFixedAlterID As Long, ByVal lngFixedCardID As Long)
    DispCard lngFixedAlterID, lngFixedCardID
    Show vbModal
End Sub