账户管理.frm

财务信息管理系统,适合做毕业论文的人使用

    '        'bNoRepeatAcc = CByte(rec("bNoRepeatAcc")) / 255
    '        If IsNull(rec("parent_id")) Then
    '            'Me.treStyle.Nodes.Add , , "K" & Trim(rec("accgrp_id")) & bNoRepeatAcc, rec("accgrp_name")
    '            Me.treStyle.Nodes.Add , , "K" & Trim(rec("accgrp_id")), rec("accgrp_name")
    '            Me.treStyle.Nodes("K" & Trim(rec("accgrp_id"))).Image = 3
    '            Me.treStyle.Nodes("K" & Trim(rec("accgrp_id"))).Expanded = True
    '            CreateTree Trim(rec("accgrp_id"))  '& CByte(rec("bNoRepeatAcc"))/ 255
    '        Else
    '            'Me.treStyle.Nodes.Add "K" & Trim(rec("parent_id")) & Right(ParentOID, 1), tvwChild, "K" & Trim(rec("accgrp_id")) & bNoRepeatAcc, rec("accgrp_name")
    '            Me.treStyle.Nodes.Add "K" & Trim(rec("parent_id")), tvwChild, "K" & Trim(rec("accgrp_id")), rec("accgrp_name")
    '            Me.treStyle.Nodes("K" & Trim(rec("parent_id"))).Image = 2
    '            Me.treStyle.Nodes("K" & Trim(rec("accgrp_id"))).Image = 3
    '            Me.treStyle.Nodes("K" & Trim(rec("accgrp_id"))).Expanded = True
    '            CreateTree Trim(rec("accgrp_id"))  '& CByte(rec("bNoRepeatAcc"))/ 255
    '        End If
    '        rec.MoveNext
    '    Loop
    'Else
    '    If Not (IsNull(ParentOID) Or ParentOID = "") Then
    '        Me.treStyle.Nodes("K" & Trim(ParentOID)).Image = 3
    '    End If
    'End If
End Sub

