frmunend.frm

金算盘软件代码

    '启用日期
    GetStartPeriod mintStartYear, mintStartPeriod
    mintYear = gclsBase.AccountYear
    lblPeriod.Caption = "(无)"
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '向导初始化(包括每步仅需初始一次的部分)
    mintStepNum = stabEnd.Tabs - 1
    mintStep = -1
    mblnEnd = False
    ReDim mblnValid(mintStepNum)
End Sub


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

Private Sub Form_Unload(Cancel As Integer)
    Dim strDBName As String
    On Error Resume Next
    
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    Set mclsPeriodGrid = Nothing
End Sub

Private Sub mclsMainControl_ChildActive()
    frmMain.SetEditUnEnabled
End Sub

Private Sub stabEnd_Click(PreviousTab As Integer)
    
    ' 若向导进入其他步骤，进行该步骤合法检查
    If stabEnd.Tab > mintStep And mintStep < mintStepNum Then
        If ValidStep(mintStep) Then
            mintStep = stabEnd.Tab
            '初始向导步骤
            InitStep mintStep
        End If
    Else
        mintStep = stabEnd.Tab
        InitStep mintStep
        RefreshCmd
    End If
    If stabEnd.Tab = stabEnd.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    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 = ValidOver(strMsg)          '取消结帐
    Case Else
        ValidStep = True
    End Select
    
    '返回上一步
    If Not ValidStep Then
        If mintStep < stabEnd.Tab Then
            stabEnd.Tab = mintStep
            ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
        Else
            mintStep = stabEnd.Tab
            RefreshCmd
        End If
    End If
    
    '设置每步合法性
    If TabIndex <> -1 Then
        mblnValid(TabIndex) = ValidStep
    End If
    
End Function

' 向导每步初始设置
Private Sub InitStep(ByVal TabIndex As Integer)
    Me.MousePointer = vbHourglass
    Select Case TabIndex
    Case 0: InitPeriod        '会计期间
    Case 2: InitOver          '取消结帐
    End Select
    RefreshCmd
    Me.MousePointer = vbDefault
End Sub

' 向导完成后需执行的操作
Private Sub Execute()
    Dim strSql As String
    Dim errNo As Long
    
    On Error GoTo ErrHandle
    
    '关闭结帐期间
    strSql = "UPDATE AccountPeriod SET lngCloseID=0,strCloseDate='" & Chr(1) _
        & "' WHERE intYear=" & mintYear & " AND bytperiod=" & mintPeriod
    If Not gclsBase.ExecSQL(strSql) Then
        ShowMsg hwnd, "取消结帐失败！", vbCritical + vbOKOnly, Caption
    Else
        gclsBase.GetBaseInfo
    End If
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    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 stabEnd.Tab > 0 Then
            stabEnd.Tab = stabEnd.Tab - 1
        End If
    Case 2  '下一步
        If stabEnd.Tab < mintStepNum Then
            stabEnd.Tab = stabEnd.Tab + 1
        End If
    Case 3: '完成
        If ValidStep(mintStepNum) Then
            cmdStep(3).Enabled = False
            Execute
        End If
        blnUnload = True
    End Select
    
    If blnUnload Then
       Unload Me
    End If
End Sub

'重设按扭显示属性
Private Sub RefreshCmd()
    Dim lngCnt As Long
    
    Select Case stabEnd.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 stabEnd.Tab = mintStepNum Then
            cmdStep(3).Enabled = True
        End If
    End If
End Sub


''''''''''''''''''''''''''''''''
'
' 初始过程
'
''''''''''''''''''''''''''''''''

