dataviewer.ctl

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl DataViewer 
   ClientHeight    =   3015
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5355
   LockControls    =   -1  'True
   ScaleHeight     =   3015
   ScaleWidth      =   5355
   Begin MSComctlLib.ImageList imlImages 
      Left            =   1080
      Top             =   1935
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   128
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "DataViewer.ctx":0000
            Key             =   "Closed"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "DataViewer.ctx":0112
            Key             =   "Open"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "DataViewer.ctx":0224
            Key             =   "Item"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvwData 
      Height          =   2895
      Left            =   2700
      TabIndex        =   1
      Top             =   45
      Width           =   2580
      _ExtentX        =   4551
      _ExtentY        =   5106
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      Icons           =   "imlImages"
      SmallIcons      =   "imlImages"
      ColHdrIcons     =   "imlImages"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.TreeView TvwData 
      Height          =   2895
      Left            =   45
      TabIndex        =   0
      Top             =   45
      Width           =   2580
      _ExtentX        =   4551
      _ExtentY        =   5106
      _Version        =   393217
      Indentation     =   441
      Style           =   7
      ImageList       =   "imlImages"
      Appearance      =   1
   End
End
Attribute VB_Name = "DataViewer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'缺省属性值:
Const m_def_DatabaseName = ""
Const m_def_ParentTableName = ""
Const m_def_ParentIDField = ""
Const m_def_ParentNameField = ""
Const m_def_ChildTableName = ""
Const m_def_ChildIDField = ""
Const m_def_ChildNameField = ""
Const m_def_LinkField = ""
'属性变量:
Dim m_DatabaseName As String
Dim m_ParentTableName As String
Dim m_ParentIDField As String
Dim m_ParentNameField As String
Dim m_ChildTableName As String
Dim m_ChildIDField As String
Dim m_ChildNameField As String
Dim m_LinkField As String
Private dcnDB As ADODB.Connection



Private Sub TvwData_NodeClick(ByVal Node As MSComctlLib.Node)
    OpenChildTable
End Sub



Private Sub UserControl_Resize()
    With UserControl
        TvwData.Height = .ScaleHeight
        lvwData.Height = .ScaleHeight
        If .ScaleWidth - lvwData.Left > 0 Then
            lvwData.Width = .ScaleWidth - lvwData.Left
        End If
    End With
End Sub
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get DatabaseName() As String
    DatabaseName = m_DatabaseName
End Property

Public Property Let DatabaseName(ByVal New_DatabaseName As String)
    m_DatabaseName = New_DatabaseName
    PropertyChanged "DatabaseName"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ParentTableName() As String
    ParentTableName = m_ParentTableName
End Property

Public Property Let ParentTableName(ByVal New_ParentTableName As String)
    m_ParentTableName = New_ParentTableName
    PropertyChanged "ParentTableName"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ParentIDField() As String
    ParentIDField = m_ParentIDField
End Property

Public Property Let ParentIDField(ByVal New_ParentIDField As String)
    m_ParentIDField = New_ParentIDField
    PropertyChanged "ParentIDField"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ParentNameField() As String
    ParentNameField = m_ParentNameField
End Property

Public Property Let ParentNameField(ByVal New_ParentNameField As String)
    m_ParentNameField = New_ParentNameField
    PropertyChanged "ParentNameField"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ChildTableName() As String
    ChildTableName = m_ChildTableName
End Property

Public Property Let ChildTableName(ByVal New_ChildTableName As String)
    m_ChildTableName = New_ChildTableName
    PropertyChanged "ChildTableName"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ChildIDField() As String
    ChildIDField = m_ChildIDField
End Property

Public Property Let ChildIDField(ByVal New_ChildIDField As String)
    m_ChildIDField = New_ChildIDField
    PropertyChanged "ChildIDField"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get ChildNameField() As String
    ChildNameField = m_ChildNameField
End Property

Public Property Let ChildNameField(ByVal New_ChildNameField As String)
    m_ChildNameField = New_ChildNameField
    PropertyChanged "ChildNameField"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get LinkField() As String
    LinkField = m_LinkField
End Property

