|
最近在做一个数据库管理系统，其中要用到数据的分页显示技术，所以花点时间研究了一下，实现比较简单，代码如下：
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","ItemCode","ItemChinese",1500
ListView_Show.ColumnHeaders.Add,"ItemProtocolCode",2000
ListView_Show.ColumnHeaders.Add,"ItemEnglish","ItemPrice","OrderNo","PY","eMod","Visibled","MDeptCode","ClassTreeID","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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
运行结果如下图： （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
