frmread.frm

星级酒店管理系统VB源代码

               EndProperty
               BeginProperty Column11 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column12 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column13 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column14 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column15 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column16 
                  ColumnWidth     =   2085.166
               EndProperty
               BeginProperty Column17 
                  ColumnWidth     =   2085.166
               EndProperty
            EndProperty
         End
      End
      Begin MSComctlLib.TabStrip TabStrip1 
         Height          =   7155
         Left            =   -74880
         TabIndex        =   16
         Top             =   480
         Width           =   3375
         _ExtentX        =   5953
         _ExtentY        =   12621
         _Version        =   393216
         BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
            NumTabs         =   3
            BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "类别一"
               Key             =   "a"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "类别二"
               Key             =   "b"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "类别三"
               Key             =   "c"
               ImageVarType    =   2
            EndProperty
         EndProperty
      End
      Begin VB.OLE OLE1 
         BackColor       =   &H00FFFFC0&
         DataField       =   "内容"
         DataSource      =   "Data1"
         Height          =   6675
         Left            =   -71340
         TabIndex        =   15
         Top             =   540
         Width           =   6315
      End
   End
End
Attribute VB_Name = "frmRead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public cn As New ADODB.Connection
Public WithEvents tvwPublishers As MSComctlLib.TreeView
Attribute tvwPublishers.VB_VarHelpID = -1

Private Sub Command3_Click()
  Unload fMainForm.ActiveForm
  fMainForm.Picture2.Visible = True

End Sub

Private Sub Form_Load()
    Dim rss As New ADODB.Recordset
    Dim i As Integer
    
    ' Show the database.
    On Error Resume Next
    cn.Open "DSN=DM;UID=;PWD=;"
    
    If Err Then
        MsgBox "Unable to database " & Err.Description, vbCritical
        End
    End If
    
    rss.Open "select DISTINCT 类别 from 类别信息", cn, adOpenForwardOnly, adLockReadOnly
    If Err Then
        MsgBox "Unable to open table" & Err.Description, vbCritical
        End
    End If

    If Not rss.EOF Then
        rss.MoveFirst
        Set tvwPublishers = Controls.Add("MSComctlLib.TreeCtrl.2", "tvw", picTab)
    
        With tvwPublishers
            .Scroll = True
            .ImageList = ImageList1
            .Indentation = 400
            .Visible = False
            .Top = picTab.ScaleTop
            .Left = picTab.ScaleLeft
            .Height = picTab.ScaleHeight
            .Width = picTab.ScaleWidth
        End With
    
        tvwPublishers.Visible = True
        
        i = 1
        TabStrip1.Tabs(i).Caption = rss.Fields("类别")
        TabStrip1.Tabs(i).Key = rss.Fields("类别")
        Set TabStrip1.SelectedItem = TabStrip1.Tabs(i)
        TabStrip1.Tabs(i).Selected = True
    End If
    
    If Not rss.EOF Then
        rss.MoveNext
        
        Do Until rss.EOF
            i = i + 1
            If i > 3 Then
                TabStrip1.Tabs.Add , , ""
            End If
                
            TabStrip1.Tabs(i).Caption = rss.Fields("类别")
            TabStrip1.Tabs(i).Key = rss.Fields("类别")
            rss.MoveNext
        Loop
        
        picTab.Move TabStrip1.clientLeft, TabStrip1.clientTop, TabStrip1.clientWidth, TabStrip1.clientHeight
        picTab.BorderStyle = 0
        
        tvwPublishers.Scroll = True
        rss.Close
    End If
    DatabaseRefresh
End Sub

Private Sub TabStrip1_Click()
    
    picTab.Visible = True
    
    Controls.Remove "tvw"
    
    Set tvwPublishers = Controls.Add("MSComctlLib.TreeCtrl.2", "tvw", picTab)
    
    With tvwPublishers
        .Scroll = True
        .ImageList = ImageList1
        .Indentation = 400
        .Top = picTab.ScaleTop
        .Left = picTab.ScaleLeft
        .Height = picTab.ScaleHeight
        .Width = picTab.ScaleWidth
    End With
    
    tvwPublishers.Visible = True
    
    DatabaseRefresh

End Sub

