frmfixedtypelistcard.frm

金算盘软件代码

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


Private Sub txtInput_Change(Index As Integer)
    
    If mblnChangeIsFirst = True Then Exit Sub
    
    Select Case Index
           Case 0, 1
                If ContainErrorChar(txtInput(Index).Text, "'|") Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
           Case 2
                If Not ChickIsRight(txtInput(Index).Text, txtInput(Index).hwnd) Then Exit Sub '检查输入的字符串是数字型并且是非负数
                If Val(txtInput(2).Text) > 100 Then   '预计净残值率只能在0到100之间
                   SendKeys "{BS}"
                   Exit Sub
                End If
                If Val(txtInput(2).Text) < 100 And Len(txtInput(2).Text) > 5 Then
                   SendKeys "{BS}"
                   Exit Sub
                ElseIf Val(txtInput(2).Text) = 100 And Len(txtInput(2).Text) > 6 Then
                   SendKeys "{BS}"
                   Exit Sub
                End If
           Case 3
                If Not ChickIsRight(txtInput(Index).Text, txtInput(Index).hwnd) Then Exit Sub
                If InStr(1, txtInput(Index).Text, ".") <> 0 Then
                   BKKEY txtInput(Index).hwnd
                   Exit Sub
                End If
                If Trim(cboFixedType(1).Text) <> "工作量法" Then
                   If Val(txtInput(3).Text) > 9999 Then
                      SendKeys "{BS}"
                      Exit Sub
                   End If
                End If
    End Select
    mblnIsChanged = True
End Sub

Private Function ChickIsRight(ByVal strInputString As String, ByVal Ctlhwnd As Long) As Boolean
    ChickIsRight = False
    If Not IsNumeric(strInputString) Then
      BKKEY Ctlhwnd        '
      ' SendKeys "{BS}"
       Exit Function
    End If
    If strCount(strInputString, "-") <> 0 Then   '检查减号
       BKKEY Ctlhwnd
       'SendKeys "{BS}"
       Exit Function
    End If
    ChickIsRight = True
End Function

Private Sub cmdokcancel_Click(Index As Integer)
    Dim strSql As String
    Dim recType As rdoResultset
    
    Select Case Index
        Case 0   '确定
            If SaveCard(True) Then
               strSql = "select * from FixedType order by lngFixedTypeID"
               Set recType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
               If recType.RowCount > 0 Then
                  recType.MoveLast
                  ID = recType!lngFixedTypeID
               Else
                  ID = 0
               End If
               Unload Me
            End If
        Case 1   '取消
            mblnIsChanged = False
            Unload Me
        Case 2   '下一个
            SaveCard False
    End Select
End Sub