Public Sub CreateSQL(IsGroup As Boolean)
    Dim objAccDefBI      As New U8FDBso.clsAccDefBI
    Dim i                As Integer
    Dim QryFldOrderBy(3) As String
    Dim Order            As String
    
    Set EO = objAccDefBI.Init(g_sDataSourceName)
    Set objAccDefBI = Nothing
    
    ReDim QryFldSqc(EO.Fields.count)
    For i = 1 To EO.Fields.count
        If EO.Fields(i).QryFldSqc > 0 Then 'select field... from fd_accdef
            QryFldSqc(EO.Fields(i).QryFldSqc) = EO.Fields(i).SourceField & " as " & EO.Fields(i).Caption
        End If
        If EO.Fields(i).ReferenceType > 0 Then 'order by
            QryFldOrderBy(EO.Fields(i).ReferenceType) = EO.Fields(i).SourceField
        End If
    Next
    
    m_sql = "Select "
    For i = 1 To UBound(QryFldSqc)
        If Not IsNull(QryFldSqc(i)) And QryFldSqc(i) <> "" Then
            If i = 1 Then
                m_sql = m_sql & QryFldSqc(i) & "," & EO.SourceTable & "." & EO.SourceOIDField & " as 账户ID,"
            Else
                m_sql = m_sql & QryFldSqc(i) & ","
            End If
        End If
    Next
    m_sql = mID(m_sql, 1, Len(m_sql) - 1)
    If IsGroup Then
        m_sql = m_sql & " from " & "fd_accdef INNER JOIN fd_accgrplnk ON fd_accdef.accdef_id = fd_accgrplnk.accdef_id INNER JOIN fd_accunit ON fd_accdef.accunit_id = fd_accunit.accunit_id LEFT OUTER JOIN fd_cadset as fd_cadset_yt ON fd_accdef.yt_cad_id = fd_cadset_yt.cad_id LEFT OUTER JOIN fd_cadset ON fd_accdef.cad_id = fd_cadset.cad_id LEFT OUTER JOIN fd_intra ON fd_accdef.irate_id = fd_intra.irate_id RIGHT OUTER JOIN fd_accgrp ON fd_accgrplnk.accgrp_id = fd_accgrp.accgrp_id LEFT OUTER JOIN fd_accgrp fd_accgrp_1 ON fd_accgrp.accgrp_id = fd_accgrp_1.parent_id"
    Else
        m_sql = m_sql & " from " & "fd_accdef LEFT OUTER JOIN fd_intra ON fd_accdef.irate_id = fd_intra.irate_id LEFT OUTER JOIN fd_cadset ON fd_accdef.cad_id = fd_cadset.cad_id LEFT OUTER JOIN fd_cadset as fd_cadset_yt ON fd_accdef.yt_cad_id = fd_cadset_yt.cad_id LEFT OUTER JOIN fd_accunit ON fd_accdef.accunit_id = fd_accunit.accunit_id"
    End If
    m_sql = m_sql & " where " & EO("destroy_flag").SourceField & "=0 "
    Order = " order by "
    For i = 1 To 3
        If Not IsNull(QryFldOrderBy(i)) And QryFldOrderBy(i) <> "" Then
            Order = Order & QryFldOrderBy(i) & ","
        End If
    Next
    Order = mID(Order, 1, Len(Order) - 1)
    If InStr(1, m_sql, "dOpenDate") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "dOpenDate") - 1) & "convert(varchar(10),dOpenDate,111)" & mID(m_sql, InStr(1, m_sql, "dOpenDate") + Len("dOpenDate"))
    End If
    If InStr(1, m_sql, "cUnitCode") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "cUnitCode") - 1) & "fd_accunit." & "cUnitCode" & mID(m_sql, InStr(1, m_sql, "cUnitCode") + Len("cUnitCode"))
    End If
    If InStr(1, m_sql, "cIntrID") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "cIntrID") - 1) & "fd_intra." & "cIntrID" & mID(m_sql, InStr(1, m_sql, "cIntrID") + Len("cIntrID"))
    End If
    If InStr(1, m_sql, "cCadID") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "cCadID") - 1) & "fd_cadset." & "cCadID" & mID(m_sql, InStr(1, m_sql, "cCadID") + Len("cCadID"))
    End If
    If InStr(1, m_sql, "cYtID") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "cYtID") - 1) & "fd_cadset_yt." & "cCadID" & mID(m_sql, InStr(1, m_sql, "cYtID") + Len("cYtID"))
    End If
    If InStr(1, m_sql, "itype") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "itype") - 1) & "fd_accdef." & "itype" & mID(m_sql, InStr(1, m_sql, "itype") + Len("itype"))
    End If
    If InStr(1, m_sql, "digest") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "digest") - 1) & "fd_accdef." & "digest" & mID(m_sql, InStr(1, m_sql, "digest") + Len("digest"))
    End If
    
    If InStr(1, m_sql, "iDataSrc" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "iDataSrc" & " as ") - 1) & " case iDataSrc when 0 then '资金' when 1 then '总账' end " & mID(m_sql, InStr(1, m_sql, "iDataSrc" & " as ") + Len("iDataSrc"))
    End If
    If InStr(1, m_sql, "fd_accdef.itype" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "fd_accdef.itype" & " as ") - 1) & " case fd_accdef.itype when 0 then '定期' when 1 then '活期' end " & mID(m_sql, InStr(1, m_sql, "fd_accdef.itype" & " as ") + Len("fd_accdef.itype"))
    End If
    If InStr(1, m_sql, "iio" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "iio" & " as ") - 1) & " case iio when 0 then '内部' when 1 then '外部' end " & mID(m_sql, InStr(1, m_sql, "iio" & " as ") + Len("iio"))
    End If
    If InStr(1, m_sql, "iYt" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "iYt" & " as ") - 1) & " case iYt when 0 then '否' when 1 then '是' end " & mID(m_sql, InStr(1, m_sql, "iYt" & " as ") + Len("iYt"))
    End If
    If InStr(1, m_sql, "deficit_flag" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "deficit_flag" & " as ") - 1) & " case deficit_flag when 0 then '否' when 1 then '是' end " & mID(m_sql, InStr(1, m_sql, "deficit_flag" & " as ") + Len("deficit_flag"))
    End If
    If InStr(1, m_sql, "deficitrestrict_flag" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "deficitrestrict_flag" & " as ") - 1) & " case deficitrestrict_flag when 0 then '否' when 1 then '是' end " & mID(m_sql, InStr(1, m_sql, "deficitrestrict_flag" & " as ") + Len("deficitrestrict_flag"))
    End If
    If InStr(1, m_sql, "istate" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "istate" & " as ") - 1) & " case istate when 0 then '未冻结' when 1 then '冻结' end " & mID(m_sql, InStr(1, m_sql, "istate" & " as ") + Len("istate"))
    End If
    If InStr(1, m_sql, "bDestroy" & " as ") > 0 Then
        m_sql = mID(m_sql, 1, InStr(1, m_sql, "bDestroy" & " as ") - 1) & " case bDestroy when 0 then '未销户' when 1 then '销户' end " & mID(m_sql, InStr(1, m_sql, "bDestroy" & " as ") + Len("bDestroy"))
    End If
    
    If InStrRev(Order, "cUnitCode") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "cUnitCode") - 1) & "fd_accunit." & "cUnitCode" & mID(Order, InStrRev(Order, "cUnitCode") + Len("cUnitCode"))
    End If
    If InStrRev(Order, "cIntrID") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "cIntrID") - 1) & "fd_intra." & "cIntrID" & mID(Order, InStrRev(Order, "cIntrID") + Len("cIntrID"))
    End If
    If InStrRev(Order, "cCadID") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "cCadID") - 1) & "fd_cadset." & "cCadID" & mID(Order, InStrRev(Order, "cCadID") + Len("cCadID"))
    End If
    If InStrRev(Order, "cYtID") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "cYtID") - 1) & "fd_cadset_yt." & "cCadID" & mID(Order, InStrRev(Order, "cYtID") + Len("cYtID"))
    End If
    If InStrRev(Order, "itype") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "itype") - 1) & "fd_accdef." & "itype" & mID(Order, InStrRev(Order, "itype") + Len("itype"))
    End If
    If InStrRev(Order, "digest") > 0 Then
        Order = mID(Order, 1, InStrRev(Order, "digest") - 1) & "fd_accdef." & "digest" & mID(Order, InStrRev(Order, "digest") + Len("digest"))
    End If
    m_sql = m_sql & Order
