frmdispart.frm

金算盘软件代码

    '删除凭证类型参照
    If Not ltxtType.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If
End Sub

'更新与子窗体相关的菜单项的可用性
Private Sub UpdateMenuStatus()
    With frmMain
        ' 设置MDI主窗口菜单可用标志
        .mnuEditUndo.Enabled = False
        .mnuEditCut.Enabled = False
        .mnuEditCopy.Enabled = False
        .mnuEditPaste.Enabled = False
        .mnuEditInsLine.Enabled = False
        .mnuEditDelLine.Enabled = False
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditInActive.Enabled = False
        .mnuEditShowAll.Enabled = False
        .mnuEditShowList.Enabled = False
        .mnuEditUse.Enabled = False
        .mnuEditNotepad.Enabled = False
        .mnuEditFilter.Enabled = False
        .mnuEditColumn.Enabled = False
        .mnuFilePrintSetup.Enabled = False
        .mnuFilePrint.Enabled = False
        .mnuReportQuick.Enabled = False
        .mnuToolRefresh.Enabled = False
        .SetToolBar
    End With
End Sub



Private Sub ltxtType_Choose()
    RefreshTemplate ltxtTemplate.ID
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
                mclsMainControl.Messages.Remove CStr(vntMessage)
                RefreshVoucherType ltxtType.ID
            Case Message.msgTemplate
                mclsMainControl.Messages.Remove CStr(vntMessage)
                RefreshTemplate ltxtTemplate.ID
            Case Message.msgAccount
                mclsMainControl.Messages.Remove CStr(vntMessage)
                RefreshAccount 0
            End Select
        Next
    End If
    
    gclsSys.CurrFormName = hwnd
    UpdateMenuStatus
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
    ElseIf mintStep <> stabWizard.Tab Then
        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 = ValidAccount1(strMsg)       '结余转入
    Case 1: ValidStep = ValidAccount2(strMsg)        '结余分配
    Case 2: ValidStep = ValidResult(strMsg)        '凭证预演
    Case Else
        ValidStep = True
    End Select
    
    '返回上一步
    If Not ValidStep Then
        If mintStep < stabWizard.Tab Then
            stabWizard.Tab = mintStep
        Else
            mintStep = stabWizard.Tab
            RefreshCmd
        End If
        ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
    End If
    
    '设置每步合法性
    If TabIndex <> -1 Then
        mblnValid(TabIndex) = ValidStep
    End If
    
End Function

' 向导每步初始设置
Private Sub InitStep(TabIndex As Integer)
    Dim lngCnt As Long
    Me.MousePointer = vbHourglass
    
    Select Case TabIndex
    Case 0: InitAccount1       '结余转入
    Case 1: InitAccount2        '结余分配
    Case 2
        For lngCnt = 0 To TabIndex - 1
            If Not mblnValid(lngCnt) Then
                stabWizard.Tab = lngCnt
            End If
        Next lngCnt
        InitResult        '凭证预演
    End Select
    RefreshCmd
    Me.MousePointer = vbDefault
End Sub

' 向导完成后需执行的操作
Private Sub Execute()
    Dim lngCnt As Long, lngCntDetail As Long
    Dim errNo As Long
    Dim strMsg As String
    
    On Error GoTo ErrHandle
    
    If Not SaveVoucher(VoucherData) Then
        If VoucherData(0).ErrorString <> "" Then
            ShowMsg hwnd, "凭证生成失败：" & VoucherData(0).ErrorString, vbOKOnly + vbCritical, Caption
        Else
            ShowMsg hwnd, "没有凭证生成！", vbOKOnly + vbCritical, Caption
        End If
    Else
        lngCntDetail = 0
        For lngCnt = 0 To UBound(VoucherData)
            If VoucherData(lngCnt).Used Then
                If Not VoucherData(lngCnt).IsError Then
                    lngCntDetail = lngCntDetail + 1
                Else
                    strMsg = strMsg & Chr(13) & "第" & lngCnt & "张凭证" & VoucherData(lngCnt).ErrorString
                End If
            End If
        Next lngCnt
        If strMsg <> "" Then
            ShowMsg hwnd, "生成了" & lngCntDetail & "张凭证，其中：" & strMsg, vbOKOnly + vbExclamation, Caption
        End If
        gclsSys.SendMessage Me.hwnd, msgReceipt41
        For lngCnt = 0 To UBound(VoucherData)
            If VoucherData(lngCnt).Saved Then
                Me.Hide
                BillPublic.ShowBill 50, VoucherData(lngCnt).VoucherID
                Exit For
            End If
        Next lngCnt
    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 Function InitAccount1()
    
    If fraWizard(0).Tag <> "已设置" Then
        fraWizard(0).Tag = "已设置"
        '结余转入
        RefreshAccount 11
        ltxtAcc11.SeekId GetSet(1, "结余分配", "收支结余科目", 0)
        
        RefreshAccount 12
        ltxtAcc12.SeekId GetSet(1, "结余分配", "财政专项补助结余科目", 0)
        
        RefreshAccount 13
        ltxtAcc13.SeekId GetSet(1, "结余分配", "待分配结余科目", 0)
    End If
End Function

'第二步：凭证选项初始
Private Function InitAccount2()
    Select Case mdblBalance13
    Case Is > 0
        lblNote(4).Visible = False
        lblNote(13).Visible = False
        fraLoss.Visible = False
        fraProfit.Visible = True
        lblNote(12).Visible = True
        spinRate.Text = Format(GetSet(1, "结余分配", "提取职工福利基金比例", 0), "0.00")
        RefreshAccount 31
        ltxtAcc31.SeekId GetSet(1, "结余分配", "职工福利基金科目", 0)
        RefreshAccount 32
        ltxtAcc32.SeekId GetSet(1, "结余分配", "结余分配科目3", 0)
        RefreshAccount 33
        ltxtAcc33.SeekId GetSet(1, "结余分配", "未分配结余转入", 0)
    Case Is < 0
        lblNote(4).Visible = True
        fraLoss.Visible = True
        fraProfit.Visible = False
        lblNote(12).Visible = False
        lblNote(13).Visible = False
        RefreshAccount 21
        ltxtAcc21.SeekId GetSet(1, "结余分配", "弥补亏损科目", 0)
        RefreshAccount 22
        ltxtAcc22.SeekId GetSet(1, "结余分配", "结余分配科目2", 0)
    Case Else
        lblNote(4).Visible = False
        fraLoss.Visible = False
        fraProfit.Visible = False
        lblNote(12).Visible = False
        lblNote(13).Visible = True
    End Select
End Function

'第三步：凭证预缆初始
Private Function InitResult()
    Dim lngCnt As Long, lngCntDetail As Long, lngCntOrder As Long
    Dim strResult As String, strDetail As String, strAmount As String
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim lngLen As Long, lngSpace As Long
    
    If fraWizard(2).Tag <> "已设置" Then