frmmain.frm

VB代码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "显示表的内容"
   ClientHeight    =   4845
   ClientLeft      =   720
   ClientTop       =   2340
   ClientWidth     =   9390
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4845
   ScaleWidth      =   9390
   Begin VB.ListBox lstPublisher 
      Height          =   4200
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   2655
   End
   Begin MSComctlLib.ListView lvwTitle 
      Height          =   4215
      Left            =   3000
      TabIndex        =   0
      Top             =   480
      Width           =   6240
      _ExtentX        =   11007
      _ExtentY        =   7435
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      Icons           =   "imlIcons"
      SmallIcons      =   "imlSmallIcons"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "内容："
      Height          =   180
      Left            =   3000
      TabIndex        =   3
      Top             =   120
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "出版社列表："
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1080
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mCon As Connection

Private Sub Form_Load()
   On Error GoTo errHandler
   
   '打开连接对象
   Set mCon = New ADODB.Connection
   Dim str As String
   str = App.Path & "\" & "biblio.mdb"
   mCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & str
   mCon.Open
   
   lvwTitle.View = lvwReport ''设置lvwReport的风格
   lvwTitle.ColumnHeaders.Clear ' 清除 ColumnHeaders 集合。
   '添加四个 ColumnHeaders。
   lvwTitle.ColumnHeaders.Add , "title", "Title", 2800
   lvwTitle.ColumnHeaders.Add , "author", "Author"
   lvwTitle.ColumnHeaders.Add , "year", "Year", 800
   lvwTitle.ColumnHeaders.Add , "isbn", "ISBN"
   
   ' 创建 ADODB 记录集对象变量。
   Dim rsPublishers As New ADODB.Recordset
   ' 设置 ADODB 连接对象的连接字符串并且打开它。
   rsPublishers.Open "SELECT PubID, [Company Name] FROM Publishers", mCon, adOpenStatic, adLockOptimistic
   Do While Not rsPublishers.EOF
     lstPublisher.AddItem rsPublishers![company name], lstPublisher.ListCount
     lstPublisher.ItemData(lstPublisher.ListCount - 1) = rsPublishers!PubID
     rsPublishers.MoveNext   ' 移动到下一个出版商记录。
   Loop
   
   rsPublishers.Close   '关闭记录集对象
   Exit Sub
   
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub lstPublisher_Click()
   '以SQL语句来打开记录集
   Dim rsTitles As New ADODB.Recordset
   Dim strSQL As String
   strSQL = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & _
           "Titles.[Year Published] as year FROM Authors INNER JOIN " & _
           "(Titles INNER JOIN [Title Author] " & _
           "ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
           "[Title Author].Au_ID WHERE Titles.PubID=" & lstPublisher.ItemData(lstPublisher.ListIndex)
   rsTitles.Open strSQL, mCon, adOpenStatic, adLockReadOnly, adCmdText
   
   Dim xItem As ListItem
   lvwTitle.ListItems.Clear
   While Not rsTitles.EOF
     '添加到ListView中
     Set xItem = lvwTitle.ListItems.Add(Text:=rsTitles!TITLE)
     xItem.ListSubItems.Add Key:="author", Text:=rsTitles!author
     xItem.ListSubItems.Add Key:="year", Text:=rsTitles!Year
     xItem.ListSubItems.Add Key:="isbn", Text:=rsTitles!isbn
     rsTitles.MoveNext
   Wend
   Exit Sub

errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub lvwTitle_ColumnClick(ByVal ColumnHeader As ColumnHeader)
   lvwTitle.SortKey = ColumnHeader.Index - 1
   ' 设置 Sorted 为真对列表进行排序。
   lvwTitle.Sorted = True
End Sub