frmfixedtypecard.frm

金算盘软件代码

Private mstrDepreciationType As String
Private mstrDepreciationMethod As String
Private mdblNetWorthRate As Double
Private mdblTotalWork As Double
Private mintUseAge As Integer
Private mstrCodeManner As String
Private mstrPrefix As String
Private mintOrderDec As String
Private mdblDeprRate As Double

'引入固资类别
Public Function AddFixedType(ByVal strFixed As String) As Integer
    Dim strFixedTypeCode As String, strFixedTypeName As String
    Dim blnIsInActive As Boolean, strDepreciationType As String
    Dim strDepreciationMethod As String, dblNetWorthRate As Double
    Dim intUseAge As Integer, dblTotalWork As Double, dblDeprRate As Double
    Dim strTemp As String, strCodeManner As String
    Dim strPrefix As String, intOrderDec As String
    
    AddFixedType = 0
    If Not GetString(strFixed, strFixedTypeCode, 1) Then Exit Function
    If Not GetString(strFixed, strFixedTypeName, 2) Then Exit Function
    If Not GetString(strFixed, strTemp, 3) Then Exit Function
    blnIsInActive = (strTemp = "1")
    If Not GetString(strFixed, strDepreciationType, 4) Then Exit Function
    If Not GetString(strFixed, strDepreciationMethod, 5) Then Exit Function
    If Not GetString(strFixed, strTemp, 6) Then Exit Function
    dblNetWorthRate = CDbl(strTemp)
    If Not GetString(strFixed, strTemp, 7) Then Exit Function
    intUseAge = CInt(strTemp)
    If Not GetString(strFixed, strTemp, 8) Then Exit Function
    dblTotalWork = CDbl(strTemp)
    If Not GetString(strFixed, strCodeManner, 9) Then Exit Function
    If Not GetString(strFixed, strPrefix, 10) Then Exit Function
    If Not GetString(strFixed, strTemp, 11) Then Exit Function
    intOrderDec = TxtToDouble(strTemp)
    If Not GetString(strFixed, strTemp, 12) Then Exit Function
    dblDeprRate = TxtToDouble(strTemp)
    
    If strFixedTypeCode = "" Or strFixedTypeName = "" Then Exit Function
    txtInput(0).Text = strFixedTypeCode
    txtInput(1).Text = strFixedTypeName
    txtInput(2).Text = dblNetWorthRate
    cboFixedType(0).ListIndex = CInt(strDepreciationType) - 1
    cboFixedType(1).ListIndex = CInt(strDepreciationMethod) - 1
    If cboFixedType(1).ListIndex = 2 Then
        txtInput(3).Text = dblTotalWork
    Else
        txtInput(3).Text = intUseAge
    End If
    txtInput(4).Text = strPrefix
    optCode(strCodeManner).Value = True
    sptOrder.Value = intOrderDec
    txtInput(5).Text = dblDeprRate
    chkPause.Value = IIf(blnIsInActive, Checked, Unchecked)
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddFixedType = 1
End Function

Public Property Get getID() As Long
    getID = mlngFixedTypeID
End Property

