frmac_indexselect.frm

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

End Sub


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

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



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

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

Private Sub cmdHelp_Click()
  Dim nRet As Integer
    
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation
    Else
        On Error Resume Next
        nRet = HtmlHelp(Me.hwnd, App.Path & "\Help Files\" & App.ProductName & ".chm", _
        HH_HELP_CONTEXT, CLng(Me.HelpContextID))
        If Err Then
            MsgBox Err.Dscription
        End If
    End If
End Sub

Private Sub cmdSubjectHelpOne_Click()
    With frmUSU_KmHelp
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectCodeFrom.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub

Private Sub cmdSubjectHelpTwo_Click()
    With frmUSU_KmHelp
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectCodeTo.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub


Private Sub Form_Initialize()
    Ok = False
End Sub

Private Sub form_load()
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim i As Integer
    
    ''''
    '注册表
    Me.chkHave.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_IndexSelect", "NotRecord", True)))
    Me.chkBlankKm.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_IndexSelect", "BlankKm", False)))
    
    Set CSubject = New clsSubject
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    
    '求出最小开始月份
    sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            '如果当前注册年份大于结账年, 则查询最小月份为一月份、最大月份为一月份；
            If Val(glo.sOperateYear) > Val(.Fields("ModiYear").value) Then
                m_iMinStartMonth = 0
'                m_iMaxEndMonth = 1
            '否则如果注册年份等于结账年份, 则查询最小月份为
                                            '(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于结账月+1
            ElseIf Val(glo.sOperateYear) = Val(.Fields("ModiYear").value) Then
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), _
                                    .Fields("BeginMonth").value - 1, 0)
'                m_iMaxEndMonth = .Fields("ModiMonth").Value + 1
            '否则查询最小月份为(如果注册年份等于
                                            '(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于12
            Else
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), _
                                    .Fields("BeginMonth").value - 1, 0)
            End If
        End If
        .Close
    End With
    '最大结束月份为12
    m_iMaxEndMonth = 12
      
    '查询起始月从子系统启用月份到12月份
    For i = m_iMinStartMonth + 1 To 12
        cboMonthFrom.AddItem glo.sOperateYear & "." & i
    Next i
    
    '查询截止月从子系统启用月份到12月份
    For i = m_iMinStartMonth + 1 To 12
        cboMonthTo.AddItem glo.sOperateYear & "." & i
    Next i
    
    '选中的查询起始月等于当前注册月
    cboMonthFrom.ListIndex = Month(glo.sOperateDate) - m_iMinStartMonth - 1
    
    '填充科目类型
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT ClassName FROM tSYS_TradeCodeClass A, tSYS_Account B" & _
            " WHERE B.AccountID = '" & glo.sAccountID & "' AND A.TradeID = B.TradeID"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            .MoveFirst
            cboSubjectType.AddItem ""
            Do Until .EOF
                cboSubjectType.AddItem Trim$("" & .Fields("ClassName").value)
                .MoveNext
            Loop
        End If
    End With
    cboSubjectType.ListIndex = 0
    
    txtLevelFrom.text = 1
    upLevelFrom.Min = 1
    upLevelTo.Min = 1

    txtLevelTo.text = uGetMaxJc()
    upLevelFrom.Max = txtLevelTo
    upLevelTo.Max = txtLevelTo
    
    '填充排序
    cboSort.AddItem "1.按科目升序"
    cboSort.AddItem "2.按科目降序"
    cboSort.ListIndex = 0
    cboStyle.ListIndex = 0
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
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 cmdOk_Click()
    Dim i As Integer
    Dim rSt As New Recordset
       If SqlStringValid(txtSubjectCodeFrom) = False Then
        MsgBox "起始科目中含有非法字符！"
        Exit Sub
   End If
   If SqlStringValid(txtSubjectCodeTo) = False Then
        MsgBox "结束科目中含有非法字符！"
        Exit Sub
   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_sSubjectType = IIf(cboSubjectType.Enabled = True, cboSubjectType.text, "")
    m_sSort = Left(cboSort.text, 1)
    m_sStyle = Trim$(cboStyle.text)
    
    m_bIncludeNotRecordVoucher = IIf(chkHave.value = 0, False, True)
    m_bIncludeBlankKm = IIf(chkBlankKm.value = 0, False, True)

    
    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 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"

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

If Not rSt.EOF Then
    HasVoucherInMonth = True
Else
    HasVoucherInMonth = False
End If
rSt.Close
End Function