frmclosecost.frm

金算盘软件代码

Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 成本结转
' 1998.7.13
' 作者：唐维勇
'
' 过程：
'     InitStep                                                     向导每步初始化
'     ValidStep                                                    向导每步合法检查
'     Execute                                                      向导完成后需执行的操作
'     GenCostVoucher                                               生成凭证
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mintStepNum As Integer                                    '向导总步骤
Private mintStep As Integer                                       '向导当前步骤
Private mblnEnd As Boolean                                        '完成按扭是否有效
Private mblnValid() As Boolean                                    '向导每步是否合法

Private WithEvents mclsPeriodGrid As Grid                         'Grid对象
Attribute mclsPeriodGrid.VB_VarHelpID = -1
Private WithEvents mclsMainControl As MainControl                 '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Private mVoucherTypeID As Long
Private mTemplateID As Long
Private mRemarkID As Long
Private VoucherData() As VoucherRecord                            '凭证结果

Private Const HelpID = 14005

Private mintYear As Integer                                       '当前年度
Private mintPeriod As Integer                                     '结转期间
Private mintMinPeriod As Integer                                  '最小成本计算日期
Private mintStartYear As Integer                                  '帐套起用会计年度
Private mintStartPeriod As Integer                                '帐套起用会计期间
Private mlngFormatID As Long

'传递参数
Public Sub SetParameters(intFirstPeriod As Integer, intEndPeriod As Integer)
'    mintMinPeriod = intFirstPeriod
'    mintEndPeriod = intEndPeriod
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = hwnd
    SetHelpID HelpContextID
    '进入向导第一步
    If Not mblnValid(0) Then
        stabWizard.Tab = 0
        stabWizard_Click -1
    End If
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
    
    Me.HelpContextID = HelpID
    
    '启用日期
    GetStartPeriod mintStartYear, mintStartPeriod
    mintYear = gclsBase.AccountYear
    mlngFormatID = 41
    
    '主控对象
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '向导初始化(包括每步仅需初始一次的部分)
    mintStepNum = stabWizard.Tabs - 1
    mintStep = -1
    mblnEnd = False
    ReDim mblnValid(mintStepNum)
End Sub


Private Sub Form_Resize()
    If WindowState <> vbMinimized Then
        If (Left < 0 Or Left > Screen.width) And WindowState <> vbMaximized Then
            Left = (Screen.width - width) / 2
        End If
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If (TypeOf Screen.ActiveControl Is ListText) Then
        If Not Screen.ActiveControl.ReferVisible Then
            If KeyCode = vbKeyReturn Then
               KeyCode = 0
               SendKeys "{Tab}", True
            End If
        End If
    Else
        If KeyCode = vbKeyReturn Then
           KeyCode = 0
           SendKeys "{Tab}", True
        End If
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    Set mclsPeriodGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    
    '删除凭证类型参照
    If Not lstxtType.Resultset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If
End Sub


Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '响应消息
    If fraWizard(1).Tag = "已设置" Then
        For Each vntMessage In mclsMainControl.Messages
            Select Case vntMessage
            Case Message.msgVoucherType
                RefreshVoucherType
            Case Message.msgTemplate
                RefreshTemplate
            End Select
        Next
    End If
    
    gclsSys.CurrFormName = hwnd
End Sub

Private Sub stabWizard_Click(PreviousTab As Integer)
    Dim intCnt As Integer
    
    For intCnt = 0 To stabWizard.Tabs - 1
        fraWizard(intCnt).Visible = (intCnt = stabWizard.Tab)
    Next intCnt
    
    ' 若向导进入其他步骤，进行该步骤合法检查
    If stabWizard.Tab > mintStep And mintStep < mintStepNum Then
        If ValidStep(mintStep) Then
            mintStep = stabWizard.Tab
            
            '初始向导步骤
            InitStep mintStep
            
        End If
    Else
        mintStep = stabWizard.Tab
        InitStep mintStep
        RefreshCmd
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'向导公用过程
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 向导每步合法检查
Private Function ValidStep(ByVal TabIndex As Integer) As Boolean
    Dim strMsg As String, lngBottom As Integer
    
    Select Case TabIndex
    Case 0: ValidStep = ValidPeriod(strMsg)        '会计期间
    Case 1: ValidStep = ValidOption(strMsg)        '凭证选项
    Case 2: ValidStep = ValidResult(strMsg)        '执行调汇
    Case Else
        ValidStep = True
    End Select
    
    '返回上一步
    If Not ValidStep Then
        If mintStep <= stabWizard.Tab Then
            stabWizard.Tab = mintStep
            ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
        Else
            mintStep = stabWizard.Tab
            RefreshCmd
        End If
    End If
    
    '设置每步合法性
    If TabIndex <> -1 Then
        mblnValid(TabIndex) = ValidStep
    End If
    
End Function

' 向导每步初始设置
Private Sub InitStep(ByVal TabIndex As Integer)
    Select Case TabIndex
    Case 0: InitPeriod        '会计期间
    Case 1: InitOption        '凭证选项
    Case 2
        If Not mblnValid(1) Then
            InitOption
            stabWizard.Tab = 1
        Else
            InitResult        '执行结转
        End If
    End Select
    RefreshCmd
