frmfixedoldwizard.frm

金算盘软件代码

        mblnVoucherFinish = False
        Exit Sub
    End If
    '本会计期间已经结帐
    If gclsBase.PeriodClosed(gclsBase.BaseDate) Then
        stbOldWizard.Tab = 0
        ShowMsg Me.hwnd, "本会计期间已经结帐，不能计提折旧", vbInformation, Me.Caption
        mblnVoucherFinish = False
        Exit Sub
    End If
    If Val(litAccount.TextMatrix(litAccount.ReferRow, 1)) = 0 Then
        stbOldWizard.Tab = 0
        ShowMsg Me.hwnd, "请选择折旧科目", vbInformation, Me.Caption
        mblnVoucherFinish = False
        litAccount.SetFocus
        Exit Sub
    End If
    If Not mblnVoucherFinish Then
        Me.MousePointer = vbHourglass
        mblnVoucherFinish = True
        '计提折旧
        Set ref = gclsBase.BaseDB.CreateQuery("", "{?=CALL " & gclsBase.UID & ".CalcDeprection(?,?)}")
        ref.rdoParameters(0).Type = rdTypeVARCHAR
        ref.rdoParameters(1).Type = rdTypeINTEGER
        ref.rdoParameters(1).Direction = rdParamInput
        ref.rdoParameters(1).Value = gclsBase.AccountYear
        ref.rdoParameters(2).Type = rdTypeINTEGER
        ref.rdoParameters(2).Direction = rdParamInput
        ref.rdoParameters(2).Value = gclsBase.Period
        ref.Execute
        Call UpdateMonthFixedAlter(gclsBase.AccountYear, gclsBase.Period)
        If Val(ref.rdoParameters(0).Value) > 0 Then
            Call FixedOldPart
            mblnHaveDeprection = True
        Else
            prgVoucher.Visible = False
            stbOldWizard.Tab = 0
            ShowMsg Me.hwnd, "没有固定资产可以计提折旧", vbInformation, Me.Caption
            mblnVoucherFinish = False
        End If
        Me.MousePointer = vbDefault
    End If
End Sub

Private Sub litAccount_AddNew()
    Dim lngID As Long
    mblnVoucherFinish = False
    lngID = Card.AddCard(msgAccount)
    '初始化科目
    Call InitAccountID
    litAccount.SeekId (lngID)
End Sub
Private Sub litAccount_Choose()
    Dim lngID As Long
    Dim recResultset As rdoResultset
    Dim strSql As String
    strSql = "SELECT blnIsDetail,blnIsCustomer,blnIsDepartment,blnIsEmployee," _
            & "blnIsClass1,blnIsClass2,blnIsQuantity,lngAccountNatureID FROM Account WHERE " _
            & "lngAccountID=" & Val(litAccount.TextMatrix(litAccount.ReferRow, 1))
    Set recResultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recResultset.EOF Then
        Exit Sub
    End If
    With recResultset
        If !blnIsDetail = 0 Or !blnIsCustomer = 1 Or !blnIsDepartment = 1 Or !blnIsEmployee = 1 Or _
            !blnIsClass1 = 1 Or !blnIsClass2 = 1 Or !blnIsQuantity = 1 Then
            
            ShowMsg Me.hwnd, "请选择没有辅助核算的末级科目", vbInformation, Me.Caption
            .Close
            Set recResultset = Nothing
            litAccount.PopRefer
            litAccount.Text = ""
            Exit Sub
        End If
        If !blnIsQuantity > 0 Then
            ShowMsg Me.hwnd, "不能选择现金、银行、应收、应付、存货类科目", vbInformation, Me.Caption
            .Close
            Set recResultset = Nothing
            litAccount.PopRefer
            litAccount.Text = ""
            Exit Sub
        End If
    End With
    mlngAccountID = litAccount.ID
    recResultset.Close
    Set recResultset = Nothing
