frmrelation.frm

金算盘软件代码

         Index           =   0
         Left            =   3510
         TabIndex        =   25
         Top             =   510
         Width           =   720
      End
   End
End
Attribute VB_Name = "frmRelation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''
'   固资变动资料
'   作者:肖宇
'   日期:98-07-03
'
''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mstrDate As String                  '当前时间
Private mstrAlterMethod As String           '变动方式名称

Private mclsList As Grid                            'Grid类
Private WithEvents mclsMainControl As MainControl   'MainControl类
Attribute mclsMainControl.VB_VarHelpID = -1

Private Sub cmdClose_Click(Index As Integer)
    Unload Me
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
End Sub

'以下代码先对窗体初始化,然后显示给定固资的所有信息
Private Sub Form_Load()
    Dim lngRow As Long
    Dim lngColumn As Long
    Dim recCard As Recordset
    Dim recType As Recordset
    Dim recAlter As Recordset
    Dim recCost As Recordset
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
   
    Set mclsList = New Grid
    Set mclsList.Grid = grdAux
    grdAux.ColWidth(0) = 0
    mclsList.SetupStyle
    mclsList.ListSetToGrid

    With grdAux
        For lngColumn = 1 To 6
            .FixedAlignment(lngColumn) = flexAlignRightBottom
            .ColAlignment(lngColumn) = flexAlignRightBottom
            .ColWidth(lngColumn) = .Width / 6.4
        Next lngColumn
        
        .TextMatrix(0, 1) = "附属设备"
        .TextMatrix(0, 2) = "规格型号"
        .TextMatrix(0, 3) = "计量单位"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"
        .TextMatrix(0, 6) = "备注"
    End With
    
    With frmScanFixCard
        cboFixCode = .cboFixCode
        tEdit1(4).Text = .tEdit1(4).Text
        tEdit1(1).Text = .tEdit1(1).Text
        tEdit1(5).Text = .tEdit1(5).Text
        tEdit1(2).Text = .tEdit1(2).Text
        tEdit1(6).Text = .tEdit1(6).Text
        tEdit1(3).Text = .tEdit1(3).Text
        tEdit1(7).Text = .tEdit1(7).Text

        ltxtFixedType.Text = .ltxtFixedType.Text
        
        Set recCard = gclsBase.BaseDB.OpenRecordset("FixedCard", dbOpenSnapshot)
        recCard.FindFirst "strFixedCardCode='" & tEdit1(4).Text & "'"
        Set recAlter = gclsBase.BaseDB.OpenRecordset("FixedAlter", dbOpenSnapshot)
        recAlter.FindFirst "lngFixedCardID=" & recCard!lngFixedCardID & _
                " and strDate='" & Format(Me.strDate, "yyyy-mm-dd") & "'"
        Select Case recAlter!strFixedState
            Case 1
                cboUseStatus = "使用中"
            Case 2
                cboUseStatus = "未使用"
            Case 3
                cboUseStatus = "不需用"
            Case 4
                cboUseStatus = "租出"
        End Select
       
        cboAlterMethod = Me.strAlterMethod
        cboDate = Me.strDate
        optSngDpm.Value = .optSngDpm.Value
        optMutiDpm.Value = .optMutiDpm.Value
        ltxtDpm.Text = .ltxtDpm.Text
        optSngAccount.Value = .optSngAccount.Value
        optMutiAccount.Value = .optMutiAccount.Value
        ltxtAcc.Text = .ltxtAcc.Text
        
        grdAux.Rows = .grdAux.Rows
        For lngRow = 0 To .grdAux.Rows - 1
            For lngColumn = 1 To .grdAux.Cols - 1
                grdAux.TextMatrix(lngRow, lngColumn) = .grdAux.TextMatrix(lngRow, lngColumn)
            Next lngColumn
        Next lngRow
        
        tEdit1(8).Text = .tEdit1(8).Text
        
        optSngCurr.Value = .optSngCurr.Value
        ltxtCurr.Text = .ltxtCurr.Text
        TEdit2(0).Text = .TEdit2(0).Text
        Set recCost = gclsBase.BaseDB.OpenRecordset("FixedCost", dbOpenSnapshot)
        recCost.FindFirst "lngFixedAlterID=" & recAlter!lngFixedAlterID
        TEdit2(1).Text = recCost!dblCurrAmount
        TEdit2(2).Text = recCost!dblAmount
        optMutiCurr.Value = .optMutiCurr.Value
            
        TEdit4(0).Text = recAlter!dblDeprection
        TEdit4(1).Text = CStr(CDbl(TEdit2(2).Text) - recAlter!dblDeprection)
        
        Select Case recAlter!strDepreciationMethod
            Case 1
                cboDepreMethod = "不计提折旧"
            Case 2
                cboDepreMethod = "平均年限法"
            Case 3
                cboDepreMethod = "工作量法"
            Case 4
                cboDepreMethod = "双倍余额递减法"
            Case 5
                cboDepreMethod = "年数总和法"
        End Select
        
        If cboDepreMethod = "工作量法" Then
            Label18(0).Visible = False
            spinYears.Visible = False
            Label18(2).Visible = False
            lblPerYear.Visible = False
            Label18(3).Visible = False
            lblPerPeriod.Visible = False
            Label18(4).Visible = False
            lblRateOfYear.Visible = False
            Label18(5).Visible = False
            lblRateOfMonth.Visible = False
            
            Label2(2).Visible = True
            txtTotalWork.Visible = True
            txtTotalWork.Text = CStr(recAlter!dblTotalWork)
            Label2(0).Visible = True
            Label2(1).Visible = True
            lblUnitWork.Visible = True
            txtUnit.Visible = True
            txtUnit.Text = recCard!strWorkUnit
        Else
            Label18(0).Visible = True
            spinYears.Visible = True
            spinYears.Text = CStr(recAlter!intUseAge)
            Label18(2).Visible = True
            lblPerYear.Visible = True
            Label18(3).Visible = True
            lblPerPeriod.Visible = True
            Label18(4).Visible = True
            lblRateOfYear.Visible = True
            Label18(5).Visible = True
            lblRateOfMonth.Visible = True
        
            Label2(2).Visible = False
            txtTotalWork.Visible = False
            Label2(0).Visible = False
            Label2(1).Visible = False
            lblUnitWork.Visible = False
            txtUnit.Visible = False
            If cboDepreMethod = "双倍余额递减法" Or cboDepreMethod = "年数总和法" Then
                Label18(2).Visible = False
                lblPerYear.Visible = False
                Label18(4).Visible = False
                lblRateOfYear.Visible = False
            End If
            If cboDepreMethod = "年数总和法" Then
                Label18(3).Visible = False
                lblPerPeriod.Visible = False
                Label18(5).Visible = False
                lblRateOfMonth.Visible = False
            End If
        End If
        
        Set recType = gclsBase.BaseDB.OpenRecordset("FixedType", dbOpenSnapshot)
        recType.FindFirst "strFixedTypeName='" & ltxtFixedType.Text & "'"
        txtNet.Text = CStr(recAlter!dblNetWorth)
            
        If recAlter!strDeprectionFactor = "2" Then
            opt1.Value = True
        Else
            opt2.Value = True
        End If
        
        ComputeDeprection
        
        cldDateOfUse.Text = .cldDateOfUse.Text
        chkDate.Value = .chkDate.Value
        
        If cboDepreMethod = "工作量法" Then
            Label27 = "已提折旧工作量"
            spinPeriods.Text = CStr(recCard!intStartWork)
        Else
            Label27 = "已提折旧期间数"
            spinPeriods.Text = CStr(recCard!intStartPeriod)
        End If
    End With
    
    SetHelpID Me.hwnd, 30007