'进入新增固资类型操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mblnIsNew = True
    mlngFixedTypeID = 0
    Caption = "新增固资类型"
    cmdOKCancel(2).Visible = True
    mblnIsList = IsList
    InitCard StringOut(strName)
    Show intModal
    AddCard = mlngFixedTypeID
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recFixedType As rdoResultset, strSql As String
    
    mblnIsInit = True
    mlngPCodeID = 0
    mblnPIsDetail = False
    mblnPIsInActive = False
    If mblnIsNew Then
        txtInput(1).Text = ""
        txtInput(0).Text = Trim(strName)
        txtInput(2).Text = ""
        txtInput(3).Text = ""
        lblTitle(5).Caption = "预计使用年限(&Y)"
        chkPause.Value = Unchecked
        cboFixedType(0).ListIndex = 0
        cboFixedType(1).ListIndex = 1
        chkPause.Value = Unchecked
    Else
        strSql = "SELECT * FROM FixedType WHERE lngFixedTypeID=" & mlngFixedTypeID
        Set recFixedType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        txtInput(0).Text = recFixedType!strFixedTypeCode
        txtInput(1).Text = recFixedType!strFixedTypeName
        txtInput(2).Text = FormatShow(recFixedType!dblNetWorthRate, 2)
        If recFixedType!strDepreciationType > "0" Then
            cboFixedType(0).ListIndex = CInt(recFixedType!strDepreciationType) - 1
        End If
        If recFixedType!strDepreciationMethod > "0" Then
            cboFixedType(1).ListIndex = CInt(recFixedType!strDepreciationMethod) - 1
            If cboFixedType(1).ListIndex = 2 Then
                lblTitle(5).Caption = "预计工作总量"
                txtInput(3).Text = FormatShow(recFixedType!dblTotalWork, 0)
            Else
                lblTitle(5).Caption = "预计使用年限(&Y)"
                txtInput(3).Text = FormatShow(recFixedType!intUseAge, 0)
                txtInput(3).MaxLength = 4
            End If
        End If
        txtInput(4).Text = Format(recFixedType!strPrefix, "@;;")
        txtInput(5).Text = FormatShow(recFixedType!dblDeprRate, 2)
        sptOrder.Value = Format(recFixedType!intOrderDec, "@;0;")
        optCode(recFixedType!strCodeManner).Value = True
        chkPause.Value = recFixedType!blnIsInActive
        mblnIsInActive = (recFixedType!blnIsInActive = 1)
        mblnIsDetail = (recFixedType!blnIsDetail = 1)
        mintOldLevel = recFixedType!intLevel
        mstrOldFullName = recFixedType!strFullName
        mstrOldCode = txtInput(0).Text
        mstrOldName = txtInput(1).Text
    End If
    mblnIsInit = False
End Sub
'进入修改固资类型操作
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strType As String)
    Dim strMess As String
    
    If Not CheckIDUsed("FixedType", "lngFixedTypeID", lngID) Then
        If Trim(strType) <> "" Then
            strMess = "“" & strType & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "固资类型不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改固资类型"
        Unload Me
    Else
        mblnIsNew = False
        mblnIsChanged = False
        mlngFixedTypeID = lngID
        Caption = "修改固资类型"
        cmdOKCancel(2).Visible = False
        cmdOKCancel(3).top = cmdOKCancel(2).top
        InitCard
        Show intModal
    End If
End Sub

Private Sub InitComboBox()
    cboFixedType(0).Clear
    cboFixedType(0).AddItem "正常计提折旧", 0
    cboFixedType(0).AddItem "永不计提折旧", 1
    cboFixedType(0).AddItem "永远计提折旧", 2
    cboFixedType(1).Clear
    If gclsBase.AccountSys = 4 Then
        cboFixedType(1).AddItem "不计提折旧", 0
        cboFixedType(1).AddItem "平均年限法", 1
        cboFixedType(1).AddItem "工作量法", 2
    Else
        cboFixedType(1).AddItem "不计提折旧", 0
        cboFixedType(1).AddItem "平均年限法", 1
        cboFixedType(1).AddItem "工作量法", 2
        cboFixedType(1).AddItem "双倍余额递减法", 3
        cboFixedType(1).AddItem "年数总和法", 4
        cboFixedType(1).AddItem "分类折旧率", 5
    End If
End Sub

Private Function AllowDel(ByVal lngID As Long, strAccount As String) As Integer
    Dim strSql As String, recAcn As rdoResultset
    
    strSql = "SELECT * FROM FixedType WHERE lngFixedTypeID=" & lngID
    Set recAcn = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recAcn.EOF Then
        AllowDel = -1
'        Exit Function
    Else
        strAccount = recAcn!strFixedTypeCode & " " & recAcn!strFixedTypeName
        If Not recAcn!blnIsDetail = 1 Then
            AllowDel = 1
            Exit Function
        End If
    End If
    recAcn.Close
    
    If CodeUsed(lngID) Then
        AllowDel = 2
        Exit Function
    End If
    
    AllowDel = -1
End Function

