VB6 ADO ListView数据库分页显示

　　Dim link1 As New ADODB.Connection

　　Dim rs As New ADODB.Recordset

　　Dim page As Integer

　　Dim pubdatapath As String

　　Sub opendatabase(datapath As String) '打开数据库函数

　　page = 1 '首次定义打开时的页码为1

　　If link1.State = 1 Then '如果以连接过，则关闭，初始化下次事务

　　link1.Close: list2.ListItems.Clear: list2.ColumnHeaders.Clear: c.Clear: list1.ListItems.Clear

　　End If

　　link1.ConnectionString = "Provider=microsoft.jet.oledb.4.0;data source=" & datapath

　　link1.Open

　　pubdatapath = datapath

　　Set biaoming = link1.OpenSchema(adSchemaColumns) '创建数据库记录集

　　tablename = ""

　　Do Until biaoming.EOF

　　If biaoming("table_name") <> tablename Then '列出所有表

　　tablename = biaoming("table_name")

　　list1.ListItems.Add , , tablename

　　End If

　　biaoming.MoveNext

　　Loop

　　Set biaoming = Nothing

　　menu1.Enabled = True

　　list1_MouseUp 1, 0, 10, 10

　　End Sub

　　Private Sub Command1_Click() '打开数据库

　　d.DialogTitle = "打开一个数据库文件进行浏览"

　　d.InitDir = App.Path

　　d.FileName = ""

　　d.Filter = "Access数据库(mdb后缀,推荐格式)　*.mdb"

　　d.ShowOpen

　　If d.FileName = "" Then Exit Sub

　　opendatabase d.FileName

　　End Sub

　　

　　Private Sub Command4_Click()

　　str1 = InputBox("请输入一个1-5000之间的数字", "重设", Text1.Text)

　　If str1 = Text1.Text Or str1 = "" Then Exit Sub

　　If IsNumeric(str1) = False Then Exit Sub

　　If str1 > 5000 Or str1 < 1 Then Exit Sub

　　Text1.Text = str1

　　If list1.ListItems.Count = 0 Then Exit Sub Else list1_MouseUp 1, 0, 10, 10

　　End Sub　　

　　Private Sub down_Click() '功能，下一页

　　page = page 1: list1_MouseUp 1, 0, 10, 10

　　End Sub　　

　　Private Sub findstr_Click() '查询数据

　　If InStr(Text2.Text, "'") <> 0 Then MsgBox "查询时关键字不允许包含 ' 符号", VBCritical, "无效字符": Exit Sub

　　If rs.State = 1 Then rs.Close

　　rs.Open "select " & c.Text & " from " & list1.SelectedItem.Text & " where " & c.Text & " like '%" & Text2.Text & "%'", link1, adOpenStatic, adLockReadOnly

　　If rs.EOF Then MsgBox "没有符号条件的记录,请从新查找", vbCritical, "未发现记录": Exit Sub

　　Do While Not rs.EOF

　　i = i 1

　　str1 = str1 & i & " ： " & rs(0) & vbCrLf

　　rs.MoveNext

　　Loop

　　MsgBox str1, vbExclamation, "查询结果 - " & rs.RecordCount & "匹配"

　　End Sub

　　　　

　　Private Sub Form_Resize()

　　list1.ColumnHeaders(1).Width = list1.Width - 80

　　list2.Width = Me.ScaleWidth - list2.Left - 30

　　list1.Height = Me.ScaleHeight - list1.Top - 30

　　list2.Height = Me.ScaleHeight - (Me.ScaleHeight - down.Top) - 150

　　End Sub

　　Private Sub Form_Unload(Cancel As Integer)

　　If rs.State = 1 Then rs.Close

　　If link1.State = 1 Then link1.Close

　　Set rs = Nothing: Set link1 = Nothing

　　End Sub　　

　　Private Sub list1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) '切换表

　　On Error Resume Next

　　If list1.ListItems.Count = 0 Then Exit Sub

　　If rs.State = 1 Then rs.Close

　　list2.ListItems.Clear: list2.ColumnHeaders.Clear: c.Clear

　　rs.Open "select * from " & list1.SelectedItem.Text, link1, adOpenStatic, adLockReadOnly

　　If Err.Number <> 0 Then

　　MsgBox "该数据表不能支持的游标模式", vbCritical, "不规则的格式": Exit Sub

　　End If

　　rs.PageSize = Text1.Text

　　rslen = rs.RecordCount

　　If rs.PageCount < page Then page = 1

　　Label3.Caption = "共" & rslen & "条记录,共" & rs.PageCount & "页,当前页码 " & page

　　If rs.PageCount > page Then down.Enabled = True Else down.Enabled = False

　　If page <> 1 Then up.Enabled = True Else up.Enabled = False

　　Set ziduan = rs.Fields '定义字段记录集

　　For i = 0 To ziduan.Count - 1

　　list2.ColumnHeaders.Add , , ziduan(i).Name '根据字段指定视图列

　　c.AddItem ziduan(i).Name

　　rs.MoveFirst '记录到尾后填充下一列

　　rs.AbsolutePage = page '定义记录集的绝对页码

　　For r = 0 To rs.PageSize - 1

　　If rs.EOF Then Exit For

　　rstext = rs(i)

　　If i = 0 Then '首次直接填充第一列

　　list2.ListItems.Add , , rstext

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有