做一个数据库管理系统，其中要用到数据的分页显示技术，所以花点时间研究了一下，实现比较简单，代码如下：
Option Explicit
Dim Con As New ADODB.Connection
Dim Res As New ADODB.Recordset
Dim ResTemp As New ADODB.Recordset '记录每一次记录集的位置
Dim RecordCount As Integer
Dim CurrentPage As Integer
Const PageSize = 25
Public PageCount As Integer
Private FormOldWidth As Long '保存窗体宽度
Private FormOldHeight As Long '保存窗体高度
Private FormOldFont As Single '保存字体尺寸大小
Private Sub CmdFirst_Click(Index As Integer) '显示第一页记录
CurrentPage = 1
Call ShowInfo(CurrentPage)
CmdFirst(0).Enabled = False
CmdLast(3).Enabled = True
CmdNext(1).Enabled = True
CmdPre(2).Enabled = False
End Sub
Private Sub CmdLast_Click(Index As Integer) '显示最后一页记录
CurrentPage = PageCount
Call ShowInfo(CurrentPage)
CmdLast(3).Enabled = False
CmdNext(1).Enabled = False
CmdPre(2).Enabled = True
CmdFirst(0).Enabled = True
End Sub
Private Sub CmdNext_Click(Index As Integer) '显示下一页记录
CurrentPage = CurrentPage + 1
Call ShowInfo(CurrentPage)
If CurrentPage = PageCount Then
CmdNext(1).Enabled = False
End If
CmdFirst(0).Enabled = True
CmdPre(2).Enabled = True
End Sub
Private Sub CmdPre_Click(Index As Integer) '显示前一页记录
CurrentPage = CurrentPage - 1
If CurrentPage < 1 Then
CurrentPage = 1
CmdPre(2).Enabled = False
End If
CmdFirst(0).Enabled = True
CmdNext(1).Enabled = True
CmdLast(3).Enabled = True
Call ShowInfo(CurrentPage)
End Sub
Private Sub Form_Load()
Call ResizeInit(Me)
ListView_Show.View = lvwReport '报表显示
ListView_Show.GridLines = True '显示网格线
ListView_Show.FullRowSelect = True
ListView_Show.ColumnHeaders.Add , , "ItemID", 1000
ListView_Show.ColumnHeaders.Add , , "Modality", 1000
ListView_Show.ColumnHeaders.Add , , "ItemCode", 1000
ListView_Show.ColumnHeaders.Add , , "ItemChinese", 1500
ListView_Show.ColumnHeaders.Add , , "ItemProtocolCode", 2000
ListView_Show.ColumnHeaders.Add , , "ItemEnglish", 1500
ListView_Show.ColumnHeaders.Add , , "ItemPrice", 1000
ListView_Show.ColumnHeaders.Add , , "OrderNo", 1000
ListView_Show.ColumnHeaders.Add , , "PY", 1000
ListView_Show.ColumnHeaders.Add , , "eMod", 1000
ListView_Show.ColumnHeaders.Add , , "Visibled", 1000
ListView_Show.ColumnHeaders.Add , , "MDeptCode", 1000
ListView_Show.ColumnHeaders.Add , , "ClassTreeID", 1500
ListView_Show.ColumnHeaders.Add , , "IsDefault", 1000
Con.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa;PWD=密码;Initial Catalog=数据库名;Data Source=服务器名" '连接数据库字符串
Con.Open
Con.CommandTimeout = 20
Res.Open "Item", Con, adOpenDynamic, adLockPessimistic
Do While Not Res.EOF
RecordCount = RecordCount + 1
Res.MoveNext
Loop
If RecordCount Mod PageSize = 0 Then
PageCount = RecordCount \ PageSize
Else
PageCount = RecordCount \ PageSize + 1
End If
CurrentPage = 1
Call ShowInfo(CurrentPage)
'Form1.Show
End Sub
Private Sub ShowInfo(CurPage As Integer)
Dim j As Integer
Dim itemA As ListItem
Dim fldName As String
Dim intRecordStart As Integer
Dim intRecordEnd As Integer
Dim cursor As Integer
ListView_Show.ListItems.Clear
If CurPage = 1 Then
intRecordStart = 1
intRecordEnd = PageSize
Else
intRecordStart = (CurPage - 1) * PageSize + 1
intRecordEnd = CurPage * PageSize
If CurPage = PageCount Then
intRecordEnd = RecordCount
End If
End If
cursor = 1
Res.MoveFirst
Do While Not Res.EOF
If cursor >= intRecordStart Then
fldName = ListView_Show.ColumnHeaders(1).Text
Set itemA = ListView_Show.ListItems.Add(, , Res.Fields(fldName))
For j = 2 To ListView_Show.ColumnHeaders.Count
fldName = ListView_Show.ColumnHeaders(j)
If IsNull(Res.Fields(fldName)) Then '如果记录为NULL,则给记录赋值为NULL，然后添加记录
itemA.ListSubItems.Add , , Res.Fields(fldName) & "NULL"
Else
itemA.ListSubItems.Add , , Res.Fields(fldName) '记录不为空则添加记录
End If
Next j
End If
cursor = cursor + 1
If cursor > intRecordEnd Then
Res.MoveLast
End If
Res.MoveNext
Loop
Label2.Caption = Str(CurrentPage)
End Sub
Public Sub ResizeInit(FormName As Form) '初始化窗体尺寸参数
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
FormOldFont = FormName.Font.Size / FormOldHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0
End Sub
Public Sub ResizeForm(FormName As Form) '窗体尺寸改变时自动调整空件大小及字体大小
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / FormOldWidth
ScaleY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Obj.Font.Size = FormOldFont * FormName.ScaleHeight
Next i
Next Obj
On Error GoTo 0
End Sub
''''''''''''''''''''''''''' '从数据库向ListView控件中添加数据''''''''''''''''''''''''''''''''''''
'Private Sub ShowItem()
'Dim j As Integer
'Dim itemA As ListItem
'Dim fldName As String
'Do While Not Res.EOF
'fldName = ListView_Show.ColumnHeaders(1).Text
'Set itemA = ListView_Show.ListItems.Add(, , Res.Fields(fldName))
'For j = 2 To ListView_Show.ColumnHeaders.Count
'fldName = ListView_Show.ColumnHeaders(j)
'If IsNull(Res.Fields(fldName)) Then '如果记录为NULL,则给记录赋值为NULL，然后添加记录
'itemA.ListSubItems.Add , , Res.Fields(fldName) & "NULL"
'Else
'itemA.ListSubItems.Add , , Res.Fields(fldName) '记录不为空则添加记录
'End If
'Next j
'Res.MoveNext
'Loop
'Res.Close
'End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Resize()
Call ResizeForm(Me)
'Form1.Width = Me.Width
'Form1.Height = Me.Height
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
运行结果如下图：
联系客服