End Sub

' 向导完成后需执行的操作
Private Sub Execute()
    Dim strSql As String
    Dim recVoucher As rdoResultset
    Dim lngCnt As Long, lngCntDetail As Long
    Dim intYear As Integer
    Dim errNo As Long
    
    On Error GoTo ErrHandle
    
    intYear = gclsBase.FYearOfDate(gclsBase.BaseDate)
    
    If VoucherData(0).Used Then
        VoucherData(0).TemplateID = mTemplateID
        VoucherData(0).VoucherTypeID = mVoucherTypeID
        If lstxtRemark.Text <> "结转成本[商品性质]" Then
            For lngCntDetail = 0 To UBound(VoucherData(0).Detail)
                VoucherData(0).Detail(lngCntDetail).Remark = Trim$(lstxtRemark.Text)
            Next lngCntDetail
        End If
    End If
    
    If SaveVoucher(VoucherData) Then
        Me.Hide
'        AutoBackup "成本结转"
        gclsSys.SendMessage Me.hwnd, msgReceipt41
        BillPublic.ShowBill 50, VoucherData(0).VoucherID
    Else
        If VoucherData(0).ErrorString <> "" Then
            ShowMsg hwnd, "生成成本结转凭证失败：" & VoucherData(0).ErrorString, vbOKOnly + vbCritical, Caption
        Else
            ShowMsg hwnd, "没有凭证生成！", vbOKOnly + vbCritical, Caption
        End If
    End If
    
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
End Sub

Private Sub cmdStep_Click(Index As Integer)
    Dim blnUnload As Boolean
    Dim strMsg As String
    
    blnUnload = False
    
    Select Case Index
    Case 0  '取消
        blnUnload = True
    Case 1  '上一步
        If stabWizard.Tab > 0 Then
            stabWizard.Tab = stabWizard.Tab - 1
        End If
    Case 2  '下一步
        If stabWizard.Tab < mintStepNum Then
            stabWizard.Tab = stabWizard.Tab + 1
        End If
    Case 3: '完成
        If ValidStep(mintStepNum) Then
            cmdStep(3).Enabled = False
            Execute
            blnUnload = True
        End If
    End Select
    
    If blnUnload Then
       Unload Me
    End If
End Sub

'重设按扭显示属性
Private Sub RefreshCmd()
    Dim lngCnt As Long
    
    Select Case stabWizard.Tab
    Case 0
        cmdStep(1).Enabled = False
        cmdStep(2).Enabled = True
    Case mintStepNum
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = False
    Case Else
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = True
    End Select
    
    '是否每步都合法
    For lngCnt = 0 To mintStepNum
        If Not mblnValid(lngCnt) Then
            Exit For
        End If
    Next lngCnt
    cmdStep(3).Enabled = (lngCnt > mintStepNum)
    
    '若是最后一步，把完成按扭变为有效
    If Not cmdStep(3).Enabled Then
        If stabWizard.Tab = mintStepNum Then
            cmdStep(3).Enabled = True
        End If
    End If

    If stabWizard.Tab = stabWizard.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  向导步骤初始化
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'第一步：会计期间初始
Private Sub InitPeriod()
    Dim strSql As String, recPeriod As rdoResultset
    Dim recVoucher As rdoResultset
    Dim recItem As rdoResultset
    Dim lngCnt As Long
    
    If fraWizard(0).Tag <> "已设置" Then
        strSql = "SELECT '' AS ID, 0 As VoucherID," _
                & "intYear || '.' || LPAD(bytPeriod,2,'0') 期间, " _
                & "'' AS 结转成本, " _
                & "DECODE(lngCloseID,0,'','√') AS 结帐, " _
                & "strCloseDate AS 日期 "
        strSql = strSql & "FROM AccountPeriod , Operator WHERE " _
                & "AccountPeriod.lngCloseID=Operator.lngOperatorID(+) " _
                & "AND intYear=" & gclsBase.FYearOfDate(gclsBase.BaseDate)
        
        Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Set datPeriod.Resultset = recPeriod
        
        fraWizard(0).Tag = "已设置"
        
        msgPeriod.SelectionMode = flexSelectionByRow
        Set mclsPeriodGrid = New Grid
        Set mclsPeriodGrid.Grid = msgPeriod
        mclsPeriodGrid.ColOfs = 2
        mclsPeriodGrid.SetupStyle
        msgPeriod.ColWidth(0) = 0
        msgPeriod.ColWidth(1) = 0
        msgPeriod.ColWidth(2) = 800
        msgPeriod.ColWidth(3) = 900
        msgPeriod.ColWidth(4) = 450
        msgPeriod.ColWidth(5) = 1000
        
        '各期是否有成本结转凭证（不包括冲销凭证）
        strSql = "SELECT strDate,bytPeriod,lngVoucherID,lngPostID FROM Voucher WHERE intYear=" _
            & gclsBase.AccountYear & " AND lngVoucherSourceID=" & vsCost & " AND blnIsVoid = 0 "