frmloss.frm

金算盘软件代码

    Dim lngCnt As Long
    
    ValidAccount = True
    lngCnt = 0
    With msgLossAccount
        For lngRow = 1 To .Rows - 1
            If .TextMatrix(lngRow, 1) = "√" Then
                
                If stabWizard.TabVisible(1) And fraWizard(1).Tag = "已设置" Then
                    msgLossAccount1.TextMatrix(lngRow, 1) = ""
                    msgLossAccount1.TextMatrix(lngRow, 3) = ""
                    msgLossAccount1.TextMatrix(lngRow, 4) = 0
                End If
                
                lngCnt = lngCnt + 1
                If Trim$(.TextMatrix(lngRow, 3)) = "" Then
                    ValidAccount = False
                    Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                    Exit For
                Else
                    If IsNumeric(.TextMatrix(lngRow, 4)) Then
                        If .TextMatrix(lngRow, 4) = 0 Then
                            ValidAccount = False
                            Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                            Exit For
                        End If
                    Else
                        ValidAccount = False
                        Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                        Exit For
                    End If
                End If
            End If
        Next lngRow
    End With
    
    If lngCnt = 0 And Not stabWizard.TabVisible(1) Then
        Msg = "请选择结转科目!"
        ValidAccount = False
    ElseIf Not CheckProfit() Then
        Msg = lblProfit.Caption & "和" & lblProfit1.Caption & "不能是同一个明细科目!"
        ValidAccount = False
    End If
    
    fraWizard(4).Tag = ""
End Function
Private Function CheckProfit() As Boolean
    Dim strSql As String
    Dim recDetail As rdoResultset
    
    CheckProfit = True
    If stabWizard.TabVisible(1) Then
        If ltxtProfit.ID > 0 And ltxtProfit1.ID > 0 And ltxtProfit.ID = ltxtProfit1.ID Then
            strSql = "SELECT blnIsDetail FROM Account WHERE lngAccountID=" & ltxtProfit.ID
            'Set recDetail = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recDetail.EOF Then
                If recDetail!blnIsDetail Then
                    CheckProfit = False
                End If
            End If
            recDetail.Close
            Set recDetail = Nothing
        End If
    End If
End Function

Private Function ValidAccount1(Msg As String) As Boolean
    Dim lngRow As Long
    Dim lngCnt As Long
    
    ValidAccount1 = True
    lngCnt = 0
    With msgLossAccount1
        For lngRow = 1 To .Rows - 1
            If .TextMatrix(lngRow, 1) = "√" Then
                
                If fraWizard(0).Tag = "已设置" Then
                    msgLossAccount.TextMatrix(lngRow, 1) = ""
                    msgLossAccount.TextMatrix(lngRow, 3) = ""
                    msgLossAccount.TextMatrix(lngRow, 4) = 0
                End If
                
                lngCnt = lngCnt + 1
                If Trim$(.TextMatrix(lngRow, 3)) = "" Then
                    ValidAccount1 = False
                    Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                    Exit For
                Else
                    If IsNumeric(.TextMatrix(lngRow, 4)) Then
                        If .TextMatrix(lngRow, 4) = 0 Then
                            ValidAccount1 = False
                            Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                            Exit For
                        End If
                    Else
                        ValidAccount1 = False
                        Msg = Trim(.TextMatrix(lngRow, 2)) & "未指定转入科目！"
                        Exit For
                    End If
                End If
            End If
        Next lngRow
    End With
    
    fraWizard(4).Tag = ""
End Function

'第二步，凭证选项
Private Function ValidOption(Msg As String) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim strCode As String, strText As String
    
    ValidOption = True
    
    strText = lstxtTemplate.Text
    If InStr(strText, vbTab) > 0 Then
        strCode = Left(strText, InStr(strText, vbTab) - 1)
    Else
        If InStr(strText, " ") > 0 Then
            strCode = Left(strText, InStr(strText, " ") - 1)
        Else
            strCode = Trim(strText)
        End If
    End If
    If strCode = "" Then
        ValidOption = False
        Msg = "请输入凭证模板！"
    End If
    
    If ValidOption Then
        If lstxtTemplate.ID = 0 Then
            Msg = "凭证模板不存在！"
            ValidOption = False
        End If
'        strSql = "SELECT lngTemplateID FROM Template WHERE lngReceiptTypeID=" & rtVoucher _
'            & " AND strTemplateName='" & strCode & "'"
'        Set recTmp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'        If recTmp.EOF Then
'            Msg = "凭证模板不存在！"
'            ValidOption = False
'        Else
'            mTemplateID = recTmp!lngTemplateID
'        End If
'        recTmp.Close
'        Set recTmp = Nothing
    End If
    
    If ValidOption Then
        strText = lstxtType.Text
        If InStr(strText, vbTab) > 0 Then
            strCode = Left(strText, InStr(strText, vbTab) - 1)
        Else
            If InStr(strText, " ") > 0 Then
                strCode = Left(strText, InStr(strText, " ") - 1)
            Else
                strCode = Trim(strText)
            End If
        End If
        If strCode = "" Then
            ValidOption = False
            Msg = "请输入凭证类型！"
        End If
    End If
    
    If ValidOption Then
        strSql = "SELECT lngVoucherTypeID FROM VoucherType " _
            & "WHERE strVoucherTypeCode='" & strCode & "'"
        'Set recTmp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTmp.EOF Then
            Msg = "凭证类型不存在！"
            ValidOption = False
        Else
            mVoucherTypeID = recTmp!lngVoucherTypeID
        End If
        recTmp.Close
        Set recTmp = Nothing
    End If
    SaveSet 1, "损益结转", "凭证摸板", lstxtTemplate.ID, True, "Long"
    SaveSet 1, "损益结转", "凭证类型", lstxtType.ID, True, "Long"
