frmac_balanceselect.frm

一个用VB写的财务软件源码

   End If
    m_sMonthFrom = Mid(cboMonthFrom.text, InStr(1, cboMonthFrom.text, ".") + 1)
    m_sMonthTo = Mid(cboMonthTo.text, InStr(1, cboMonthTo.text, ".") + 1)
    
    m_sSubjectCodeFrom = ""
    m_sSubjectNameFrom = ""
    If Trim$("" & txtSubjectCodeFrom.text) <> "" Then
        If txtSubject_Validate(txtSubjectCodeFrom) Then
            m_sSubjectCodeFrom = CSubject.SubjectCode
            m_sSubjectNameFrom = CSubject.SubjectName
        Else
            MsgBox "科目输入不正确！", vbInformation
            txtSubjectCodeFrom.SetFocus
            Exit Sub
        End If
    End If
    
    m_sSubjectCodeTo = ""
    m_sSubjectNameTo = ""
    If Trim$("" & txtSubjectCodeTo.text) <> "" Then
        If txtSubject_Validate(txtSubjectCodeTo) Then
            m_sSubjectCodeTo = CSubject.SubjectCode
            m_sSubjectNameTo = CSubject.SubjectName
            txtSubjectCodeTo.SetFocus
        Else
            MsgBox "科目输入不正确！", vbInformation
            Exit Sub
        End If
    End If
    
    m_iSubjectLevelFrom = txtLevelFrom.text
    m_iSubjectLevelTo = txtLevelTo.text
    
    If m_sSubjectCodeFrom <> "" And m_sSubjectCodeTo <> "" Then
        If m_sSubjectCodeFrom > m_sSubjectCodeTo Then
            MsgBox "起始科目不能小于结束科目"
            Exit Sub
        End If
    End If
    
    m_bIsEndLevelSubject = IIf(chkEndLevelSubject.value = 0, False, True)
    
    If txtBalanceFrom.text <> "" Then
        m_sBalanceFrom = Format(txtBalanceFrom.text, "##0.00")
    Else
        m_sBalanceFrom = ""
    End If
    If txtBalanceTo.text <> "" Then
        m_sBalanceTo = Format(txtBalanceTo.text, "##0.00")
    Else
        m_sBalanceTo = ""
    End If
    
    m_sSubjectType = IIf(cboSubjectType.Enabled = True, cboSubjectType.text, "")
    m_sSort = Left(cboSort.text, 1)
    
    m_bIncludeNotRecordVoucher = IIf(chkHave.value = 0, False, True)
    m_bIncludeBlankKm = IIf(chkBlankKm.value = 0, False, True)
'
'    If HasVoucherInMonth(CInt(m_sMonthFrom), m_sSubjectCodeFrom, m_sSubjectCodeTo, m_iSubjectLevelFrom, m_iSubjectLevelTo, m_bIncludeNotRecordVoucher) = False Then
'        MsgBox "开始月份中没有发生符合要求的凭证，请重新选择。"
'        Exit Sub
'    End If
'    If HasVoucherInMonth(CInt(m_sMonthTo), m_sSubjectCodeFrom, m_sSubjectCodeTo, m_iSubjectLevelFrom, m_iSubjectLevelTo, m_bIncludeNotRecordVoucher) = False Then
'        MsgBox "结束月份中没有发生符合要求的凭证，请重新选择。"
'        Exit Sub
'    End If
    
    rSt.Open "select Min(kmdm),max(kmdm) from tzw_km" + glo.sOperateYear, glo.cnnMain, adOpenKeyset, adLockPessimistic
    m_IsFullKm = False
    If rSt.EOF = False Then
        If m_sSubjectCodeFrom = rSt.Fields(0).value And m_sSubjectCodeTo = rSt.Fields(1).value Then
            m_IsFullKm = True
        ElseIf m_sSubjectCodeFrom = "" Then
            If m_sSubjectCodeTo = "" Then
                m_IsFullKm = True
            ElseIf m_sSubjectCodeTo = rSt.Fields(1).value Then
                m_IsFullKm = True
            End If
        End If
    End If
    Ok = True
    Me.Hide
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Set CSubject = Nothing
End Sub

Private Sub txtLevelFrom_Change()
    upLevelTo.Min = Val(txtLevelFrom.text)
    If Val(txtLevelTo.text) < Val(txtLevelFrom.text) Then
        txtLevelTo.text = txtLevelFrom.text
    End If