End Sub

Public Sub OrderDesc()
    Dim sql As String
    sql = mID(m_sql, 1, InStr(1, m_sql, "order by ") - 1 + Len("order by "))
    Select Case mID(QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), 1, InStr(1, QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), " as ") - 1)
        Case "cUnitCode"
            sql = sql & "fd_accunit." & "cUnitCode" & " desc"
        Case "cIntrID"
            sql = sql & "fd_intra." & "cIntrID" & " desc"
        Case "cCadID"
            sql = sql & "fd_cadset." & "cCadID" & " desc"
        Case "cYtID"
            sql = sql & "fd_cadset_yt." & "cCadID" & " desc"
        Case "Itype"
            sql = sql & "fd_accdef." & "Itype" & " desc"
        Case "digest"
            sql = sql & "fd_accdef." & "digest" & " desc"
        Case Else
            sql = sql & mID(QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), 1, InStr(1, QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), " as ") - 1) & " desc"
    End Select
    msg.Rows = 0
    If Me.treStyle.SelectedItem.key = "K" Then
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and " & EO.SourceTable & "." & EO.SourceOIDField & " not in (select " & EO.SourceOIDField & " from fd_accgrplnk) " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        Set msg.DataSource = Adodc
    ElseIf Me.treStyle.SelectedItem.children = 0 Then
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and fd_accgrp.accgrp_id='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "' " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    Else
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and fd_accgrp.parent_id='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "' " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    End If
End Sub

