clsdepart.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDepart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'“科目代码设置”、“部门代码设置”类。
'  特征：级数最大为六级，共十六位，多层次联系树图。

'科目代码共计40位

Private m_adoRst As ADODB.Recordset
Private m_Tvw As TreeView
Public m_bGeneral As Boolean
Dim iCount As Integer


'方法 1：保存一条新记录，并更新树表。
'C：新记录的代码。
'N：新记录的名称。
'ParKey：新记录的父节点的关键字。
'BMDYKM：新记录的部门对应科目。

'卞荣兵于2001.12.23修改

Public Sub Append(cTl As TreeView, C As String, N As String, ByVal IsEnd As String, OtherValue As Variant)
    Dim sSql As String
    Dim sYefx As String
    
    On Error GoTo errhandle
    '添加新记录。
    m_adoRst.AddNew
    m_adoRst.Fields("kmdm").value = C
    m_adoRst.Fields("kmmc").value = N
    m_adoRst![kmmceng] = OtherValue(0)
    m_adoRst![zjm] = OtherValue(1)
    m_adoRst![kmlx] = OtherValue(2)
    m_adoRst![KmJc] = Val(OtherValue(3))
    sYefx = IIf(OtherValue(4) = 0, "借方", IIf(OtherValue(4) = 1, "贷方", "两性"))
    m_adoRst![yefx] = sYefx
    m_adoRst![zygs] = OtherValue(5)
    m_adoRst![hzdykm] = OtherValue(6)
    m_adoRst![sldw] = OtherValue(7)
    m_adoRst![wbdw] = OtherValue(8)
    m_adoRst![isrjz] = IIf(OtherValue(9) = 1, -1, 0)
    m_adoRst![IsYhz] = IIf(OtherValue(10) = 1, -1, 0)
    m_adoRst![isgrwlhs] = IIf(OtherValue(11) = 1, -1, 0)
    m_adoRst![iskhwlhs] = IIf(OtherValue(12) = 1, -1, 0)
    m_adoRst![isgyswlhs] = IIf(OtherValue(13) = 1, -1, 0)
    m_adoRst![isbmhs] = IIf(OtherValue(14) = 1, -1, 0)
    m_adoRst![isxmhs] = IIf(OtherValue(15) = 1, -1, 0)
    m_adoRst![isxjllkm] = IIf(OtherValue(16) = 1, -1, 0)
    m_adoRst![xjlllb] = OtherValue(17)
    m_adoRst![isfc] = IIf(OtherValue(18) = 1, -1, 0)
    
    '=========================================2002.8.28  yao revise====================================
    If IsEnd = "" Then
        m_adoRst![IsEndKm] = -1
    Else
        m_adoRst![IsEndKm] = Val(IsEnd)
    End If
    m_adoRst.Update
'    设置科目是否是末级科目
   If IsEnd = "" Then
        If cTl.SelectedItem.Key <> "R" Then
            If cTl.SelectedItem.Parent.Key <> "R" And Len(cTl.SelectedItem.Parent.Key) <> 2 Then
    '            If m_adoRst.State = adStateOpen Then m_adoRst.Close
                sSql = "update  tZW_Km" & glo.sOperateYear & " set isendkm=0 " & _
                    " where kmdm='" & Trim("" & Mid(cTl.SelectedItem.Key, 2)) & "'"
                glo.cnnMain.BeginTrans
                glo.cnnMain.Execute sSql
                glo.cnnMain.CommitTrans
            End If
        End If
    End If
'=======================================================================================================================
    '设置科目余额表地的
    sSql = "insert into tzw_balance" & glo.sOperateYear & " (kmdm,kmmc,yefx) values ('" & C & "','" & N & "','" & sYefx & "')"
    glo.cnnMain.Execute sSql

errhandle:
   
End Sub

'方法：检测新添加的记录的代码是否重复。
Public Function Valid_Append(cTl As TreeView, C As String) As Boolean
    Dim i As Integer
    For i = 1 To cTl.Nodes.Count
        If cTl.Nodes(i).Key = "k" & C Then
            Valid_Append = False
            Exit Function
        End If
    Next i
    
    Valid_Append = True
