Attribute VB_Name = "ShowAlterInfo"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   顯示固資變動信息模塊
'   作者:肖宇
'   日期:1998-07-05
'
'   功能:
'       1.提供關聯固資變動資料的接口
'       2.提供關聯固資卡片資料的接口
'       3.提供取幣種匯率方法
'       4.提供刪除多幣種、多科目和多部門
'         錄入窗體的相關內容集合的方法
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'卡片查閱
Public Sub DispFixedCard(ByVal lngCardID As Long)
    frmScanFixCard.EditCard lngCardID
End Sub

'顯示變動信息
Public Sub DispCardInfo(ByVal lngAlterID As Long)
    DispAlterInfo lngAlterID
End Sub
Public Sub DispAlterInfo(ByVal lngAlterID As Long)
    Dim strSql As String
    Dim recFixedAlter As rdoResultset
    Dim lngCardID As Long
    Dim bytAlterType As Integer
    Dim blnInit As Boolean
    
    strSql = "SELECT strDate,lngFixedCardID,bytAlterType FROM FixedAlter WHERE lngFixedAlterID=" & lngAlterID
    Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recFixedAlter.EOF Then
        lngCardID = recFixedAlter!lngFixedCardID
        bytAlterType = recFixedAlter!bytAlterType
        blnInit = (CDate(recFixedAlter!strDate) < CDate(gclsBase.BeginDate))
    Else
        lngAlterID = 0
    End If
    recFixedAlter.Close
    Set recFixedAlter = Nothing
    
    If lngAlterID > 0 Then
        Select Case bytAlterType
        Case 1 ' 增加
            frmFixedAdd.EditCard lngAlterID, lngCardID, True, blnInit
        Case 2 ' 減少
            frmFixedDec.EditCard lngAlterID, lngCardID, True
        Case 3 ' 其他變動
            frmFixedOtherAlter.EditCard lngAlterID, lngCardID, True
        End Select
    End If
End Sub

Public Function FixedMethodName(lngFixedMethodID As Long) As String
    Dim strSql As String
    Dim recMethod As rdoResultset
    
    strSql = "SELECT * FROM FixedMethod WHERE lngFixedMethodID=" & lngFixedMethodID
    Set recMethod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recMethod.EOF Then
        FixedMethodName = recMethod!strFixedMethodName
    End If
    recMethod.Close
    Set recMethod = Nothing
End Function

Public Function UseStatus(strCode As String) As String
    Select Case strCode
    Case "1": UseStatus = "使用中"
    Case "2": UseStatus = "未使用"
    Case "3": UseStatus = "不需用"
    Case "4": UseStatus = "租出"
    Case Else
        UseStatus = ""
    End Select
End Function

Public Function UseStatusCode(strName As String) As String
    Select Case strName
    Case "使用中": UseStatusCode = "1"
    Case "未使用": UseStatusCode = "2"
    Case "不需用": UseStatusCode = "3"
    Case "租出": UseStatusCode = "4"
    Case Else
        UseStatusCode = ""
    End Select
End Function

Public Function DeprectionMethod(strCode As String) As String
    Select Case strCode
    Case "1": DeprectionMethod = "不計提折舊"
    Case "2": DeprectionMethod = "平均年限法"
    Case "3": DeprectionMethod = "工作量法"
    Case "4": DeprectionMethod = "雙倍余額遞減法"
    Case "5": DeprectionMethod = "年數總和法"
    Case "6": DeprectionMethod = "分類折舊法"
    Case Else
        DeprectionMethod = "1"
    End Select
End Function

Public Function DeprectionMethodCode(strName As String) As String
    Select Case strName
    Case "不計提折舊": DeprectionMethodCode = "1"
    Case "平均年限法": DeprectionMethodCode = "2"
    Case "工作量法": DeprectionMethodCode = "3"
    Case "雙倍余額遞減法": DeprectionMethodCode = "4"
    Case "年數總和法": DeprectionMethodCode = "5"
    Case "分類折舊法": DeprectionMethodCode = "6"
    Case Else
        DeprectionMethodCode = "1"
    End Select
End Function

'判斷憑證是否已被刪除
Public Function VoucherExist(ByVal lngVoucherID As Long) As Boolean
    Dim strSql As String
    Dim recVoucher As rdoResultset
    
    VoucherExist = False
    If lngVoucherID > 0 Then
        strSql = "SELECT * FROM Voucher WHERE lngVoucherID=" & lngVoucherID & " AND blnIsVoid = 0 "
        Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recVoucher.EOF Then
            VoucherExist = True
        End If
        recVoucher.Close
        Set recVoucher = Nothing
    End If