End Sub
Private Sub litAccount_Delete()
    mblnVoucherFinish = False
    If mlngAccountID > 0 Then
        With litAccount
            Card.DelCard msgAccount, mlngAccountID
            mlngAccountID = 0
        End With
        '初始化科目
        Call InitAccountID
    Else
        ShowMsg Me.hwnd, "请先选择要删除的科目", vbInformation, Me.Caption
    End If
End Sub
Private Sub litAccount_Edit()
    mblnVoucherFinish = False
    If mlngAccountID > 0 Then
        With litAccount
            Card.EditCard msgAccount, mlngAccountID
        End With
        '初始化科目
        Call InitAccountID
    Else
        ShowMsg Me.hwnd, "请先选择要修改的科目", vbInformation, Me.Caption
    End If
End Sub

Private Sub litAccount_GotFocus()
    InitAccountID
End Sub

Private Sub litAccount_ItemNotExist()
    If frmMsgAdd.MsgAddShow("科目不存在", "科目表中没有" + Trim(litAccount.Text)) = vbOK Then
        litAccount.ReferRow = 0
    Else
        litAccount.Text = ""
    End If
End Sub
Private Sub ltxtResume_AddNew()
    Dim lngID As Long
    mblnVoucherFinish = False
    lngID = Card.AddCard(msgRemark)
    '初始化摘要
    Call InitResume
    ltxtResume.SeekId (lngID)
End Sub
Private Sub ltxtResume_Choose()
    mblnVoucherFinish = False
    mlngResumeID = ltxtResume.TextMatrix(ltxtResume.ReferRow, 1)
End Sub
Private Sub ltxtResume_Delete()
    mblnVoucherFinish = False
    If mlngResumeID > 0 Then
        With ltxtResume
            Card.DelCard msgRemark, mlngResumeID
            mlngResumeID = 0
        End With
    Else
        ShowMsg Me.hwnd, "请先选择要删除的摘要", vbInformation, Me.Caption
    End If
    '初始化凭证模板
    Call InitResume
End Sub

Private Sub ltxtResume_Edit()
    mblnVoucherFinish = False
    If mlngResumeID > 0 Then
        With ltxtResume
            Card.EditCard msgRemark, mlngResumeID
        End With
    Else
        ShowMsg Me.hwnd, "请先选择要修改的摘要", vbInformation, Me.Caption
    End If
    '初始化凭证模板
    Call InitResume
    ltxtResume.SeekId mlngResumeID
    If ltxtResume.Text = "" Then
        ltxtResume.Text = "计提折旧"
    End If
End Sub

Private Sub ltxtResume_GotFocus()
    Dim lngID As Long
    lngID = ltxtResume.ID
    InitResume
    If lngID > 0 Then
        ltxtResume.SeekId lngID
    End If
End Sub
Private Sub ltxtTemplet_AddNew()
    Dim lngID As Long
    mblnVoucherFinish = False
    lngID = Card.AddCard(msgTemplate, , , 41)
    '初始化凭证模板
    Call InitTemplet
    ltxtTemplet.SeekId (lngID)
End Sub
Private Sub ltxtTemplet_Choose()
    mlngTempletID = ltxtTemplet.ID
End Sub
Private Sub ltxtTemplet_Delete()
    mblnVoucherFinish = False
    If mlngTempletID > 0 Then
        With ltxtTemplet
            Card.DelCard msgTemplate, mlngTempletID
        End With
    Else
        ShowMsg Me.hwnd, "请先选择要删除的凭证模板", vbInformation, Me.Caption
    End If
    '初始化凭证模板
    Call InitTemplet
End Sub
Private Sub ltxtTemplet_Edit()
    Dim lngID As Long
    
    mblnVoucherFinish = False
    If mlngTempletID > 0 Then
        With ltxtTemplet
            lngID = Card.EditCard(msgTemplate, mlngTempletID, , 41)
            If lngID > 0 Then mlngTempletID = lngID
        End With
    Else
        ShowMsg Me.hwnd, "请先选择要修改的凭证模板", vbInformation, Me.Caption
    End If
    '初始化凭证模板
    Call InitTemplet
    If mlngTempletID > 0 Then
        ltxtTemplet.SeekId mlngTempletID
    End If