End Function

'方法 2：保存一条被修改的记录，并更新树表。
'C：记录修改后的代码。
'N：记录修改后的名称。
'RecKey：被修改记录的关键字。
Public Sub Edit(C As String, N As String, RecKey As String, OtherValue As Variant)
    Dim sSql As String
    
    If m_adoRst.State = adStateOpen Then m_adoRst.Close
    sSql = "select kmdm,kmmc,kmmceng,zjm,kmlx,kmjc,IsEndkm,yefx,zygs,hzdykm," & _
                "sldw,wbdw,IsRjz,IsYhz,IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs,IsXjllkm," & _
                "Xjlllb,Isfc,bUse,bAdd from tZW_Km" & glo.sOperateYear & _
                " where kmdm='" & C & "' order by kmdm"
    m_adoRst.Open sSql, glo.cnnMain, adOpenStatic, adLockOptimistic
        
    '添加
    m_adoRst.Fields("kmdm").value = C
    m_adoRst.Fields("kmmc").value = N
    m_adoRst![kmmceng] = OtherValue(0)
    m_adoRst![zjm] = OtherValue(1)
    m_adoRst![kmlx] = OtherValue(2)
    m_adoRst![KmJc] = Val(OtherValue(3))
    m_adoRst![yefx] = IIf(OtherValue(4) = 0, "借方", IIf(OtherValue(4) = 1, "贷方", "两性"))
    m_adoRst![zygs] = OtherValue(5)
    m_adoRst![hzdykm] = OtherValue(6)
    m_adoRst![sldw] = OtherValue(7)
    m_adoRst![wbdw] = OtherValue(8)
    m_adoRst![isrjz] = IIf(OtherValue(9) = 1, -1, 0)
    m_adoRst![IsYhz] = IIf(OtherValue(10) = 1, -1, 0)
    m_adoRst![isgrwlhs] = IIf(OtherValue(11) = 1, -1, 0)
    m_adoRst![iskhwlhs] = IIf(OtherValue(12) = 1, -1, 0)
    m_adoRst![isgyswlhs] = IIf(OtherValue(13) = 1, -1, 0)
    m_adoRst![isbmhs] = IIf(OtherValue(14) = 1, -1, 0)
    m_adoRst![isxmhs] = IIf(OtherValue(15) = 1, -1, 0)
    m_adoRst![isxjllkm] = IIf(OtherValue(16) = 1, -1, 0)
    m_adoRst![xjlllb] = OtherValue(17)
    m_adoRst![isfc] = IIf(OtherValue(18) = 1, -1, 0)
    m_adoRst.Update
End Sub

'方法 3：删除一条记录，并更新树表。
'C：待删除记录的代码。
'Ind：待删除记录在树表中索引。
Public Sub Delete(cTl As TreeView, C As String, ind As Integer)
    '删除记录。
    Call DeleteRec(C)
    '更新树表。
    
    '如果当前没删除的结点的同级结点只剩余一个时,
    '在删除结点后将该结点的父结点的末级科目标志置为true;
    If cTl.Nodes(ind).Parent.Children = 1 Then
        glo.cnnMain.Execute "Update tZW_Km" & glo.sOperateYear & _
            " Set isendkm=-1 where kmdm='" & _
            Right$(cTl.Nodes(ind).Parent.Key, _
                Len(cTl.Nodes(ind).Parent.Key) - 1) & "'"
    End If
End Sub

'方法：结点处于第几级。
Public Function GetLevel(ByVal NewNode As Node) As Byte
    Dim Nodx As Node
    Dim l As Byte
    
    Set Nodx = NewNode
    l = 0
    Do Until Nodx.Key = "R"
        Set Nodx = Nodx.Parent
        l = l + 1
    Loop
    GetLevel = l
End Function