End Function
'取消折舊
Public Function UndoDeprection() As Boolean
    Dim strSql As String
    Dim recVoucher As rdoResultset
    Dim clsVoucher As clsVoucherMethod
    Dim lngVoucherID As Long
    
    strSql = "SELECT lngVoucherID FROM Voucher WHERE lngVoucherSourceID=" & vsFixedDeprection _
        & " AND intYear=" & gclsBase.AccountYear & " AND bytPeriod=" & gclsBase.Period _
        & " AND blnIsVoid = 0 "
    Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recVoucher.EOF Then
        lngVoucherID = recVoucher!lngVoucherID
    End If
    recVoucher.Close
    Set recVoucher = Nothing
    If lngVoucherID > 0 Then
        If ShowMsg(frmMain.hwnd, "本期已提折舊，是否取消折舊?", vbQuestion + vbYesNo + vbDefaultButton2, "計提折舊") = vbYes Then
            Set clsVoucher = New clsVoucherMethod
            If Not clsVoucher.DeleteVoucher(lngVoucherID, True) Then
                ShowMsg frmMain.hwnd, "取消折舊失敗!", vbCritical + vbOKOnly, "計提折舊"
            Else
                ShowMsg frmMain.hwnd, "本期已經取消折舊!", vbInformation + vbOKOnly, "計提折舊"
            End If
            Set clsVoucher = Nothing
        End If
    Else
        ShowMsg frmMain.hwnd, "本期以后期間已提折舊!", vbCritical + vbOKOnly, "計提折舊"
    End If
End Function
'檢查期間是否計提折舊
Public Function PeriodDepection(intYear As Integer, intPeriod As Integer, Optional intDiffPeriod As Integer = 0, Optional blnTrade As Boolean = True) As Boolean
    Dim strSql As String
    Dim recVoucher As rdoResultset
    Dim lngPeriod As Long
    Dim intNumPeriod As Integer
    Dim strTrade As String
    
    '若是行政事業版
    strTrade = GetAccountSystem()
    If strTrade = "3" Then
        PeriodDepection = blnTrade
    End If
    
    intNumPeriod = PeriodsOfYear()
    If intDiffPeriod <> 0 Then
        lngPeriod = CLng(intYear) * intNumPeriod + intPeriod + intDiffPeriod - 1
        lngPeriod = (lngPeriod \ intNumPeriod) * 100 + (lngPeriod Mod intNumPeriod + 1)
    Else
        lngPeriod = CLng(intYear) * 100 + intPeriod
    End If
    PeriodDepection = False
    strSql = "SELECT * FROM Voucher WHERE lngVoucherSourceID=" & vsFixedDeprection _
        & " AND (intYear)*100+bytPeriod>=" & lngPeriod _
        & " AND ( blnIsVoid = 0 )"
    Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recVoucher.EOF Then
        PeriodDepection = True
    End If
    recVoucher.Close
    Set recVoucher = Nothing
End Function

'變動記錄是否生成憑證
Public Function AlterExistVoucher(lngFixedAlterID As Long) As Boolean
    Dim strSql As String
    Dim recFixedAlter As rdoResultset
    
    AlterExistVoucher = False
    strSql = "SELECT * FROM FixedAlter WHERE lngFixedAlterID=" & lngFixedAlterID
    Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recFixedAlter.EOF Then
        If recFixedAlter!lngVoucherID > 0 Then
            AlterExistVoucher = VoucherExist(recFixedAlter!lngVoucherID)
        End If
    End If
    recFixedAlter.Close
    Set recFixedAlter = Nothing
End Function

Public Function GetVoucherNo(ByVal lngVoucherID As Long) As String
    Dim strSql As String
    Dim recVoucher As rdoResultset
    
    strSql = "SELECT VoucherType.strVoucherTypCode,lngVoucherNo FROM Voucher " _
        & ", VoucherType WHERE Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID " _
        & "AND lngVoucherID=" & lngVoucherID
    Set recVoucher = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recVoucher.EOF Then
        GetVoucherNo = recVoucher!strVoucherTypCode & "-" & Format(recVoucher!lngVoucherNO, "0000")
    Else
        GetVoucherNo = ""
    End If
    recVoucher.Close
    Set recVoucher = Nothing
End Function

'每年會計期間數
Public Function PeriodsOfYear() As Integer
    Dim strSql As String
    Dim recPeriod As rdoResultset
    strSql = "SELECT bytPeriodNO AS intYearPreiod FROM AccountYear ORDER BY intYear ASC "
    Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recPeriod.EOF Then
        PeriodsOfYear = recPeriod!intYearPreiod
    Else
        PeriodsOfYear = 12
    End If
End Function

'某個固定資產是否提過折舊
Public Function FixedDeprection(ByVal lngCardID As Long, ByVal intYear As Integer, ByVal bytPeriod As Integer) As Boolean
    Dim strSql As String
    Dim recBalance As rdoResultset
    
    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & lngCardID _
        & " AND intYear * 100 + bytPeriod >= " & CLng(intYear) * 100 + bytPeriod _
        & " AND dblDeprection>0"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recBalance.EOF Then
        FixedDeprection = True
    Else
        FixedDeprection = False
    End If
    recBalance.Close
    Set recBalance = Nothing
End Function

'某期固定資產是否錄入工作量
Public Function BeenInputWork(ByVal intYear As Integer, ByVal bytPeriod As Integer) As Boolean
    Dim strSql As String
    Dim strQFixedMax As String