End Sub

Private Sub ltxtTemplet_GotFocus()
    Dim lngID As Long
    lngID = ltxtTemplet.ID
    InitTemplet
    If lngID > 0 Then
        ltxtTemplet.SeekId lngID
    End If
End Sub

Private Sub ltxtTemplet_ItemNotExist()
    If frmMsgAdd.MsgAddShow("凭证模板不存在", "凭证模板列表中没有" + Trim(ltxtTemplet.Text)) = vbOK Then
        ltxtTemplet.ReferRow = 0
    Else
        ltxtTemplet.Text = ""
    End If
End Sub

Private Sub ltxtType_AddNew()
    Dim lngID As Long
    mblnVoucherFinish = False
    mlngTypeID = Card.AddCard(msgVoucherType)
    '初始化凭证类型
    Call InitType
End Sub
Private Sub ltxtType_Choose()
'    Dim strSql As String
'    Dim recType As Recordset
'    Static intShow As Integer
    
    mblnVoucherFinish = False
    mlngTypeID = ltxtType.ID
    
'    If mlngTypeID > 0 And ltxtType.Text <> "" Then
'       strSql = "SELECT * FROM VoucherType WHERE strVoucherFormat='0' AND lngVoucherTypeID=" & ltxtType.ID
'       Set recType = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'       If recType.EOF Then
'          ltxtType.Text = ""
'          mlngTypeID = 0
'          recType.Close
'          Set recType = Nothing
'          If intShow = 0 Then
'             If Visible Then ShowMsg hwnd, "不能选择收付款凭证类型！", vbOKOnly + vbInformation, Caption
'             intShow = 1
'          Else
'             intShow = 0
'          End If
'       Else
'          recType.Close
'          Set recType = Nothing
'       End If
'    End If
End Sub
Private Sub ltxtType_Delete()
    mblnVoucherFinish = False
    If mlngTypeID > 0 Then
        With ltxtType
            Card.DelCard msgVoucherType, mlngTypeID
            mlngTypeID = 0
        End With
    Else
        ShowMsg Me.hwnd, "请先选择要删除的凭证类型", vbInformation, Me.Caption
    End If
    '初始化凭证类型
    Call InitType
End Sub

Private Sub ltxtType_Edit()
    Dim lngID As Long
    mblnVoucherFinish = False
    mlngTypeID = ltxtType.ID
    lngID = mlngTypeID
    If mlngTypeID > 0 Then
        With ltxtType
            mlngTypeID = Card.EditCard(msgVoucherType, mlngTypeID)
        End With
        If mlngTypeID > 0 Then
            lngID = mlngTypeID
        End If
    Else
        ShowMsg Me.hwnd, "请先选择要修改的凭证类型", vbInformation, Me.Caption
    End If
    '初始化凭证类型
    Call InitType
    ltxtType.SeekId lngID
End Sub

Private Sub ltxtType_GotFocus()
    Dim lngID As Long
    lngID = ltxtType.ID
    InitType
    If lngID > 0 Then
        ltxtType.SeekId lngID
    End If
End Sub

Private Sub ltxtType_ItemNotExist()
    If frmMsgAdd.MsgAddShow("凭证类型不存在", "凭证类型列表中没有" + Trim(ltxtType.Text)) = vbOK Then
        ltxtType.ReferRow = 0
    Else
        ltxtType.Text = ""
    End If
End Sub

Private Sub msgOldWizard_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgOldWizard
        .ColSel = .col
        .RowSel = .Row
    End With
End Sub

Private Sub EnabledControl()
    litAccount.Visible = (stbOldWizard.Tab = 0)
    ltxtType.Visible = (stbOldWizard.Tab = 1)
    ltxtTemplet.Visible = (stbOldWizard.Tab = 1)
    ltxtResume.Visible = (stbOldWizard.Tab = 1)
    msgFixedReport.Visible = (stbOldWizard.Tab = 2)
    msgOldWizard.Visible = (stbOldWizard.Tab = 3)