Public Sub OrderAsc()
    Dim sql As String
    sql = mID(m_sql, 1, InStr(1, m_sql, "order by ") - 1 + Len("order by "))
    Select Case mID(QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), 1, InStr(1, QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), " as ") - 1)
        Case "cUnitCode"
            sql = sql & "fd_accunit." & "cUnitCode" & " asc"
        Case "cIntrID"
            sql = sql & "fd_intra." & "cIntrID" & " asc"
        Case "cCadID"
            sql = sql & "fd_cadset." & "cCadID" & " asc"
        Case "cYtID"
            sql = sql & "fd_cadset_yt." & "cCadID" & " asc"
        Case "Itype"
            sql = sql & "fd_accdef." & "Itype" & " asc"
        Case "digest"
            sql = sql & "fd_accdef." & "digest" & " asc"
        Case Else
            sql = sql & mID(QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), 1, InStr(1, QryFldSqc(IIf(Me.msg.col = 0, 1, Me.msg.col)), " as ") - 1) & " asc"
    End Select
    msg.Rows = 0
    If Me.treStyle.SelectedItem.key = "K" Then
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and " & EO.SourceTable & "." & EO.SourceOIDField & " not in (select " & EO.SourceOIDField & " from fd_accgrplnk) " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        Set msg.DataSource = Adodc
    ElseIf Me.treStyle.SelectedItem.children = 0 Then
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and fd_accgrp.accgrp_id='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "' " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    Else
        sql = mID(sql, 1, InStr(1, sql, "order") - 1) & "and fd_accgrp.parent_id='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "' " & mID(sql, InStr(1, sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    End If
End Sub

Private Sub Form_Activate()
    SetTlbStyle Me, True: ocxCtbTool.RefreshEnable
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandler
    Dim ShiftDown, AltDown, CtrlDown
    ShiftDown = (Shift And vbShiftMask) > 0
    AltDown = (Shift And vbAltMask) > 0
    CtrlDown = (Shift And vbCtrlMask) > 0
    
    Select Case KeyCode
        Case vbKeyF1
            SendKeys "{F1 3}"
        Case vbKeyF3
            If Me.tlbAction.Buttons("Find").Enabled Then
                frmAccFind.m_FromAccOrGrp = 1
                frmAccFind.Show vbModal
            End If
        Case vbKeyF5
            If Me.tlbAction.Buttons("AddNew").Enabled Then
                AddNew Me.ActiveControl
            End If
        Case vbKeyF8
            If Me.tlbAction.Buttons("Edit").Enabled Then
                Edit Me.ActiveControl
            End If
        Case vbKeyDelete
            If Me.tlbAction.Buttons("Delete").Enabled Then
                Delete Me.ActiveControl
            End If
        Case vbKeyP
            If CtrlDown And Me.tlbAction.Buttons("Print").Enabled Then
                If Not InitPrnGrid Then Exit Sub
                Print_Doc Me, "Print", TAB_ACCDEF
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
ErrHandler:
    Exit Sub
End Sub

Private Sub msg_Click()
    If Me.treStyle.SelectedItem.children > 0 Then
        Me.tlbAction.Buttons("AddNew").Enabled = False
    Else
        Me.tlbAction.Buttons("AddNew").Enabled = True
    End If
    If msg.Rows > 1 Then
        If msg.row = msg.RowSel Then
            Me.tlbAction.Buttons("Grouping").Enabled = True
            Me.tlbAction.Buttons("Edit").Enabled = True
        Else
            Me.tlbAction.Buttons("Grouping").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
        End If
        Me.tlbAction.Buttons("Delete").Enabled = True
    Else
        Me.tlbAction.Buttons("Grouping").Enabled = False
        Me.tlbAction.Buttons("Edit").Enabled = False
        Me.tlbAction.Buttons("Delete").Enabled = False
    End If
    LeftRight = 2
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

Private Sub msg_DblClick()
    If msg.row = msg.RowSel Then
        If msg.Rows > 0 Then View Me.ActiveControl
    Else
        Me.Caption = "资金管理...账户管理"
    End If
    LeftRight = 2
End Sub

Private Sub msg_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If msg.row = msg.RowSel Then
            If msg.Rows > 0 Then View Me.ActiveControl
        Else
            Me.Caption = "资金管理...账户管理"