Private Sub tvwPublishers_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim curs As String
    
    If IsNumeric(Node.Tag) Then
        curs = "编号 = " & Node.Tag
        Data1.Connect = "ODBC;DSN=DM;UID=;PWD=;"
        Data1.DefaultType = 1
        Data1.RecordSource = "select * from 文档信息表 where " & curs
        Data1.Refresh
        Data1.Recordset.MoveFirst
        OLE1.Refresh
    End If
End Sub


Private Sub DatabaseRefresh()
    Dim rsa As New ADODB.Recordset
    Dim qrys As String
    Dim rootNode As Node, nd As Node
   
    On Error Resume Next
        
    qrys = "select * from 文档信息表 where trim(类别) = '" & TabStrip1.SelectedItem.Key & "'"
    ' Open the Authors recordset.
    rsa.Open qrys, cn, adOpenForwardOnly, adLockReadOnly
    
    If Err Then
        MsgBox "Unable to open aaa table", vbCritical
        End
    End If
    
    tvwPublishers.Refresh
    
    ' Add the "Publishers" root (expanded).
    Set rootNode = tvwPublishers.Nodes.Add(, , TabStrip1.SelectedItem.Key, "[" & TabStrip1.SelectedItem.Key & "]文档仓库", 2)
    rootNode.Expanded = True
    
    ' Add all the publishers, with a plus sign.
    Do Until rsa.EOF
        Set nd = tvwPublishers.Nodes.Add(rootNode.Key, tvwChild, , rsa.Fields("主题"), 1)
        ' We can't use PubID as the Key, because it is a number.
        nd.Tag = rsa.Fields("主题")
        AddDummyChild nd
        rsa.MoveNext
    Loop
    rsa.Close
    
End Sub

Sub AddDummyChild(nd As Node)
    ' add a dummy child node, if necessary
    If nd.children = 0 Then
        ' dummy nodes' Text property is "***"
        tvwPublishers.Nodes.Add nd.Index, tvwChild, , "***"
    End If
End Sub

Private Sub tvwPublishers_Expand(ByVal Node As MSComctlLib.Node)
    ' a node if being expanded
    Dim nd As Node
    ' exit if the node had been already expanded in the past
    If Node.children = 0 Or Node.children > 1 Then Exit Sub
    ' also exit if it doesn't have a dummy child node
    If Node.Child.Text <> "***" Then Exit Sub
    ' remove the dummy child item
    tvwPublishers.Nodes.Remove Node.Child.Index
    ' add all the titles for this Node object
    AddTitles Node
End Sub

Private Sub AddTitles(ByVal Node As MSComctlLib.Node)
    Dim nd As Node
    Dim tv As String
    Dim rsb As New ADODB.Recordset
    
    ' Show all the titles for the expanded publishers.
    rsb.Open "Select 编号, 标题 From 文档信息表 Where 主题 = '" & Node.Tag & "'", cn, adOpenForwardOnly, adLockReadOnly
    Do Until rsb.EOF
        If IsNull(rsb.Fields("标题")) Then
            tv = "(无)"
        Else
            tv = rsb.Fields("标题")
        End If
        Set nd = tvwPublishers.Nodes.Add(Node, tvwChild, , tv, 1)
        nd.Tag = rsb.Fields("编号")
        rsb.MoveNext
    Loop
    rsb.Close
End Sub

Private Sub Command1_Click()
    Dim sFilter As String
    Dim s1 As String
    Dim s2 As String
    
    If DataCombo2.BoundText = "(所有)" Then
        s1 = "(编号 > 0 )"
    Else
        s1 = "(类别 = '" & DataCombo2.BoundText & "')"
    End If
    
    If DataCombo1.Text = "(所有)" Then
        s2 = "(编号 > -1 )"
    Else
        s2 = " (文件格式 = '" & DataCombo1.BoundText & "')"
    End If

    sFilter = s1 & " and " & s2 & " and " & "(最后归档时间 > " & DTPicker1.Value & ") and (最后归档时间 < " & DTPicker2.Value & ")"

    Adodc1.Recordset.Filter = ""
    Adodc1.Recordset.Filter = sFilter
    
End Sub

Private Sub Command2_Click()
    Adodc1.Recordset.Filter = "编号 > 0"
End Sub