'通过事务处理完成对数据库的操作
'blnClickOK：是按[确定]按钮还是按[下一个]按钮
Private Function SaveCard(blnClickOK As Boolean) As Boolean
    Dim strSql As String
    Dim recSelect As rdoResultset
    Dim intMsgReturn As Integer
    Dim strCode As String
    
    strCode = Trim(txtInput(0).Text)
    SaveCard = False
    If validityCheck(blnClickOK) Then '检查数据的有效性并整理记录值成功
        gclsBase.BaseWorkSpace.BeginTrans
        If ExecBuffer Then  '修改数据库成功
            InitBuffer   '清空暂时存储数据库操作的数组
            If mlngUniteID > 0 Then '将上级编码的业务转到新加入它的下级编码
                strSql = "SELECT lngFixedTypeID FROM FixedType" & _
                        "  WHERE strFixedTypeCode='" & mftrFixedType.strFixedTypeCode & "'"
                Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If recSelect.EOF Then
                    recSelect.Close
                        'intMsgReturn = MsgBox("新增固定资产类别不成功。", _
                            vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                    'Else
                     '   intMsgReturn = MsgBox("修改固定资产类别不成功。", _
                            vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                    'End If
                    mblnAddRecord = True
                    InitAddCard '初始化
                    gclsBase.BaseWorkSpace.RollbackTrans
                    InputAgain
                Else
                    UniteRecord CStr(mlngUniteID), recSelect!lngFixedTypeID, False
                    recSelect.Close
                    If ExecBuffer Then  '修改数据库成功
                        gclsBase.BaseWorkSpace.CommitTrans
                        gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
                        mblnIsChanged = False
                        SaveCard = True
                        If Not blnClickOK Then
                            InitAddCard '为新增记录作设置
                            txtInput(0).Text = GetNextCode(strCode)
                            'txtInput(0).Text = GetNextCode(txtInput(0).Text)
                            InputAgain
                        End If
                    Else '修改数据库不成功
                        'If mblnAddRecord Then
                         '   intMsgReturn = MsgBox("新增固定资产类别不成功。", _
                                vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                      '  Else
                        '    intMsgReturn = MsgBox("修改固定资产类别不成功。", _
                                vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                       ' End If
                        gclsBase.BaseWorkSpace.RollbackTrans
                        mblnAddRecord = True
                        InitAddCard '初始化
                        InputAgain
                    End If
                End If
            Else    '不用转业务
                gclsBase.BaseWorkSpace.CommitTrans
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
                mblnIsChanged = False
                SaveCard = True
                If Not blnClickOK Then
                    InitAddCard '为新增记录作设置
                    txtInput(0).Text = GetNextCode(strCode)
                    'txtInput(0).Text = GetNextCode(txtInput(0).Text)
                    InputAgain
                End If
            End If
        Else '修改数据库不成功
            If mblnAddRecord Then
             '   intMsgReturn = MsgBox("新增固定资产类别不成功。", _
                    vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                mblnAddRecord = True
                InitAddCard '初始化
            Else
               ' intMsgReturn = MsgBox("修改固定资产类别不成功。", _
                    vbExclamation + vbOKCancel, frmFixedTypeListCard.Caption)
                mblnAddRecord = True
                InitAddCard '初始化
            End If
            gclsBase.BaseWorkSpace.RollbackTrans
            InitBuffer   '清空暂时存储数据库操作的数组
            InputAgain
        End If
    Else '检查数据的有效性并整理记录值不成功
        InitBuffer   '清空暂时存储数据库操作的数组
    End If
End Function

