指定附表.frm

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

VERSION 5.00
Begin VB.Form frmAddOnSet 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "附表设置"
   ClientHeight    =   5070
   ClientLeft      =   2400
   ClientTop       =   1365
   ClientWidth     =   5145
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5070
   ScaleWidth      =   5145
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdChange 
      Caption         =   "修改"
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   4320
      Width           =   975
   End
   Begin VB.ComboBox cboSum 
      Height          =   300
      Left            =   2760
      TabIndex        =   8
      ToolTipText     =   "请选择一个合计字段"
      Top             =   3720
      Width           =   1575
   End
   Begin VB.ComboBox cboTableName 
      Height          =   300
      Left            =   2760
      Style           =   2  'Dropdown List
      TabIndex        =   1
      ToolTipText     =   "选择附表名称!"
      Top             =   120
      Width           =   1575
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   3840
      TabIndex        =   11
      Top             =   4320
      Width           =   975
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   375
      Left            =   2160
      TabIndex        =   9
      Top             =   4320
      Width           =   975
   End
   Begin VB.CommandButton cmdAddAll 
      Caption         =   ">>"
      Height          =   255
      Left            =   2400
      TabIndex        =   6
      Top             =   2280
      Width           =   375
   End
   Begin VB.CommandButton cmdRemoveAll 
      Caption         =   "<<"
      Height          =   255
      Left            =   2400
      TabIndex        =   7
      Top             =   2760
      Width           =   375
   End
   Begin VB.CommandButton cmdRemoveOne 
      Caption         =   "<"
      Height          =   255
      Left            =   2400
      TabIndex        =   5
      Top             =   1680
      Width           =   375
   End
   Begin VB.CommandButton cmdAddOne 
      Caption         =   ">"
      Height          =   255
      Left            =   2400
      TabIndex        =   4
      Top             =   1200
      Width           =   375
   End
   Begin VB.ListBox lstChosen 
      Height          =   2580
      Left            =   3000
      MultiSelect     =   2  'Extended
      TabIndex        =   3
      ToolTipText     =   "已选字段"
      Top             =   960
      Width           =   1815
   End
   Begin VB.ListBox lstAll 
      Height          =   2580
      Left            =   360
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      ToolTipText     =   "可选字段"
      Top             =   960
      Width           =   1815
   End
   Begin VB.Label lbUsed 
      Caption         =   "已使用"
      ForeColor       =   &H000000FF&
      Height          =   975
      Left            =   4440
      TabIndex        =   15
      Top             =   120
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label Label1 
      Caption         =   "设定合计字段："
      Height          =   255
      Index           =   2
      Left            =   360
      TabIndex        =   14
      Top             =   3840
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "可选项目："
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   600
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "已选项目："
      Height          =   255
      Index           =   1
      Left            =   2760
      TabIndex        =   12
      Top             =   600
      Width           =   1575
   End
   Begin VB.Label Label1 
      Caption         =   "选择表名："
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   10
      Top             =   120
      Width           =   1575
   End
End
Attribute VB_Name = "frmAddOnSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_objTable As DOMDocument
Private m_objField As DOMDocument
Private iid As Integer
Private m_bUsed As Boolean
Private m_bChange As Boolean

Public Property Let prjid(ByVal vNewValue As Integer)
    iid = vNewValue
End Property

'填充表名
Private Sub FillTableName()
    On Error Resume Next
    Dim Node As IXMLDOMElement
    Dim root As IXMLDOMElement
    Dim AddOn As New U8BudgetMgr.clsAddOnImp
    Dim rtn As DOMDocument

    Set rtn = m_objAid.objGenerateUFDom("proc", "gettable")
    AddOn.Transact rtn, m_objTable, zjLogInfo
    
    If m_objAid.iSuccess(m_objTable) <> 0 Then
        frmExportInfo.SetInfo m_objTable.xml
        frmExportInfo.Show vbModal
        Set m_objTable = Nothing
        Exit Sub
    End If

    '将中文名字插入,因为可能出现数字的情况,所以在前面加了个t,字段则是加了f
    Set root = m_objAid.objSelectRootTag(m_objTable)
    For Each Node In root.childNodes
        cboTableName.AddItem mID(Node.nodename, 2)
    Next
End Sub

Private Sub FillSum()
    Dim i As Integer
    Dim Node As IXMLDOMElement
    Dim root As IXMLDOMElement
    
    On Error Resume Next
    cboSum.clear
    Set root = m_objField.documentElement
    For i = 0 To lstChosen.ListCount
        Set Node = root.selectSingleNode("f" & lstChosen.List(i))
        If m_objAid.GetAttributeVal("type", Node) = "数字" Then
            cboSum.AddItem lstChosen.List(i)
        End If
    Next
End Sub

'填充字段名称
Private Sub FillFieldName(Optional code As String, Optional flag As Boolean = True)
    Dim Node As IXMLDOMElement
    Dim root As IXMLDOMElement
    Dim rtn As DOMDocument
    Dim AddOn As New U8BudgetMgr.clsAddOnImp
    Dim str As String
    
    On Error Resume Next
    '获取字段内容
    If code = "" Then
        Set Node = m_objTable.documentElement.selectSingleNode("t" & Trim(cboTableName.Text))
        code = m_objAid.GetAttributeVal("code", Node)
    End If
    
    Set rtn = m_objAid.objGenerateUFDom("roottag", "fd", "proc", "getfield")
    Set root = m_objAid.objSelectRootTag(rtn)
    root.setAttribute "tablecode", code
    AddOn.Transact rtn, m_objField, zjLogInfo
    
    If m_objAid.iSuccess(m_objField) Then
        frmExportInfo.SetInfo m_objField.xml
        frmExportInfo.Show vbModal
        Set m_objField = Nothing
        Exit Sub
    End If
    
    '将中文名字插入
    Set root = m_objAid.objSelectRootTag(m_objField)
    For Each Node In root.childNodes
        If flag Then
            str = LCase(Node.getAttribute("name"))
            If str = "cautocode" Or str = "cautoname" Then
                lstChosen.AddItem mID(Node.nodename, 2)
            Else
                lstAll.AddItem mID(Node.nodename, 2)
            End If
        Else
            lstChosen.AddItem mID(Node.nodename, 2)
        End If
    Next
    
End Sub

Private Sub cboSum_GotFocus()
    If lstChosen.ListCount <> 0 Then
        FillSum
    End If
End Sub


Private Sub cboSum_LostFocus()
    On Error Resume Next
    If Not m_objAid.bContain((cboSum.Text), cboSum) Then
        cboSum.Text = ""
    End If
End Sub

'表名变化
Private Sub cboTableName_Click()
    '清空原有数据
    On Error Resume Next
    lstAll.clear
    lstChosen.clear
    If Not m_objTable Is Nothing Then
        FillFieldName
    End If
End Sub

Private Sub cboTableName_LostFocus()
    '判断是否在已有的表名中,资金也可以用
    On Error Resume Next
    If Trim(cboTableName.Text) = "" Then
        Exit Sub
    End If
    If Not m_objAid.bContain(Trim(cboTableName.Text), cboTableName) Then
        cboTableName.Text = ""
        iShowMsg "不存在对应的表!"
        cboTableName_Click
    End If
End Sub


'增加全部
Private Sub cmdAddAll_Click()
    MoveItem True, True
End Sub

'增加一部分
Private Sub cmdAddOne_Click()
    MoveItem True