frmtransferloss.frm

金算盘软件代码

    Else
        If InStr(strText, " ") > 0 Then
            strCode = Left(strText, InStr(strText, " ") - 1)
        Else
            strCode = Trim(strText)
        End If
    End If
    If strCode = "" Then
        ValidAccount = False
        Msg = "请输入科目！"
    End If
    
    If ValidAccount Then
        strSQL = "SELECT * FROM Account WHERE strAccountCode='" & strCode & "'"
        'Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recAccount = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
        If Not recAccount.EOF Then
            If recAccount!blnIsDetail = 0 Then
                ValidAccount = False
                Msg = "科目必须是明细科目！"
            ElseIf recAccount!blnIsCustomer = 1 Or recAccount!blnIsDepartment = 1 Or recAccount!blnIsEmployee = 1 Or _
                recAccount!blnIsClass1 = 1 Or recAccount!blnIsClass2 = 1 Or _
                recAccount!blnIsQuantity = 1 Or recAccount!blnIsMultCurrency = 1 Or recAccount!blnIsAllCurrency = 1 Then
                ValidAccount = False
                Msg = "汇兑损益科目不能有辅助核算,也不能进行外币核算！"
            ElseIf recAccount!lngAccountNatureID > 0 Then
                ValidAccount = False
                Msg = "汇兑损益科目不能是现金银行、应收应付及存货类科目！"
            Else
                mAccountID = recAccount!lngAccountID
            End If
        Else
            ValidAccount = False
            Msg = "科目不存在！"
        End If
        recAccount.Close
    End If
    If ValidAccount Then
        SaveSet 1, "特殊科目", "汇兑损益", mAccountID
    Else
        On Error Resume Next
        lstxtAccount.Text = ""
        lstxtAccount.SetFocus
    End If
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
    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
    End If
    SaveSet 1, "汇兑损益", "凭证类型", lstxtType.ID, True, "Long"
    SaveSet 1, "汇兑损益", "凭证摸板", lstxtTemplate.ID, True, "Long"
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
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 其他过程
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub mclsRateGrid_DataValid(blnCancel As Boolean)
    If Trim$(txtRate.Text) = "" Then
        ShowMsg hWnd, "必须输入汇率！", vbOKOnly + vbExclamation, Caption
        blnCancel = True
    End If
    If Not blnCancel Then
        If Not IsNumeric(txtRate.Text) Then
            ShowMsg hWnd, "必须输入数值！", vbOKOnly + vbExclamation, Caption
            blnCancel = True
        End If
    End If
    If Not blnCancel Then
        If CDbl(txtRate.Text) <= 0 Then
            ShowMsg hWnd, "汇率必须输入且不能小于0！", vbOKOnly + vbExclamation, Caption
            blnCancel = True
        End If
    End If
    mblnValid(mintStepNum) = False
End Sub


'卡片新增（科目）
Private Sub lstxtAccount_Choose()
    Dim strMsg As String
    mAccountID = lstxtAccount.TextMatrix(lstxtAccount.ReferRow, 1)
    If Not ValidAccount(strMsg) Then
        ShowMsg hWnd, strMsg, vbOKOnly + vbExclamation, Caption
    End If
End Sub
Private Sub lstxtAccount_AddNew()
    mAccountID = Card.AddCard(msgAccount)
    RefreshAccount mAccountID
End Sub
Private Sub lstxtAccount_Delete()
    If mAccountID > 0 Then
        If Card.DelCard(msgAccount, mAccountID) Then
            mAccountID = 0
            RefreshAccount
        Else
            lstxtAccount.SeekId mAccountID
        End If
    End If
End Sub
Private Sub lstxtAccount_Edit()
    Dim lngID As Long
    
    If mAccountID > 0 Then
        Card.EditCard msgAccount, mAccountID
        RefreshAccount mAccountID
    End If
End Sub
Private Sub lstxtAccount_ItemNotExist()
    Dim lngID As Long
    On Error Resume Next
    If lstxtAccount.Visible Then
        If frmMsgAdd.MsgAddShow("增加科目", "科目“" & Trim(lstxtAccount.Text) & "”不存在，是否新增?") = vbOK Then
            lngID = Card.AddCard(msgAccount, lstxtAccount.Text)
            RefreshAccount lngID
        Else
            lstxtAccount.Text = ""
        End If
        lstxtAccount.SetFocus
    Else
        lstxtAccount.Text = ""
    End If
End Sub

'卡片新增（模板）
Private Sub lstxtTemplate_Choose()
    mTemplateID = lstxtTemplate.TextMatrix(lstxtTemplate.ReferRow, 1)
End Sub
Private Sub lstxtTemplate_AddNew()
    mTemplateID = FrmNewTemplate.AddCard(, 1, 17, mlngFormatID, lstxtTemplate.ID)
    RefreshTemplate mTemplateID
End Sub
Private Sub lstxtTemplate_Delete()
    If mTemplateID > 0 Then
        If Card.DelCard(msgTemplate, mTemplateID) Then
           mTemplateID = 0
           RefreshTemplate
        Else
            lstxtTemplate.SeekId lstxtTemplate.ID
        End If
    End If