End Sub

Private Sub txtLevelFrom_GotFocus()
    txtLevelFrom.SelStart = 0
    txtLevelFrom.SelLength = Len(txtLevelFrom.text)
End Sub

Private Sub txtLevelFrom_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = IntegerEnabled(KeyAscii)
    End If
End Sub

Private Sub txtLevelFrom_Validate(Cancel As Boolean)
    If Val(txtLevelFrom.text) < 1 Or Val(txtLevelFrom.text) > 6 Then
        MsgBox "级次范围应在1-6！", vbExclamation
        Cancel = True
        txtLevelFrom.SelStart = 0
        txtLevelFrom.SelLength = Len(txtLevelFrom.text)
    End If
End Sub

Private Sub txtLevelTo_Change()
    If Val(txtLevelTo.text) < Val(txtLevelFrom.text) Then
        txtLevelFrom.text = txtLevelTo.text
    End If
End Sub

Private Sub txtLevelTo_GotFocus()
    txtLevelTo.SelStart = 0
    txtLevelTo.SelLength = Len(txtLevelTo.text)
End Sub

Private Sub txtLevelTo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = IntegerEnabled(KeyAscii)
    End If
End Sub

Private Sub txtLevelTo_Validate(Cancel As Boolean)
    If Val(txtLevelTo.text) < 1 Or Val(txtLevelTo.text) > 6 Then
        MsgBox "级次范围应在1-6！", vbExclamation
        Cancel = True
        txtLevelTo.SelStart = 0
        txtLevelTo.SelLength = Len(txtLevelTo.text)
    End If
End Sub

Private Sub txtSubjectCodeFrom_Change()
    If txtSubjectCodeFrom.text = "" And txtSubjectCodeTo.text = "" Then
        cboSubjectType.Enabled = True
    Else
        cboSubjectType.Enabled = False
    End If
End Sub
Private Sub txtSubjectCodeFrom_GotFocus()
    txtSubjectCodeFrom.Alignment = 0
    txtSubjectCodeFrom.SelStart = 0
    txtSubjectCodeFrom.SelLength = Len(txtSubjectCodeFrom.text)
End Sub

Private Sub txtSubjectCodeFrom_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectHelpOne_Click
    End If
End Sub

Private Sub txtSubjectCodeFrom_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = 8 Or KeyAscii = 10 Or KeyAscii = Asc(glo.sSeparateSubject) Then
            If KeyAscii = Asc("0") And txtSubjectCodeFrom.text = "" Then
                KeyAscii = 0
            Else
                KeyAscii = KeyAscii
            End If
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub txtSubjectCodeTo_Change()
    If txtSubjectCodeTo.text = "" And txtSubjectCodeFrom.text = "" Then
        cboSubjectType.Enabled = True
    Else
        cboSubjectType.Enabled = False
    End If
End Sub

Private Sub txtSubjectCodeTo_GotFocus()
    txtSubjectCodeTo.Alignment = 0
    txtSubjectCodeTo.SelStart = 0
    txtSubjectCodeTo.SelLength = Len(txtSubjectCodeTo.text)
End Sub

Private Sub txtSubjectCodeTo_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectHelpTwo_Click
    End If
End Sub

Private Sub txtSubjectCodeTo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = 8 Or KeyAscii = 10 Or KeyAscii = Asc(glo.sSeparateSubject) Then
            If KeyAscii = Asc("0") And txtSubjectCodeTo.text = "" Then
                KeyAscii = 0
            Else
                KeyAscii = KeyAscii
            End If
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Function txtSubject_Validate(ByVal txtControl As Control) As Boolean
    Dim iTemp As Integer

    txtSubject_Validate = False
    If Trim$("" & txtControl.text) <> "" Then
        iTemp = InStr(1, txtControl.text, "=")
        If iTemp <> 0 Then
            CSubject.Init Left$(Trim$("" & txtControl.text), iTemp - 1), glo.sOperateYear
        Else
            CSubject.Init Trim$("" & txtControl.text), glo.sOperateYear
        End If
    End If
    If CSubject.SubjectIsExist Then
        txtSubject_Validate = True
    End If
End Function

Private Sub txtBalanceFrom_GotFocus()
    txtBalanceFrom.text = Format(txtBalanceFrom.text, "##0.00")
    txtBalanceFrom.Alignment = 0
    txtBalanceFrom.SelStart = 0
    txtBalanceFrom.SelLength = Len(txtBalanceFrom.text)
