frmac_balanceselect.frm

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

Dim CSubject As clsSubject

Private m_sMonthFrom As String, m_sMonthTo As String                        '查询起始月份、截止月份
Private m_iMinStartMonth As Integer, m_iMaxEndMonth As Integer              '查询最小月份、查询最大月份
            
Private m_sSubjectCodeFrom As String, m_sSubjectNameFrom As String          '查询起始科目代码、科目名称
Private m_sSubjectCodeTo As String, m_sSubjectNameTo As String              '查询截止科目代码、科目名称
Private m_iSubjectLevelFrom As Integer, m_iSubjectLevelTo As Integer        '科目起始级次、截止级次
Private m_bIsEndLevelSubject As Boolean                                     '是否末级科目
Private m_sBalanceFrom As String, m_sBalanceTo As String                    '余额最小金额、最大金额
Private m_sSubjectType As String                                            '科目类型
Private m_sSort As String                                                   '排序方式
Private m_bIncludeNotRecordVoucher As Boolean                                                '是否包含未记账凭证
Private m_bIncludeBlankKm As Boolean
Private m_IsFullKm As Boolean

Public Ok As Boolean

Public Property Get ubFullKm() As Boolean
ubFullKm = m_IsFullKm
End Property

Public Property Get usMonthFrom() As String
    usMonthFrom = m_sMonthFrom
End Property

Public Property Get usMonthTo() As String
    usMonthTo = m_sMonthTo
End Property

Public Property Get usMaxEndMonth() As String
    usMaxEndMonth = CStr(m_iMaxEndMonth)
End Property

Public Property Get usSubjectCodeFrom() As String
    usSubjectCodeFrom = m_sSubjectCodeFrom
End Property

Public Property Get usSubjectNameFrom() As String
    usSubjectNameFrom = m_sSubjectNameFrom
End Property

Public Property Get usSubjectCodeTo() As String
    usSubjectCodeTo = m_sSubjectCodeTo
End Property

Public Property Get usSubjectNameTo() As String
    usSubjectNameTo = m_sSubjectNameTo
End Property

Public Property Get uiSubjectLevelFrom() As Integer
    uiSubjectLevelFrom = m_iSubjectLevelFrom
End Property

Public Property Get uiSubjectLevelTo() As Integer
    uiSubjectLevelTo = m_iSubjectLevelTo
End Property

Public Property Get ubIsEndSubject() As Boolean
    ubIsEndSubject = m_bIsEndLevelSubject
End Property

Public Property Get usBalanceFrom() As String
    usBalanceFrom = m_sBalanceFrom
End Property

Public Property Get usBalanceTo() As String
    usBalanceTo = m_sBalanceTo
End Property

Public Property Get usSubjectType() As String
    usSubjectType = m_sSubjectType
End Property

Public Property Get usSort() As String
    usSort = m_sSort
End Property

Public Property Get ubIncludeNotRecordVoucher() As Boolean
    ubIncludeNotRecordVoucher = m_bIncludeNotRecordVoucher
End Property

Public Property Get ubIncludeBlankKm() As Boolean
     ubIncludeBlankKm = m_bIncludeBlankKm
End Property


Private Sub cboMonthFrom_Click()
    Dim i As Integer
    Dim sTxt As String
    
    '查询起始月改变时, 先保存查询截止月的内容, 然后重新填充截止月列表框;
    sTxt = IIf(cboMonthTo.text = "", 0, cboMonthTo.text)
    cboMonthTo.Clear
    For i = cboMonthFrom.ListIndex + m_iMinStartMonth + 1 To 12
        cboMonthTo.AddItem glo.sOperateYear & "." & i
    Next i
    If CInt(Mid(sTxt, InStr(1, sTxt, ".") + 1)) < CInt(Mid(cboMonthFrom.text, InStr(1, cboMonthFrom.text, ".") + 1)) Then
        cboMonthTo.text = cboMonthFrom.List(cboMonthFrom.ListIndex)
    Else
        For i = 0 To cboMonthTo.ListCount - 1
            If cboMonthTo.List(i) = sTxt Then
                cboMonthTo.ListIndex = i
                Exit For
            End If
        Next i
    End If
End Sub

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


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

Private Sub cboSort_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 chkEndLevelSubject_Click()
    If chkEndLevelSubject.value = 0 Then
        txtLevelFrom.Enabled = True
        txtLevelTo.Enabled = True
        upLevelFrom.Enabled = True
        upLevelTo.Enabled = True
    Else
        txtLevelFrom.Enabled = False
        txtLevelTo.Enabled = False
        upLevelFrom.Enabled = False
        upLevelTo.Enabled = False
    End If
End Sub

Private Sub chkEndLevelSubject_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_BalanceSelect", "NotRecord", True)))
    Me.chkBlankKm.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_BalanceSelect", "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
    
'    '从凭证表中查找已记账凭证的记录个数，条件kjqj等于最大查询结束月,并且修改标志为2
'    '如果不存在, 则最大查询结束月等于最大查询结束月-1
'    sSQL = "SELECT COUNT(*) FROM tZW_Pzsj" & glo.sOperateYear & _
'            " WHERE kjqj = " & m_iMaxEndMonth & _
'            " AND xgbz = '2'"
'    With rstTemp
'        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
'        If .Fields(0).Value = 0 Then
'            If m_iMaxEndMonth > m_iMinStartMonth Then
'                m_iMaxEndMonth = m_iMaxEndMonth - 1
'            End If
'        End If
'        .Close
'    End With
    
    '查询起始月从子系统启用月份到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.AddItem "3.按余额升序"
    cboSort.AddItem "4.按余额降序"
    cboSort.AddItem "5.按科目、余额升序"
    cboSort.AddItem "6.按科目、余额降序"
    cboSort.ListIndex = 0
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
End Sub

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