'第一步：会计期间初始
Private Sub InitPeriod()
    Dim strSql As String, recPeriod As rdoResultset
    Dim lngCnt As Long
    If fraend(0).Tag <> "已设置" Then
        'strSql = "SELECT '' AS ID, " _
                & "intYear & '.' & Format(bytPeriod,'00') AS 期间, " _
                & "IIF(lngCloseID>0,'√','') AS 结帐, " _
                & "strCloseDate AS 日期, " _
                & "strOperatorName AS 操作员 "
        strSql = "SELECT '' AS ID, " _
                & "intYear || '.' || LPAD(bytPeriod,2,'0') AS 期间, " _
                & "DECODE(SIGN(lngCloseID),1,'√','') AS 结帐, " _
                & "strCloseDate AS 日期, " _
                & "strOperatorName AS 操作员 "
        'strSql = strSql & "FROM AccountPeriod LEFT JOIN Operator ON " _
                & "AccountPeriod.lngCloseID=Operator.lngOperatorID " _
                & "WHERE intYear=" & gclsBase.AccountYear
        strSql = strSql & " FROM AccountPeriod,Operator " _
                & " WHERE AccountPeriod.lngCloseID=Operator.lngOperatorID(+) " _
                & " AND intYear=" & gclsBase.AccountYear
        
        'Set recPeriod = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        'Set datPeriod.Recordset = recPeriod
        Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Set datPeriod.Resultset = recPeriod
        
        fraend(0).Tag = "已设置"
        
        Set mclsPeriodGrid = New Grid
        Set mclsPeriodGrid.Grid = msgPeriod
        mclsPeriodGrid.ColOfs = 1
        mclsPeriodGrid.SetupStyle
        msgPeriod.ColWidth(0) = 0
        msgPeriod.ColWidth(1) = 800
        msgPeriod.ColWidth(2) = 500
        msgPeriod.ColWidth(3) = 1000
        msgPeriod.ColWidth(4) = 1000
        
        If gclsBase.AccountYear = mintStartYear Then
            msgPeriod.ColAlignment(2) = 4
            For lngCnt = 1 To mintStartPeriod - 1
                msgPeriod.TextMatrix(lngCnt, 2) = "—"
            Next lngCnt
        End If
        mintPeriod = 0
        With msgPeriod
            For lngCnt = .Rows - 1 To .FixedRows - 1 Step -1
                If .TextMatrix(lngCnt, 2) = "√" Then
                    .Row = lngCnt
                    mintPeriod = CInt(Mid(.TextMatrix(.Row, 1), 6, 2))
                    lblPeriod.Caption = .TextMatrix(.Row, 1)
                    Exit For
                End If
            Next lngCnt
            If mintPeriod > 0 Then
                For lngCnt = 0 To .Cols - 1
                    .col = lngCnt
                    .CellBackColor = &H8000000D
                    .CellForeColor = &H8000000E
                Next lngCnt
            End If
        End With
    End If
End Sub


'第三步：取消结帐初始
Private Function InitOver()
    Dim lngCnt As Integer
End Function

''''''''''''''''''''''''''''''''
'
' 合法检查
'
''''''''''''''''''''''''''''''''

'第一步：会计期间合法检查
Private Function ValidPeriod(Msg As String) As Boolean
    Dim strSql As String
    Dim recPeriod As rdoResultset
    
    ValidPeriod = True
    
    '短开绑定数据
    'Set datPeriod.Recordset = Nothing
    Set datPeriod.Resultset = Nothing
    If mintPeriod = 0 Then
        Msg = "没有可取消结帐的会计期间！"
        ValidPeriod = False
    End If
    
    If ValidPeriod Then
        strSql = "SELECT * FROM AccountPeriod WHERE (intYear=" & mintYear & " AND bytPeriod>" _
            & mintPeriod & ") OR (intYear>" & mintYear & ") ORDER BY intYear,bytPeriod"
        'Set recPeriod = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recPeriod.EOF Then
            If recPeriod!lngCloseID > 0 Then
                Msg = "下一个期间已过帐，本期不能取消结帐！"
                ValidPeriod = False
            ElseIf recPeriod!strCloseDate = Chr(1) Then
                #If conTest = 1 Then
                    Msg = "下一个期间结过帐，本期不能取消结帐！"
                    ValidPeriod = False
                #End If
            End If
        End If
        recPeriod.Close
        Set recPeriod = Nothing
    End If
End Function


'第二步：执行结帐合法检查
Private Function ValidOver(Msg As String) As Boolean
    ValidOver = True
    If mintPeriod = 0 Then
        ValidOver = False
        Msg = "没有结帐月份！"
    End If
End Function


Private Sub msgPeriod_Click()
    msgPeriod.col = 0
    msgPeriod.ColSel = 0
End Sub

Private Sub msgPeriod_KeyDown(KeyCode As Integer, Shift As Integer)
    KeyCode = 0
End Sub