'检查数据的有效性并整理记录值,存储记录
'blnClickOK：是按[确定]按钮还是按[下一个]按钮
Private Function validityCheck(blnClickOK As Boolean) As Boolean
    Dim intMsgReturn As Integer
    Dim strNewFullName As String
    Dim strName As String
    Dim strOldFullName As String
    Dim lngOldID As Long
    Dim strSql As String
    Dim strChildID As String
    Dim recSelect As rdoResultset
    
    On Error Resume Next
    validityCheck = True
    If strLen(Trim(txtInput(0).Text)) = 0 Then  '检查非空项
       ShowMsg 0, " 固资类别编码不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
        validityCheck = False
        InputAgain
        Exit Function
    End If
    If strLen(Trim(txtInput(1).Text)) = 0 Then  '检查非空项
       ShowMsg 0, " 固资类别名称不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
        validityCheck = False
        InputAgain 1
        Exit Function
    End If
    If Trim(cboFixedType(1).Text) = "工作量法" Then
       
       If strLen(Trim(txtInput(3).Text)) = 0 Then
          txtInput(3).Text = 0
       ElseIf Trim(txtInput(3).Text) = "." Then
          ShowMsg 0, "预计工作总量不能为‘.’！", vbExclamation + MB_TASKMODAL, Me.Caption
          validityCheck = False
          InputAgain 3
          Exit Function
       End If
    Else
       If strLen(Trim(txtInput(3).Text)) = 0 Then
          txtInput(3).Text = 0
       ElseIf Trim(txtInput(3).Text) = "." Then
          ShowMsg 0, "预计使用年限不能为‘.’！", vbExclamation + MB_TASKMODAL, Me.Caption
          validityCheck = False
          InputAgain 3
          Exit Function
       End If
       If Val(txtInput(3).Text) > 9999 Then
          ShowMsg 0, "预计使用年限必需小于10000年！", vbExclamation + MB_TASKMODAL, Me.Caption
          validityCheck = False
          InputAgain 3
          Exit Function
       End If
    End If
    If strLen(Trim(txtInput(2).Text)) = 0 Then
       txtInput(2).Text = 0
    ElseIf Trim(txtInput(2).Text) = "." Then
       ShowMsg 0, "预计净残值率%不能为‘.’！", vbExclamation + MB_TASKMODAL, Me.Caption
       validityCheck = False
       InputAgain 2
       Exit Function
    End If
    
    If CheckSameName("fixedtype", "strFixedTypeCode", txtInput(0).Text, _
           "strFixedtypeName", txtInput(1).Text, "lngFixedTypeID", _
           mftrFixedType.lngFixedTypeID) Then         '相同上级的同级名称相同
        ShowMsg 0, "此固定资产类别名称已存在，请重新输入。", _
                  vbExclamation + MB_TASKMODAL, Me.Caption
        validityCheck = False
        InputAgain 1
        validityCheck = False
        Exit Function
    End If
    
    If Not mblnAddRecord Then
       If InStr(1, txtInput(0).Text, mftrFixedType.strFixedTypeCode & "-") = 1 Then
          ShowMsg 0, "固资类别不能修改为自己的下级！", vbExclamation + MB_TASKMODAL, Me.hwnd
          validityCheck = False
          InputAgain
          Exit Function
       End If
    End If
    
    
    With mftrFixedType
        If .strFixedTypeCode <> txtInput(0).Text Then      '编码已改变
            strSql = "SELECT lngFixedTypeID,blnIsDetail,strFullName,strFixedTypeName" & _
                " FROM FixedType WHERE strFixedTypeCode='" & txtInput(0).Text & "'"
            Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If recSelect.RowCount <> 0 Then          '编码不唯一
                strName = recSelect!strFixedTypeName
                strOldFullName = recSelect!strFullName
                lngOldID = recSelect!lngFixedTypeID
                If mblnAddRecord Then   'Or Not recSelect!blnIsDetail Then '新增编码不能重复,双方任一非末级不能合并
                    ShowMsg 0, "此固定资产类别编码已存在，请重新输入。", _
                        vbExclamation + MB_TASKMODAL, Me.Caption
                    validityCheck = False
                    InputAgain
                    recSelect.Close
                    Exit Function
                Else   '合并对象末级可以合并
                    If Not CodeIsDetail("fixedType", "strfixedtypecode", txtInput(0).Text) Or Not CodeIsDetail("fixedtype", "strfixedtypecode", .strFixedTypeCode) _
                           Or Not ActiveIsSame("FixedType", "strFixedTypeCode", txtInput(0).Text, .strFixedTypeCode) Then
                       ShowMsg 0, "固资类别“" & txtInput(0).Text & "”与“" & .strFixedTypeCode & "”不能合并，请重新修改固资类别编号“" _
                            & txtInput(0).Text & "”", vbExclamation + MB_TASKMODAL, "修改固资类别"
                       validityCheck = False
                       InputAgain
                       Exit Function
                    End If
                    intMsgReturn = ShowMsg(0, "是否将固资类别“" & .strFixedTypeCode & " " & _
                                   .strFixedTypeName & "”与“" & txtInput(0).Text & " " & _
                                    recSelect!strFixedTypeName & "”进行合并？", _
                        vbQuestion + vbYesNo + MB_TASKMODAL, "修改固资类别")
                    If intMsgReturn = vbYes Then '合并
                        If .intLevel > 1 And CodePrefix(.strFixedTypeCode) <> _
                            CodePrefix(txtInput(0).Text) Then     '改变原上级编码的末级属性
                            UpdateOldParent .strFixedTypeCode
                        End If
                        strNewFullName = strLeft(strOldFullName, strLen(strOldFullName) - strLen(strName)) _
                            & txtInput(1).Text       '得出新全名
                        .strFullName = strNewFullName
                        UniteRecord CStr(.lngFixedTypeID), lngOldID, True   '修改原编码的被使用情况
                        .lngFixedTypeID = recSelect!lngFixedTypeID
                        SettingRecord '整理记录