frmfixedtypelistcard.frm

金算盘软件代码

        .strFixedTypeCode = ""
        .strFullName = ""
        .blnIsInActive = False
        .intLevel = 1
        .blnIsDetail = True
        .strDepreciationType = "0"
        .strDepreciationMethod = "0"
        .dblNetWorthRate = 0
        .intUseAge = 0
        .dblTotalWork = 0
    End With

'    If txtInput(0).Text = "Text1" Or txtInput(0).Text = "" Then
        txtInput(0).Text = ""
'    Else
'        txtInput(0).Text = GetNextCode(txtInput(0).Text)
'        mstrInitCode = txtInput(0).Text
'    End If
    txtInput(1).Text = strName
    txtInput(2).Text = ""
    txtInput(3).Text = ""
    lblTitle(5).Caption = "预计使用年限(&Y)"
    chkPause.Value = Unchecked
    cboFixedType(0).ListIndex = 0
    cboFixedType(1).ListIndex = 1
    InitBuffer '清空暂时存储数据库操作的数组
    mlngUniteID = 0
    mblnChangeIsFirst = False
End Sub

'进入修改固定资产类别操作
Public Function EditCard(ByVal lngRecordID As Long, Optional intModal As Integer = vbModeless) As Boolean
    Dim lngResult As Long
    
    If mblnIsChanged Then
       
        lngResult = ShowMsg(0, "上一次编辑的固定资产类别还未保存，是否继续编辑它？", _
                   vbYesNoCancel + vbQuestion + MB_TASKMODAL, "固定资产类别卡片提示信息")
        If lngResult = vbYes Then       '继续编辑上一次的固定资产类别
            Me.Show
            Me.ZOrder 0
            'txtInput(0).SetFocus
            Exit Function
        Else
            Unload Me
        End If
    End If
    'Me.Hide
    mblnAddRecord = False
    frmFixedTypeListCard.Caption = "修改固定资产类别"
    cmdOKCancel(2).Visible = False
    cmdOKCancel(2).Default = False
    cmdOKCancel(0).Default = True
    InitComboBox
    SelectRecord lngRecordID
    mblnIsChanged = False
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show intModal
    Me.Refresh
    Me.ZOrder 0
    
End Function

'查找出想修改的固定资产类别表编码记录，存放在自定义类型变量中,设置卡片
Private Sub SelectRecord(ByVal lngRecordID As Long)
    Dim strSql As String
    Dim recFixedTypeSet As rdoResultset

    
    With mftrFixedType
        .lngFixedTypeID = lngRecordID
        strSql = "SELECT * FROM  FixedType WHERE lngFixedTypeID=" & .lngFixedTypeID
        Set recFixedTypeSet = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recFixedTypeSet.EOF Then
            mblnAddRecord = True
            InitAddCard
            recFixedTypeSet.Close
            Exit Sub
        End If
        mblnChangeIsFirst = True
        .strFixedTypeName = recFixedTypeSet!strFixedTypeName
        .strFixedTypeCode = recFixedTypeSet!strFixedTypeCode
        .strFullName = recFixedTypeSet!strFullName
        .blnIsInActive = recFixedTypeSet!blnIsInActive
        .intLevel = recFixedTypeSet!intLevel
        .blnIsDetail = recFixedTypeSet!blnIsDetail
        .strDepreciationMethod = recFixedTypeSet!strDepreciationMethod
        .strDepreciationType = recFixedTypeSet!strDepreciationType
        .dblNetWorthRate = recFixedTypeSet!dblNetWorthRate
        .dblTotalWork = recFixedTypeSet!dblTotalWork
        .intUseAge = recFixedTypeSet!intUseAge
        If recFixedTypeSet!blnIsInActive Then
            chkPause.Value = Checked
        Else
            chkPause.Value = Unchecked
        End If
        txtInput(0).Text = .strFixedTypeCode
        txtInput(1).Text = .strFixedTypeName
        If CDbl(.dblNetWorthRate) > 0 And CDbl(.dblNetWorthRate) < 1 Then
           txtInput(2).Text = "0" & .dblNetWorthRate
        Else
           txtInput(2).Text = .dblNetWorthRate
        End If
        If .strDepreciationType > "0" Then
            cboFixedType(0).ListIndex = CInt(.strDepreciationType) - 1
        End If
        If .strDepreciationMethod > "0" Then
            cboFixedType(1).ListIndex = CInt(.strDepreciationMethod) - 1
            If CInt(.strDepreciationMethod) - 1 = 2 Then
                lblTitle(5).Caption = "预计工作总量"
                txtInput(3).Text = .dblTotalWork
            Else
                lblTitle(5).Caption = "预计使用年限(&Y)"
                txtInput(3).Text = .intUseAge
            End If
        End If
        If txtInput(3).Text = 0 Then txtInput(3).Text = ""
        If txtInput(2).Text = 0 Then txtInput(2).Text = ""
        InitBuffer '清空暂时存储数据库操作的数组
        mlngUniteID = 0
        recFixedTypeSet.Close
        mblnChangeIsFirst = False
    End With