'进入删除固资类型操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim strSql As String, strType As String, intResult As Integer

    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    DelCard = False
    
    intResult = AllowDel(lngID, strType)
    
    Select Case intResult
    Case 1
        ShowMsg lnghWnd, "“" & strType & "”" & "固资类型不是末级固资类型,不能删除!", _
           vbExclamation + MB_TASKMODAL, "删除固资类型"
        GoTo ErrHandle
    Case 2
        ShowMsg lnghWnd, "“" & strType & "”" & "固资类型已被使用,不允许删除!", _
              vbExclamation + MB_TASKMODAL, "删除固资类型"
        GoTo ErrHandle
    End Select
    
    If ShowMsg(lnghWnd, "您确实要删除固资类型“" & strType & "”吗？" _
        , vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除固资类型") = vbNo Then
        Exit Function
    End If
    strSql = "DELETE FROM FixedType WHERE lngFixedTypeID = " & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("FixedType", "strFixedTypeCode", StringOut(strType)) Then GoTo ErrHandle
    
    intResult = AllowDel(lngID, strType)
    
    Select Case intResult
    Case 1
        ShowMsg lnghWnd, "“" & strType & "”" & "固资类型不是末级固资类型,不能删除!", _
           vbExclamation + MB_TASKMODAL, "删除固资类型"
        GoTo ErrHandle
    Case 2
        ShowMsg lnghWnd, "“" & strType & "”" & "固资类型已被使用,不允许删除!", _
              vbExclamation + MB_TASKMODAL, "删除固资类型"
        GoTo ErrHandle
    End Select
    
    gclsBase.BaseWorkSpace.CommitTrans
'    gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedType
    DelCard = True
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

'判断编码是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If lngID <> 0 Then
        If CheckIDUsed("FixedCard", "lngFixedTypeID", lngID) Then Exit Function
    End If
    CodeUsed = False
End Function

Private Sub cboFixedType_Click(Index As Integer)
    If Index = 0 Then
        If cboFixedType(0).ListIndex = 1 Then
            cboFixedType(1).Enabled = False
            cboFixedType(1).ListIndex = -1
            txtInput(3).Text = ""
            txtInput(3).Enabled = False
        Else
            cboFixedType(1).Enabled = True
            txtInput(3).Enabled = True
        End If
    Else
        If cboFixedType(1).ListIndex = 2 Then
            lblTitle(5).Caption = "预计工作总量"
        Else
            lblTitle(5).Caption = "预计使用年限(&Y)"
        End If
        If cboFixedType(1).ListIndex = 5 Then
            txtInput(5).Enabled = True
        Else
            txtInput(5).Enabled = False
            txtInput(5).Text = ""
        End If
    End If
    mblnIsChanged = True
End Sub

Private Sub chkPause_Click()
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOKCancel(1).Value = True
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOKCancel(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim intIndex As Integer
    
    On Error GoTo ErrHandle
    
    If gclsBase.AccountSys = 3 Then 'Or gclsBase.AccountSys = 4 Then
       For intIndex = 2 To 4
           lblTitle(intIndex).Visible = False
       Next
       cboFixedType(0).Visible = False
       cboFixedType(1).Visible = False
       txtInput(2).Visible = False
    Else
       For intIndex = 2 To 4
           lblTitle(intIndex).Visible = True
       Next
       cboFixedType(0).Visible = True
       cboFixedType(1).Visible = True
       txtInput(2).Visible = True
    End If
    InitComboBox
    Utility.LoadFormResPicture Me
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtInput(0).Text & txtInput(1).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的固资类型"
            If txtInput(0).Text <> "" Then
                strMess = strMess & "“" & txtInput(0).Text & "”"
            End If
            If txtInput(1).Text <> "" Then
                strMess = strMess & "“" & txtInput(1).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtInput(0).Text & "”" & " " _
                & "“" & txtInput(1).Text & "”固资类型已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
'    frmCustomerList.IsShowCard(1) = False
    Utility.UnLoadFormResPicture Me
    mblnIsChanged = False
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 270, 2760, 270 + 4005, 2760 + 1635
End Sub

Private Sub cmdokcancel_Click(Index As Integer)