End Sub

'计算折旧
Private Sub ComputeDeprection()
    Dim dblAmount As Double                 '原值
    Dim dblNetWorth As Double               '预计净残值
    Dim dblTmp As Double                    '预计工作总量/使用年限
    Dim dblTmpBak As Double
    Dim lngPeriods As Long
    Dim dblDeprePerUnit As Double           '单位工作量折旧
    Dim dblDeprePerYear As Double           '年折旧额
    Dim dblDeprePerMonth As Double          '月折旧额
    Dim dblDepreRatePerYear As Double       '年折旧率
    Dim dblDepreRatePerMonth As Double      '月折旧率
    Dim dblWorkOfMonth As Double            '月工作量
    Dim dblDepreOfYear As Double
    
    Select Case cboDepreMethod
        Case "工作量法"
            dblTmp = CDbl(txtTotalWork.Text)
        Case "不计提折旧"
            Exit Sub
        Case Else
            dblTmp = CDbl(spinYears.Text)
    End Select
    
    If IsNumeric(TEdit4(1).Text) And IsNumeric(txtNet.Text) Then
        If CDbl(TEdit4(1).Text) < CDbl(txtNet.Text) Then
            Exit Sub
        End If
    End If
    
    '先用平均年限法计算以便与双倍余额递减法的结果相比较
    dblAmount = CDbl(TEdit2(2).Text)
    dblNetWorth = CDbl(txtNet.Text)
    
    On Error GoTo HandleErr
    
    If opt1.Value Then
        dblAmount = CDbl(TEdit4(1).Text)
        If chkDate.Value Then
            dblTmpBak = dblTmp
            dblTmp = dblTmp - CDbl(spinPeriods.Text) / 12
        End If
    End If
    dblDepreRatePerYear = 100 / dblTmp
    dblDepreRatePerMonth = dblDepreRatePerYear / 12
    dblDepreOfYear = (dblAmount - CDbl(txtNet.Text)) / dblTmp
    
    '再按选定的折旧方法计算
    dblTmp = dblTmpBak
    dblAmount = CDbl(TEdit2(2).Text)
    dblNetWorth = CDbl(txtNet.Text)
    Select Case cboDepreMethod
        Case "平均年限法"
            If opt1.Value Then
                dblAmount = CDbl(TEdit4(1).Text)
                lngPeriods = dblTmp * 12 - CDbl(spinPeriods.Text)
                If chkDate.Value Then
                    dblTmp = dblTmp - CDbl(spinPeriods.Text) / 12
                End If
            Else
                lngPeriods = dblTmp * 12
            End If
            dblDepreRatePerMonth = 100 / lngPeriods
            dblDepreRatePerYear = dblDepreRatePerMonth * 12
            If dblDepreRatePerYear > 100 Then
                dblDepreRatePerYear = 100
            End If
            dblDeprePerYear = (dblAmount - CDbl(txtNet.Text)) * dblDepreRatePerYear / 100
            dblDeprePerMonth = (dblAmount - CDbl(txtNet.Text)) * dblDepreRatePerMonth / 100
            
            lblPerYear = Format(dblDeprePerYear, ".00")
            If InStr(lblPerYear, ".") = 1 Then
                lblPerYear = "0" & lblPerYear
            End If
            lblPerPeriod = Format(dblDeprePerMonth, ".00")
            If InStr(lblPerPeriod, ".") = 1 Then
                lblPerPeriod = "0" & lblPerPeriod
            End If
            lblRateOfYear = Format(dblDepreRatePerYear, ".00") & "%"
            If InStr(lblRateOfYear, ".") = 1 Then
                lblRateOfYear = "0" & lblRateOfYear
            End If
            lblRateOfMonth = Format(dblDepreRatePerMonth, ".00") & "%"
            If InStr(lblRateOfMonth, ".") = 1 Then
                lblRateOfMonth = "0" & lblRateOfMonth
            End If
            
        Case "工作量法"
            If opt1.Value Then
                dblAmount = CDbl(TEdit4(1).Text)
                If chkDate.Value Then
                    dblTmp = dblTmp - CDbl(spinPeriods.Text)
                End If
            End If
            dblDeprePerUnit = (dblAmount - CDbl(txtNet.Text)) / dblTmp
            dblDeprePerMonth = dblDeprePerUnit * dblWorkOfMonth
            lblUnitWork = Format(dblDeprePerUnit, ".00")
            If InStr(lblUnitWork, ".") = 1 Then
                lblUnitWork = "0" & lblUnitWork
            End If
            
        Case "双倍余额递减法"