End Sub

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

'进入删除固定资产类别操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngRecordID As Long) As Boolean
    Dim strSql As String
    Dim recFixedTypeSet As rdoResultset
    Dim intMsgReturn As Integer
    Dim blnSQLExec As Boolean
    Dim strCode As String
    Dim strName As String
    
    DelCard = False
    strSql = "SELECT * FROM FixedType WHERE lngFixedTypeID=" & lngRecordID
    Set recFixedTypeSet = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recFixedTypeSet.EOF Then
        'intMsgReturn = MsgBox("固定资产类别编码不存在，不能删除！", _
            vbExclamation + vbOKOnly, "删除固定资产类别")
        recFixedTypeSet.Close
        Exit Function
    End If
    strCode = recFixedTypeSet!strFixedTypeCode
    strName = recFixedTypeSet!strFixedTypeName
    If frmFixedTypeList.IsShowCard(0) = True Then
       If lngRecordID = frmFixedTypeListCard.FixedTypeID Then
          ShowMsg Me.hwnd, "不能删除正在修改的固资类型卡片！", _
                     vbExclamation + MB_SYSTEMMODAL, "删除固资类型卡片"
          Exit Function
       End If
    End If
    If recFixedTypeSet!blnIsDetail Then
        If CodeUsed(lngRecordID) Then
           ShowMsg 0, "固定资产类别“" & strCode & " " & strName & " ”已经发生业务，不能删除！", _
                vbExclamation + MB_TASKMODAL, "删除固定资产类别"
        Else
            intMsgReturn = ShowMsg(0, "你确实要删除“" & strCode & " " & strName & _
                "”固定资产类别吗！", vbQuestion + vbYesNo + MB_TASKMODAL, "删除固定资产类别")
            If intMsgReturn = vbYes Then
                strSql = "DELETE FROM FixedType WHERE lngFixedTypeID = " & lngRecordID
                blnSQLExec = gclsBase.ExecSQL(strSql)
                If blnSQLExec Then
                   If ChangeHigherCardDetail("FixedType", "strFixedTypeCode", strCode) Then
                      ' gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
                       DelCard = True
                    End If
                End If
            End If
        End If
    Else
        ShowMsg 0, "固定资产类别编码“" & strCode & "”不是末级编码，不能删除！", _
                vbExclamation + MB_TASKMODAL, "删除固定资产类别"
    End If
    recFixedTypeSet.Close
End Function

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

Private Sub chkPause_Click()
    mblnIsChanged = True
End Sub

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

Private Sub Form_Load()
    Dim intIndex As Integer
    
    On Error GoTo ErrHandle
    SetHelpID Me.hwnd, 30046
'    Set cmdOKCancel(0).Picture = LoadResPicture(1001, vbResBitmap)
'    Set cmdOKCancel(1).Picture = LoadResPicture(1002, vbResBitmap)
'    Set cmdOKCancel(2).Picture = LoadResPicture(1009, vbResBitmap)
'    If gclsBase.AccountSys = 3 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
'       txtInput(3).top = 1320
'       lblTitle(5).top = 1386
'       chkPause.top = 1621
'
'    Else
       For intIndex = 2 To 4
           lblTitle(intIndex).Visible = True
       Next
       cboFixedType(0).Visible = True
       cboFixedType(1).Visible = True
       txtInput(2).Visible = True
       txtInput(3).top = 2280
       lblTitle(5).top = 2355
       chkPause.top = 3000
       Me.Height = 3390
'    End If
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    frmFixedTypeList.IsShowCard(0) = True
    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
    
    If UnloadMode = vbFormControlMenu Then
    With mftrFixedType
        If mblnIsChanged Then
            intMsgReturn = ShowMsg(0, "当前固定资产类别已被修改，是否保存？", _
                       vbExclamation + vbYesNoCancel + MB_TASKMODAL, frmFixedTypeListCard.Caption)
            If intMsgReturn = vbYes Then
                Cancel = Not SaveCard(True)
            ElseIf intMsgReturn = vbCancel Then
                Cancel = True
            End If
        End If
        If Not Cancel Then mblnIsChanged = False
    End With
    End If
End Sub

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)
    On Error Resume Next
    frmFixedTypeList.IsShowCard(0) = False
    gclsSys.CurrFormName = ""
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    
End Sub

Private Sub Form_Paint()
'    If gclsBase.AccountSys = 3 Or gclsBase.AccountSys = 4 Then
'       FrameBox Me.hwnd, 120, 120, 4335, 1846
'       Me.Height = 2316
'    Else
       FrameBox Me.hwnd, 120, 120, 4335, 3295
       Me.Height = 3765
'    End If
End Sub

Private Sub InputAgain(Optional ByVal intIndex As Integer = 0)
    txtInput(intIndex).SelStart = 0
    txtInput(intIndex).SelLength = strLen(txtInput(intIndex).Text)
    txtInput(intIndex).SetFocus
End Sub