frmfixedoldwizard.frm

金算盘软件代码

         Tag             =   "140"
         Top             =   405
         Width           =   1365
      End
      Begin VB.Image imgSalary 
         BorderStyle     =   1  'Fixed Single
         Height          =   3195
         Index           =   2
         Left            =   -74925
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   405
         Width           =   1365
      End
      Begin VB.Image imgSalary 
         BorderStyle     =   1  'Fixed Single
         Height          =   3195
         Index           =   0
         Left            =   90
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   390
         Width           =   1365
      End
      Begin VB.Image imgSalary 
         BorderStyle     =   1  'Fixed Single
         Height          =   3195
         Index           =   1
         Left            =   -74910
         Stretch         =   -1  'True
         Tag             =   "140"
         Top             =   390
         Width           =   1365
      End
      Begin VB.Label lblArr 
         Caption         =   "凭证摘要(&S)"
         Height          =   195
         Index           =   5
         Left            =   -72720
         TabIndex        =   14
         Top             =   2400
         Width           =   1005
      End
      Begin VB.Label lblArr 
         Caption         =   "凭证类型(&T)"
         Height          =   195
         Index           =   4
         Left            =   -72720
         TabIndex        =   10
         Top             =   1230
         Width           =   1005
      End
      Begin VB.Label lblArr 
         Caption         =   "凭证模板(&M)"
         Height          =   195
         Index           =   3
         Left            =   -72720
         TabIndex        =   12
         Top             =   1800
         Width           =   1005
      End
      Begin VB.Label lblArr 
         Caption         =   "累计折旧科目(&C)"
         Height          =   195
         Index           =   0
         Left            =   2010
         TabIndex        =   8
         Top             =   930
         Width           =   1515
      End
   End
End
Attribute VB_Name = "frmFixedOldWizard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'计提折旧
'
'   作者：唐吉禹
'   1998-7-10
'
'
'
'
'科目ID，科目编码，lngCustomerID，
'lngDepartmentID，lngEmployeeID，科目名称，借方金额，贷方金额
'
'
'
'
'折旧查询：
'1、FixedOldFrom：用于计算折旧的原值等信息对应的变动记录查询。（小于当前会计期间且折旧计算因数为非零的变动记录）
'2、FixedInitData：计提折旧原值、预计残值、预计年限、预计工作量查询。（来源于FixedOldFrom查询的变动ID对应的数据）
'3、FixedNowFrom：用于计算折旧的已提折旧期间与累计折旧等信息对应的变动记录查询。（小于当前会计期间的变动记录）
'4、FixedNowData：已提折旧期间与累计折旧查询。（来源于FixedNowFrom查询的变动ID对应的数据）
'5、FixedArea：参与计算折旧的记录范围查询。（FixedType中为永远计提折旧或正常计提折旧且为使用中或租出）
'6、FixedOldData：计提折旧的所有数据项目查询。
'所用参数：当前会计期间的起始日期（strNowDate,strStartDate）、当前会计期间（Period,bytPeriod）、
'当前会计年度（Year,intYear）、当前会计期间是否为帐套启用的会计期间（Used,blnUsed）
'
Option Explicit
Private WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsGrid As New Grid
Private mblnVoucherFinish As Boolean                    '凭证生成标志
Private mlngAccountID As Long                           '科目ID
Private mlngTypeID As Long                              '凭证类型
Private mlngTempletID As Long                           '模板
Private mlngResumeID As Long                            '摘要
Private mblnCanOld As Boolean                           '能否计提折旧
Private mlngVoucherID As Long                           '
Private mblnUsed As Boolean                             '是否为第一个会计期间
Private mdblValue As Double
Private mstrReport As String                            '折旧报告的固定资产ID串
Private mblnFinish As Boolean                           '是否按完成退出
Private mblnHaveDeprection As Boolean                   '是否已经提过折旧
Private Sub cmdArr_Click(Index As Integer)
    Select Case Index
    Case 0
        Unload Me    '取消
    Case 1
        cmdArr(2).Enabled = True
        PrevClick      '上一步
        If stbOldWizard.Tab = 0 Then
            cmdArr(1).Enabled = False
        End If
    Case 2
        cmdArr(1).Enabled = True
        NextClick       '下一步
        If stbOldWizard.Tab = 3 Then
            cmdArr(2).Enabled = False
        End If
    Case 3              '完成
        Call FinishWizard
    End Select