'装载“科目类型“树表
' 入口参数：
'           Condistion ：  为“*”时条件为所有值，否则就是打开科目表时的Where子句选择条件
'
Public Sub LoadAllRoot(cTl As TreeView, strTemp As String, _
            Condistion As String, bFrmPgs As Boolean)
    Dim rSt As ADODB.Recordset
    Dim j As Integer
    
    j = 0
    Set rSt = New ADODB.Recordset
    rSt.CursorLocation = adUseClient
    If rSt.State = adStateClosed Then
        rSt.Open "select classserial,classname,yefx from " & _
                "tSYS_tradecodeclass A,tSYS_Account B" & _
                " where A.className='" & strTemp & _
                "' and B.AccountID='" & glo.sAccountID & _
                "'and A.tradeID=B.TradeID", gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    End If
    cTl.Nodes.Add , , "R", "科目: " & strTemp, "Root"
    
    If rSt.RecordCount > 0 Then
        Do While Not rSt.EOF
            cTl.Nodes.Add "R", tvwChild, _
                    "k" & Trim$("" & rSt.Fields("classserial").value), _
                    Trim$("" & rSt.Fields("classname").value), "Collapse", "Expand"
            rSt.MoveNext
        Loop
    End If
    
    rSt.Close
    Set rSt = Nothing
    Set m_Tvw = cTl
    '装载根结点及已设置的记录。
    Call loadAllTvw(Condistion, bFrmPgs)

End Sub

'装载“科目样表”树表。
' 入口：
'       strCon：打开科目表时辅助核算选择条件
'       frmPgs：是否显示进度条（TRUE：显示  FALSE：不显示）
'
'卞荣兵 于12月23日修改
'主要把用点分隔科目代码的树的装载添加了上去
Private Sub loadAllTvw(strCon As String, bFrmPgs As Boolean)
    Dim Nodx As Node, tempNode As Node, myNode As Node
    Dim strRoot As String
    Dim strSelfNode As String
    Dim strSelfNodeName As String
    Dim intLenOfRoot As Integer
    Dim intLenOfSelf As Integer
    Dim intKmjcRoot As Integer   '当为符号分隔时的ROOT的级次
    Dim intKmjcSelf As Integer   '当为符号分隔时的当前级次
    Dim iJcTemp As Integer       '科目级次变量
    Dim i As Integer
    Dim j As Integer
    
    Dim strRootKey As String
    
    j = 0
    Set m_adoRst = New ADODB.Recordset
    With m_adoRst
        .CursorLocation = adUseClient
        If m_Tvw.Nodes.Count = 1 Then Exit Sub
        Set myNode = m_Tvw.Nodes("R").Child
        i = myNode.FirstSibling.Index
        strRoot = myNode.Key
        strRootKey = strRoot
        If .State = adStateOpen Then .Close
            .Open "select kmdm,kmmc,kmmceng,zjm,kmlx,kmjc,IsEndkm,yefx,zygs,hzdykm," & _
                "sldw,wbdw,IsRjz,IsYhz,IsGrwlhs,IsKhwlhs,IsGyswlhs,IsBmhs,IsXmhs,IsXjllkm," & _
                "Xjlllb,Isfc,bUse,bAdd from tZW_Km" & glo.sOperateYear & _
                    " where kmdm like '" & Right(strRoot, 1) & "%'" & _
                    IIf(strCon = "*", "", " and " & strCon) & _
                    " order by kmdm", _
                glo.cnnMain, adOpenStatic, adLockOptimistic
        Do Until .EOF
            '取代码与名称及级次。
            strSelfNode = "k" & Trim$("" & .Fields("kmdm").value)
            strSelfNodeName = Trim$("" & .Fields("kmdm").value) & "=" & _
                       Trim$("" & .Fields("kmmc").value)
            strRoot = FindNode(strRootKey, strRoot, strSelfNode)
            Set Nodx = m_Tvw.Nodes.Add(strRoot, tvwChild, strSelfNode, _
                                        strSelfNodeName, "UnSelected", "Selected")
                 '用符号分隔时