End Function

'第三步，生成方式
Private Function ValidManner(Msg As String) As Boolean
    ValidManner = True
    fraWizard(4).Tag = ""
End Function

'第四步，凭证预览
Private Function ValidResult(Msg As String) As Boolean
    ValidResult = True
    
    If ExclusiveIn(Caption, mclsMainControl.LogID, "损益结转") Then
        If ValidResult Then
            If lstxtRemark.Text = "" Then
                ValidResult = False
                Msg = "未指定凭证摘要！"
            End If
        End If
    Else
        ValidResult = False
        stabWizard.Tab = mintStepNum - 1
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 其他过程
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub msgLossAccount_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgLossAccount
        If .MouseCol = 1 Then
            .MousePointer = flexCustom
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub
Private Sub msgLossAccount1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgLossAccount1
        If .MouseCol = 1 Then
            .MousePointer = flexCustom
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub

Private Sub msgLossAccount_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 32 Then Exit Sub
    
    If msgLossAccount.col <> 3 Then
        ChoiceOneLoss msgLossAccount.Row
    End If
End Sub
Private Sub msgLossAccount1_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 32 Then Exit Sub
    
    If msgLossAccount1.col <> 3 Then
        ChoiceOneLoss1 msgLossAccount1.Row
    End If
End Sub

Private Sub msgLossAccount_Click()
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim recLoss As rdoResultset
    Dim lngRow As Long
    
    With msgLossAccount
        If .MouseCol = 1 And .MouseRow >= .FixedRows And .MouseRow < .Rows Then
            lngRow = .MouseRow
            ChoiceOneLoss lngRow
        End If
    End With
End Sub
Private Sub msgLossAccount1_Click()
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim recLoss As rdoResultset
    Dim lngRow As Long
    
    With msgLossAccount1
        If .MouseCol = 1 And .MouseRow >= .FixedRows And .MouseRow < .Rows Then
            lngRow = .MouseRow
            ChoiceOneLoss1 lngRow
        End If
    End With
End Sub

Private Sub ChoiceOneLoss(ByVal lngRow As Long)
    Dim strSql As String
    Dim recAccount As rdoResultset
    Dim recLoss As rdoResultset
    
    With msgLossAccount
        If Trim$(.TextMatrix(lngRow, 1)) = "" Then
            .TextMatrix(lngRow, 1) = "√"
             'strSql = "UPDATE Account SET blnIsProfitLoss=True WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
            strSql = "UPDATE Account SET blnIsProfitLoss=1 WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
            If stabWizard.TabVisible(1) Then
                msgLossAccount1.TextMatrix(lngRow, 1) = ""
                msgLossAccount1.TextMatrix(lngRow, 3) = ""
                msgLossAccount1.TextMatrix(lngRow, 4) = 0
            End If
        Else
            .TextMatrix(lngRow, 1) = ""
            'strSql = "UPDATE Account SET blnIsProfitLoss=False WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
            strSql = "UPDATE Account SET blnIsProfitLoss=0 WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
        End If
        gclsBase.ExecSQL strSql
        
        If .TextMatrix(lngRow, 1) = "√" Then
            'strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtProfit.ID & " AND blnIsDetail"
            'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
            strSql = "SELECT * FROM Account WHERE lngAccountID=" & ltxtProfit.ID & " AND blnIsDetail=1"
            Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAccount.EOF Then
                strSql = "SELECT * FROM Account WHERE lngAccountID=" & .TextMatrix(.Row, 0)
                'Set recLoss = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                Set recLoss = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recLoss.EOF Then
                    'If Not (recAccount!blnIsCustomer = recLoss!blnIsCustomer And _
                        recAccount!blnIsDepartment = recLoss!blnIsDepartment And _
                        recAccount!blnIsEmployee = recLoss!blnIsEmployee And _
                        recAccount!blnIsClass1 = recLoss!blnIsClass1 And _
                        recAccount!blnIsClass2 = recLoss!blnIsClass2) And _
                        (recAccount!blnIsCustomer = True Or _
                        recAccount!blnIsDepartment = True Or _
                        recAccount!blnIsEmployee = True Or _
                        recAccount!blnIsClass1 = True Or _
                        recAccount!blnIsClass2 = True) Then
                    If Not (recAccount!blnIsCustomer = recLoss!blnIsCustomer And _
                        recAccount!blnIsDepartment = recLoss!blnIsDepartment And _
                        recAccount!blnIsEmployee = recLoss!blnIsEmployee And _
                        recAccount!blnIsClass1 = recLoss!blnIsClass1 And _
                        recAccount!blnIsClass2 = recLoss!blnIsClass2) And _
                        (recAccount!blnIsCustomer = 1 Or _
                        recAccount!blnIsDepartment = 1 Or _
                        recAccount!blnIsEmployee = 1 Or _
                        recAccount!blnIsClass1 = 1 Or _
                        recAccount!blnIsClass2 = 1) Then
                        ShowMsg hWnd, "转入科目必须与转出科目有相同的辅助核算！", vbOKOnly + vbExclamation, Caption
                        .TextMatrix(lngRow, 1) = ""
                    Else
                        .TextMatrix(lngRow, 3) = ltxtProfit.Text
                        .TextMatrix(lngRow, 4) = recAccount!lngAccountID
                        strSql = "UPDATE Account SET lngProfitLossAccountID=" & recAccount!lngAccountID _
                            & " WHERE lngAccountID=" & .TextMatrix(lngRow, 0)
                        gclsBase.ExecSQL strSql
                    End If
                End If
                recLoss.Close
                Set recLoss = Nothing
            End If
            recAccount.Close
            Set re