End Sub
'下一步
Private Sub NextClick()
    Dim strSql As String
    Dim recType As rdoResultset
    
    If stbOldWizard.Tab = 0 Then
        If Val(litAccount.TextMatrix(litAccount.ReferRow, 1)) = 0 Then
            ShowMsg Me.hwnd, "请选择折旧科目", vbInformation, Me.Caption
            litAccount.SetFocus
            Exit Sub
        End If
    End If
    If stbOldWizard.Tab = 1 Then
        If Val(ltxtType.TextMatrix(ltxtType.ReferRow, 1)) = 0 Then
            ltxtType.SetFocus
            ShowMsg Me.hwnd, "请选择凭证类别", vbInformation, Me.Caption
            Exit Sub
        End If
        If Val(ltxtTemplet.TextMatrix(ltxtTemplet.ReferRow, 1)) = 0 Then
            ltxtTemplet.SetFocus
            ShowMsg Me.hwnd, "请选择凭证模板", vbInformation, Me.Caption
            Exit Sub
        End If
        
        If ltxtType.ID > 0 Then
           mlngTypeID = ltxtType.ID
           strSql = "SELECT * FROM VoucherType WHERE strVoucherFormat='0' AND lngVoucherTypeID=" & ltxtType.ID
           Set recType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
           If recType.EOF Then
              recType.Close
              Set recType = Nothing
              If Visible Then ShowMsg hwnd, "不能选择收付款凭证类型！", vbOKOnly + vbInformation, Caption
              Exit Sub
           Else
              recType.Close
              Set recType = Nothing
           End If
        End If
    End If
    If stbOldWizard.Tab = 1 Then
        Call oldFixedVoucher
        If mblnVoucherFinish Then
'            If stbOldWizard.TabVisible(2) Then
            If Len(mstrReport) > 3 Then
                Call ReportFixed
                If stbOldWizard.TabVisible(2) Then
                    stbOldWizard.Tab = 2
                Else
                    stbOldWizard.Tab = 3
                End If
            Else
                stbOldWizard.Tab = 3
            End If
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    If stbOldWizard.Tab < 3 Then
        stbOldWizard.Tab = stbOldWizard.Tab + 1
    End If
End Sub
'上一步
Private Sub PrevClick()
    If stbOldWizard.Tab > 0 Then
        If stbOldWizard.Tab = 3 Then
            If stbOldWizard.TabVisible(2) Then
                stbOldWizard.Tab = stbOldWizard.Tab - 1
            Else
                stbOldWizard.Tab = stbOldWizard.Tab - 2
            End If
        Else
            stbOldWizard.Tab = stbOldWizard.Tab - 1
        End If
    End If
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    gclsSys.CurrFormName = Me.hwnd
    SetHelpID HelpContextID
    If stbOldWizard.Tab = stbOldWizard.Tabs - 1 Then
        cmdArr(3).SetFocus
    Else
        cmdArr(2).SetFocus
    End If