'                    intLenOfRoot = CountSeperateChar(strRoot)              '父关联结点的长度
'                    intLenOfSelf = CountSeperateChar(strSelfNode)          '本结点的长度
''                    装载科目树
'                     If Len(strRoot) <> 2 Then
'                            If intLenOfRoot - intLenOfSelf = 0 Then         '为同级结点
'                                Set Nodx = m_Tvw.Nodes.Add(strRoot, tvwNext, strSelfNode, _
'                                        strSelfNodeName, "UnSelected", "Selected")
'                            ElseIf intLenOfRoot - intLenOfSelf < 0 Then     '为子结点
'                                If InStr(1, strSelfNodeName, strRoot, vbTextCompare) = 1 Then
'                                    Set Nodx = m_Tvw.Nodes.Add(strRoot, tvwChild, strSelfNode, _
'                                            strSelfNodeName, "UnSelected", "Selected")
'                                Else
'                                    Set tempNode = m_Tvw.Nodes(strRoot)
'                                    Do Until (InStr(1, tempNode.Key, strRoot, vbTextCompare) = 1)
'                                          Set tempNode = tempNode.Parent
'                                    Loop
'                                    Set Nodx = m_Tvw.Nodes.Add(tempNode.Key, tvwChild, strSelfNode, _
'                                            strSelfNodeName, "UnSelected", "Selected")
'                                End If
'                            ElseIf intLenOfRoot - intLenOfSelf > 0 Then
'                                Set tempNode = m_Tvw.Nodes(strRoot)
'                                '查找与当前插入结点同长度的上一个插入结点的父结点
'                                    Do Until (CountSeperateChar(tempNode.Key) = intLenOfSelf)
'                                          Set tempNode = tempNode.Parent
'                                    Loop
'                                    Set Nodx = m_Tvw.Nodes.Add(tempNode.Key, tvwNext, strSelfNode, _
'                                    strSelfNodeName, "UnSelected", "Selected")
'                            End If
'                    Else
'                                Set Nodx = m_Tvw.Nodes.Add(strRoot, tvwChild, strSelfNode, _
'                                        strSelfNodeName, "UnSelected", "Selected")
'                   End If
'

                m_Tvw.Nodes(strSelfNode).Sorted = True
                '转换根结点
                 strRoot = strSelfNode
                .MoveNext
                j = j + 1
                If bFrmPgs Then
                    glo.frmProg.ShowProgress 30 + Int(j / m_adoRst.RecordCount * 70)
                End If
           Loop
    End With
    
    m_Tvw.Nodes("R").Expanded = True
    m_Tvw.Nodes("R").Child.Expanded = True
    
End Sub
'李剑就过滤问题2002-11-27
Private Function FindNode(ByVal strRoot As String, ByVal strNodeKey As String, ByVal strNewKey As String) As String
Dim tNode As Node
Dim iLenOfRoot As Integer
Dim iLenOfSelf As Integer
'iLenOfRoot = CountSeperateChar(strNodeKey)              '父关联结点的长度
'iLenOfSelf = CountSeperateChar(strNewKey)          '本结点的长度
Set tNode = m_Tvw.Nodes(strNodeKey)
Do Until (InStr(1, strNewKey, tNode.Key + glo.sSeparateSubject, vbTextCompare) = 1 Or Len(tNode.Key) = 2)
    Set tNode = tNode.Parent
Loop
FindNode = tNode.Key
End Function

'卞荣兵修改于2001.12.23
Private Sub DeleteRec(C As String)
    Dim sSql As String
    '删除科目表的科目
    sSql = "Delete from tZW_Km" & glo.sOperateYear & _
            " where kmdm='" & C & "'"
    glo.cnnMain.Execute sSql
    '删除科目余额表中的科目
    sSql = "Delete from tzw_balance" & glo.sOperateYear & _
          "  where kmdm='" & C & "'"
    glo.cnnMain.Execute sSql
    
End Sub