Public Property Let LinkField(ByVal New_LinkField As String)
    m_LinkField = New_LinkField
    PropertyChanged "LinkField"
End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    m_DatabaseName = PropBag.ReadProperty("DatabaseName", m_def_DatabaseName)
    m_ParentTableName = PropBag.ReadProperty("ParentTableName", m_def_ParentTableName)
    m_ParentIDField = PropBag.ReadProperty("ParentIDField", m_def_ParentIDField)
    m_ParentNameField = PropBag.ReadProperty("ParentNameField", m_def_ParentNameField)
    m_ChildTableName = PropBag.ReadProperty("ChildTableName", m_def_ChildTableName)
    m_ChildIDField = PropBag.ReadProperty("ChildIDField", m_def_ChildIDField)
    m_ChildNameField = PropBag.ReadProperty("ChildNameField", m_def_ChildNameField)
    m_LinkField = PropBag.ReadProperty("LinkField", m_def_LinkField)
    '注意：只有在属性窗口设置所有需要的属性时,控件才显示结果
    '若须让用语句赋属性值也可显示结果，则可在Let过程中设置相应语句
    If Ambient.UserMode Then
        Connect
        OpenParentTable
    End If
    
End Sub

Private Sub UserControl_Terminate()
    Disconnect
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("DatabaseName", m_DatabaseName, m_def_DatabaseName)
    Call PropBag.WriteProperty("ParentTableName", m_ParentTableName, m_def_ParentTableName)
    Call PropBag.WriteProperty("ParentIDField", m_ParentIDField, m_def_ParentIDField)
    Call PropBag.WriteProperty("ParentNameField", m_ParentNameField, m_def_ParentNameField)
    Call PropBag.WriteProperty("ChildTableName", m_ChildTableName, m_def_ChildTableName)
    Call PropBag.WriteProperty("ChildIDField", m_ChildIDField, m_def_ChildIDField)
    Call PropBag.WriteProperty("ChildNameField", m_ChildNameField, m_def_ChildNameField)
    Call PropBag.WriteProperty("LinkField", m_LinkField, m_def_LinkField)
End Sub
Private Sub Connect()
    If m_DatabaseName = "" Then Exit Sub
    Set dcnDB = New ADODB.Connection
    dcnDB.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & m_DatabaseName
End Sub
Private Sub Disconnect()
    On Error Resume Next
    dcnDB.Close
End Sub
Private Sub OpenParentTable()
    Dim rsParent As ADODB.Recordset
    If dcnDB Is Nothing Then Exit Sub
    If m_ParentTableName = "" Or m_ParentIDField = "" Or m_ParentNameField = "" Then Exit Sub
    Set rsParent = New ADODB.Recordset
    rsParent.Open m_ParentTableName, dcnDB, adOpenStatic, adLockReadOnly
    Do While Not rsParent.EOF
        TvwData.Nodes.Add , , "Item" & rsParent(m_ParentIDField), rsParent(m_ParentNameField), "Closed", "Open"
        rsParent.MoveNext
    Loop
    rsParent.Close
End Sub
Private Sub OpenChildTable()
    Dim rsChild As ADODB.Recordset
    Dim strSQL As String
    
    If dcnDB Is Nothing Then Exit Sub
    If m_LinkField = "" Or m_ChildTableName = "" Or m_ChildIDField = "" Or m_ChildNameField = "" Then Exit Sub
    strSQL = "select * from " & m_ChildTableName & " where " & m_LinkField & "=" & Mid(TvwData.SelectedItem.Key, Len("Item") + 1) & " order by " & m_ChildNameField
    Set rsChild = New ADODB.Recordset
    rsChild.Open strSQL, dcnDB, adOpenStatic, adLockReadOnly
    
    lvwData.ListItems.Clear
    lvwData.ColumnHeaders.Clear
    lvwData.ColumnHeaders.Add , , m_ChildNameField
    Do While Not rsChild.EOF
        lvwData.ListItems.Add , "Item" & rsChild(m_ChildIDField), rsChild(m_ChildNameField), "Item"
        rsChild.MoveNext
    Loop
    rsChild.Close
End Sub