'    FinishWizard
End Sub
Private Sub Form_Load()
    Dim lngAccountID As Long
    mblnCanOld = False
    mblnVoucherFinish = False
    mlngAccountID = 0
    mlngTypeID = 0
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    stbOldWizard.Tab = 0
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgOldWizard
    cmdArr(3).Enabled = False
    mlngVoucherID = 0
    mdblValue = 0
    Me.HelpContextID = 60110
    mblnFinish = False
    mblnHaveDeprection = False
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)
    If Not mblnFinish And mblnHaveDeprection Then
        Me.MousePointer = vbHourglass
        Call CancelDeprection(gclsBase.AccountYear, gclsBase.Period)
        Me.MousePointer = vbDefault
    End If
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    Set frmFixedOldWizard = Nothing
End Sub
'折旧分摊
Private Sub FixedOldPart()
'    Dim recOldAccount As rdoResultset
'    Dim strSql As String
'    Dim i As Integer
'    Dim dblValue As Double
'    Dim intyear As Integer
'    Dim bytPeriod As Byte
'    Dim datStartDate As Date
'    Dim datEndDate As Date
'    Dim Rec As rdoResultset
'    Dim recFixedAlter As rdoResultset
'    Dim blnIsFirst As Boolean
'    Dim blnDec As Boolean
'    Dim datDate As Date
'    Dim intFirstYear As Integer
'    Dim bytFirstPeriod As Byte
'    Dim datFirstDate As Date
'    Dim datNowDate As Date
'    Dim blnIsZero As Boolean
'    Dim intFromYear As Integer
'    Dim bytFromPeriod As Byte
'    Dim datCalcFromDate As Date
'    msgOldWizard.Clear
'    msgOldWizard.Rows = 2
'    intyear = gclsBase.AccountYear
'    bytPeriod = gclsBase.Period
'    '判断当前会计期间是否为第一个会计期间
'    strSql = "SELECT AccountPeriod.intYear, AccountPeriod.bytPeriod,Business.strStartDate FROM Business INNER " _
'        & "JOIN AccountPeriod ON (Business.strStartDate <= AccountPeriod.strEndDate) AND " _
'        & "(Business.strStartDate >= AccountPeriod.strStartDate)"
'    Set Rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    If Rec!intyear = intyear And Rec!bytPeriod = bytPeriod Then
'        blnIsFirst = True
'    End If
'    intFirstYear = Rec!intyear
'    bytFirstPeriod = Rec!bytPeriod
'    datFirstDate = Rec!strStartDate
'    Call gclsBase.DateOfPeriod(intyear, bytPeriod, datNowDate)
'    '判断是否已经计提过折旧
'    strSql = "SELECT Voucher.* FROM Voucher WHERE Voucher.lngVoucherSourceID=15 AND blnIsVoid=0 ORDER BY clng(intYear)*100+bytPeriod ASC"
'    Set Rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    If Rec.EOF Then
'        blnDec = False
'        Call gclsBase.DateOfPeriod(intFirstYear, CByte(bytFirstPeriod), datStartDate, datEndDate)
'        intFromYear = intFirstYear
'        bytFromPeriod = bytFirstPeriod
'        datCalcFromDate = datStartDate
'    Else
'        blnDec = True
'        Rec.MoveLast
'        Call gclsBase.DateOfPeriod(Rec!intyear, CByte(Rec!bytPeriod), datStartDate, datEndDate)  '
'        datCalcFromDate = datEndDate + 1
'        intFromYear = Rec!intyear
'        bytFromPeriod = Rec!bytPeriod
'    End If
'    msgOldWizard.Rows = 2
'    msgOldWizard.FixedRows = 1
'    msgOldWizard.Cols = 11
'    msgOldWizard.FixedCols = 9
'    msgOldWizard.ColWidth(1) = 0
'    msgOldWizard.ColWidth(2) = 0
'    msgOldWizard.ColWidth(3) = 0
'    msgOldWizard.ColWidth(4) = 0
'    msgOldWizard.ColWidth(5) = 0
'    msgOldWizard.ColWidth(6) = 0
'    msgOldWizard.ColWidth(7) = 0
'    msgOldWizard.ColWidth(8) = 2880
'    msgOldWizard.ColWidth(9) = 1200
'    msgOldWizard.ColWidth(10) = 1200
'    msgOldWizard.TextMatrix(0, 8) = "科目名称"
'    msgOldWizard.TextMatrix(0, 9) = "借方金额"
'    msgOldWizard.TextMatrix(0, 10) = "贷方金额"
'    msgOldWizard.ColAlignment(8) = flexAlignLeftCenter
'
'    '将在计算的会计期间内的变动记录取出