'            Label18(3).Visible = False
'            Label18(4).Visible = False
'            Label18(5).Visible = False
'            lblPerPeriod.Visible = False
'            lblRateOfYear.Visible = False
'            lblRateOfMonth.Visible = False
'
'            If opt1.Value Then
'                If chkDate.Value Then
'                    dblTmp = dblTmp - Int(CDbl(spinPeriods.Text) / 12)
'                End If
'                dblDeprePerYear = CDbl(TEdit4(1).Text) * 2 / dblTmp
'            Else
'                dblDeprePerYear = CDbl(TEdit2(2).Text) * 2 / CDbl(spinYears.Text)
'            End If
'            '取双倍余额递减法和平均年限法二者中的大者做结果
'            If dblDeprePerYear >= dblDepreOfYear Then
'                lblPerYear = Format(dblDeprePerYear, ".00")
'            Else
'                lblPerYear = Format(dblDepreOfYear, ".00")
'            End If
'            If InStr(lblPerYear, ".") = 1 Then
'                lblPerYear = "0" & lblPerYear
'            End If
            
        Case "年数总和法"
'            Label18(3).Visible = False
'            Label18(5).Visible = False
'            lblPerPeriod.Visible = False
'            lblRateOfMonth.Visible = False
'
'            If opt1.Value Then
'                dblAmount = CDbl(TEdit4(1).Text)
'                If chkDate.Value Then
'                    dblTmp = dblTmp - Int(CDbl(spinPeriods.Text) / 12)
'                End If
'            End If
'            dblDepreRatePerYear = 200 / (dblTmp + 1)
'            dblDeprePerYear = (dblAmount - CDbl(txtNet.Text)) * 2 / (dblTmp + 1)
'            lblPerYear = Format(dblDeprePerYear, ".00")
'            If InStr(lblPerYear, ".") = 1 Then
'                lblPerYear = "0" & lblPerYear
'            End If
'            lblRateOfYear = Format(dblDepreRatePerYear, ".00") & "%"
'            If InStr(lblRateOfYear, ".") = 1 Then
'                lblRateOfYear = "0" & lblRateOfYear
'            End If
    End Select
HandleErr:
End Sub

'当前日期(属性)
Public Property Get strDate() As String
    strDate = mstrDate
End Property

Public Property Let strDate(ByVal vNewValue As String)
    mstrDate = vNewValue
End Property

'变动方式名称(属性)
Public Property Get strAlterMethod() As String
    strAlterMethod = mstrAlterMethod
End Property

Public Property Let strAlterMethod(ByVal vNewValue As String)
    mstrAlterMethod = vNewValue
End Property

Private Sub Form_Resize()
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
        Me.Left = 300
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    gclsSys.MainControls.Remove Me

End Sub