End Sub

Private Sub txtBalanceFrom_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = NegativeDoubleEnabled(txtBalanceFrom, KeyAscii)
    End If
End Sub

Private Sub txtBalanceFrom_LostFocus()
    txtBalanceFrom.text = Format(txtBalanceFrom.text, "##,##0.00")
    txtBalanceFrom.Alignment = 1
End Sub

Private Sub txtBalanceTo_GotFocus()
    txtBalanceTo.text = Format(txtBalanceTo.text, "##0.00")
    txtBalanceTo.Alignment = 0
    txtBalanceTo.SelStart = 0
    txtBalanceTo.SelLength = Len(txtBalanceTo.text)
End Sub

Private Sub txtBalanceTo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = NegativeDoubleEnabled(txtBalanceTo, KeyAscii)
    End If
End Sub

Private Sub txtBalanceTo_LostFocus()
    txtBalanceTo.text = Format(txtBalanceTo.text, "##,##0.00")
    txtBalanceTo.Alignment = 1
End Sub

Private Sub upLevelFrom_Change()
    upLevelTo.Min = txtLevelFrom.text
End Sub

Public Function HasVoucherInMonth(ByVal i As Integer, ByVal StartKm As String, ByVal EndKm As String, ByVal StartJc As Integer, ByVal EndJc As Integer, ByVal IsIncludeNotRecordVocher As Boolean) As Boolean
Dim rSt As New Recordset
Dim sWhere As String
' and
If StartKm <> "" Then sWhere = "a.kmdm>='" + StartKm + "'"
If EndKm <> "" Then sWhere = sWhere + " and a.kmdm<='" + EndKm + "'"
If sWhere <> "" Then
    sWhere = "(" + sWhere + ")"
    If StartKm <> "" Then sWhere = sWhere + " or a.kmdm like '" + StartKm + "%'"
    If EndKm <> "" Then sWhere = sWhere + " or a.kmdm like '" + EndKm + "%'"
    sWhere = " and (" + sWhere + ")"
End If
If IsIncludeNotRecordVocher = False Then sWhere = sWhere + " and a.xgbz=2"
'If StartJc = upLevelFrom.Min And EndJc = upLevelTo.Max Then
    Select Case g_FLAT
    Case "ORACLE"
        rSt.Open "Select * from tzw_pzsj" + glo.sOperateYear + " a where rownum<2 and a.kjqj=" + CStr(i) + sWhere, glo.cnnMain, adOpenDynamic, adLockOptimistic
    Case "SQL"
        rSt.Open "Select top 1 * from tzw_pzsj" + glo.sOperateYear + " a where a.kjqj=" + CStr(i) + sWhere, glo.cnnMain, adOpenDynamic, adLockOptimistic
    End Select
'Else
'    Select Case g_FLAT
'    Case "ORACLE"
'        rSt.Open "Select * from tzw_pzsj" + glo.sOperateYear + " a,tzw_km" + glo.sOperateYear + " b where rownum<2 and a.kjqj=" + CStr(i) + sWhere + " and b.kmdm=a.kmdm and b.kmjc<=" + CStr(EndJc) + " and b.kmjc>=" + CStr(StartJc), glo.cnnMain, adOpenDynamic, adLockOptimistic
'    Case "SQL"
'        rSt.Open "Select top 1 * from tzw_pzsj" + glo.sOperateYear + " a,tzw_km" + glo.sOperateYear + " b where a.kjqj=" + CStr(i) + sWhere + " and b.kmdm=a.kmdm and b.kmjc<=" + CStr(EndJc) + " and b.kmjc>=" + CStr(StartJc), glo.cnnMain, adOpenDynamic, adLockOptimistic
'    End Select
'End If
If Not rSt.EOF Then
    HasVoucherInMonth = True
Else
    HasVoucherInMonth = False
End If
rSt.Close
End Function

'Private Sub upLevelTo_DownClick()
'    txtLevelTo.text = Val(txtLevelTo.text) - 1
'    If Val(txtLevelTo.text) < upLevelTo.Min Then
'        txtLevelTo.text = upLevelTo.Min
'    End If
'End Sub
'
'Private Sub upLevelTo_UpClick()
'    txtLevelTo.text = Val(txtLevelTo.text) + 1
'    If Val(txtLevelTo.text) > upLevelTo.Max Then
'        txtLevelTo.text = upLevelTo.Max
'    End If
'End Sub