End Sub
Private Sub lstxtTemplate_Edit()
    If mTemplateID > 0 Then
       Card.EditCard msgTemplate, mTemplateID, , mlngFormatID
       RefreshTemplate mTemplateID
    End If
End Sub
Private Sub lstxtTemplate_ItemNotExist()
    Dim lngID As Long
    If frmMsgAdd.MsgAddShow("增加凭证模板", "凭证模板“" & Trim(lstxtTemplate.Text) & "”不存在，是否新增?") = vbOK Then
        lngID = FrmNewTemplate.AddCard(lstxtTemplate.Text, 1, 17, mlngFormatID, lstxtTemplate.ID)
        RefreshTemplate lngID
    Else
        lstxtTemplate.Text = ""
    End If
End Sub


'卡片新增（凭证类型）
Private Sub lstxtType_Choose()
    mVoucherTypeID = lstxtType.TextMatrix(lstxtType.ReferRow, 1)
    RefreshTemplate lstxtTemplate.ID
End Sub
Private Sub lstxtType_AddNew()
    mVoucherTypeID = Card.AddCard(msgVoucherType)
    RefreshVoucherType mVoucherTypeID
End Sub
Private Sub lstxtType_Delete()
    If mVoucherTypeID > 0 Then
        If Card.DelCard(msgVoucherType, mVoucherTypeID) Then
            mVoucherTypeID = 0
            RefreshVoucherType
        Else
            lstxtType.SeekId lstxtType.ID
        End If
    End If
End Sub
Private Sub lstxtType_Edit()
    If mVoucherTypeID > 0 Then
        Card.EditCard msgVoucherType, mVoucherTypeID
        RefreshVoucherType mVoucherTypeID
    End If
End Sub
Private Sub lstxtType_ItemNotExist()
    Dim lngID As Long
    
    If frmMsgAdd.MsgAddShow("增加凭证类型", "凭证类型“" & Trim(lstxtType.Text) & "”不存在，是否新增?") = vbOK Then
        lngID = Card.AddCard(msgVoucherType, lstxtType.Text)
        RefreshVoucherType lngID
    Else
        lstxtType.Text = ""
    End If
End Sub

'卡片新增（摘要）
Private Sub lstxtRemark_Choose()
    mRemarkID = lstxtRemark.ID
End Sub
Private Sub lstxtRemark_AddNew()
    mRemarkID = Card.AddCard(msgRemark, lstxtRemark.Text)
    RefreshRemark mRemarkID
End Sub
Private Sub lstxtRemark_Edit()
    If mRemarkID > 0 Then
        Card.EditCard msgRemark, mRemarkID
        RefreshRemark mRemarkID
    End If
End Sub
Private Sub lstxtRemark_Delete()
    If mRemarkID > 0 Then
        If Card.DelCard(msgRemark, mRemarkID) Then
            RefreshRemark
        End If
    End If
End Sub

Private Sub RefreshVoucherType(Optional lngID As Long)
    If Not lstxtType.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If
    On Error Resume Next
    Set lstxtType.Recordset = Utility.GetListRecordSet(lrtVoucherType)
    On Error GoTo 0
    lstxtType.Comparts = 2
    lstxtType.AddRefer "<新增>"
    lstxtType.AddRefer "<修改>"
    lstxtType.AddRefer "<删除>"
    If lngID > 0 Then
        lstxtType.SeekId lngID
    Else
        If Not lstxtType.Recordset Is Nothing Then
            'lstxtType.ReferRow = 4 + IIf(lstxtType.Recordset.RecordCount > 0, lstxtType.Recordset.RecordCount - 1, 0)
            lstxtType.ReferRow = 4 + IIf(lstxtType.Recordset.RowCount > 0, lstxtType.Recordset.RowCount - 1, 0)
        Else
            lstxtType.Text = ""
        End If
    End If
End Sub

Private Sub RefreshAccount(Optional lngID As Long)
    If Not lstxtAccount.Recordset Is Nothing Then
        Utility.RemoveListRecordSet lrtAccount
    End If
    On Error Resume Next
    lstxtAccount.ClearRefer
    Set lstxtAccount.Recordset = Utility.GetListRecordSet(lrtAccount)
    lstxtAccount.Comparts = 2
    lstxtAccount.AddRefer "<新增>"
    lstxtAccount.AddRefer "<修改>"
    lstxtAccount.AddRefer "<删除>"
    If lngID > 0 Then
        lstxtAccount.SeekId lngID
    End If
End Sub

Private Sub RefreshTemplate(Optional lngID As Long)
    Dim strSQL As String
    Dim strCondVersion As String
    Dim recType As rdoresultset
    Dim lngFormatID As Long
    
    On Error Resume Next
    
    strSQL = "SELECT strVoucherFormat FROM VoucherType WHERE lngVoucherTypeID=" & lstxtType.ID
    'Set recType = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)