% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Programming By Smartpig ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Class TBGrid public DataSource '数据源 public style '表格总风格 public HeadStyle '表头风格 public HeadItemStyle '表头单独风格 public itemStyle '单元格独立网络 public HeadSort '表头是否显示排序功能 public Columns '需要显示的列元素 public Alternate '是否交替风格 public AlternateStyle '偶数行风格 public NormalStyle '正常风格 public DefaultStyle '默认风格簇 public PageSize '页大小 public AllowPageing '是否分页 public PageingStyle '页数风格
Private Sub Class_Initialize ' 设置 Initialize 事件。 Set itemStyle = CreateObject("Scripting.Dictionary") Set HeadSort = CreateObject("Scripting.Dictionary") Set HeadItemStyle = CreateObject("Scripting.Dictionary") Set Columns = CreateObject("Scripting.Dictionary") Set Templates = CreateObject("Scripting.Dictionary") Set DataSource = CreateObject("ADODB.Recordset") Alternate = 0 PageStart = Timer End Sub
Private Sub Class_Terminate ' 设置 Terminate 事件。 Set itemStyle = Nothing Set HeadSort = Nothing Set HeadItemStyle = Nothing Set Columns = Nothing Set DataSource = Nothing End Sub
Private Sub InitTable() 'Set FieldsNum = DataSource.Fields.Count 'Set RowsNum = DataSource.RecordCount if Columns.Count = 0 then For i = 0 to DataSource.Fields.Count -1 Columns.add DataSource.Fields(i).Name,DataSource.Fields(i).Name response.Write(DataSource.Fields(i).Name) Next end if
if IsEmpty(Style) and IsEmpty(NormalStyle) then DefaultStyle = 1 Else DefaultStyle = Style end if
CurPage = CInt(Request.QueryString("page")) if CurPage = "" then CurPage = 1 End If
if PageSize = Empty then PageSize = 10 end if
select Case DefaultStyle Case 1 Style ="align=center border=0 cellpadding=4 cellspacing=1 bgcolor='#cccccc'" Alternate = 1 HeadStyle = "Height=25 style=""background-color:#006699;color:#ffffff""" AlternateStyle = "bgColor=#ffffff height=25" NormalStyle = "height=25 bgcolor=#f5f5f5" AllowPageing = true tbGrid1.PageingStyle = "bgcolor='#f5f5f5' align='right'" Case 2 Style ="align=center border=0 cellpadding=4 cellspacing=1 bgcolor='#cccccc'" Alternate = 0 HeadStyle = "Height=25 style=""background-color:#ffffff""" AlternateStyle = "bgColor=#ffffff height=25" NormalStyle = "height=25 bgcolor=#ffffff" Case Else End Select End sub
public Sub AddTemplate(ByVal ColumnName,ByVal Template) Columns.add ColumnName,ColumnName Templates.add ColumnName,Template End Sub
public Sub Show() InitTable() Dim tableStr Dim tdStart,tdEnd,tbStyle,tbContent Dim curRow Dim clm Dim regEx,Match,Matches tableStr = "table "style">" vbCrLF 'Draw Table Head Response.Write(tableStr) Response.Write("tr>") for Each clm in Columns.Keys() tbStyle = HeadStyle " " HeadItemStyle(clm) tdStart = "th "tbStyle">" tdEnd = "/th>" vbCrLf
Response.Write(tdStart) '加入表头排序功能 'Code by Redsun 'Date:2005-1-17 If HeadSort(clm) Then Response.Write Sort(clm,Columns(clm)) Else Response.Write(Columns(clm)) End If Response.Write(tdEnd) Next Response.Write("/tr>" vbCrLF)
'Draw Table items curRow = 1 if AllowPageing > Empty then DataSource.PageSize = PageSize else DataSource.PageSize = DataSource.RecordCount end if
if CurPage 1 then DataSource.AbsolutePage = 1 end if
if CurPage >= DataSource.PageCount then DataSource.AbsolutePage = DataSource.PageCount end if
if CurPage >= 1 and CurPage = DataSource.PageCount then DataSource.AbsolutePage = CurPage end if
for curRow = 1 to DataSource.PageSize if DataSource.EOF then Exit For end if
Response.Write("tr>") for Each clm in Columns.Keys() if Alternate = 0 then tbStyle = NormalStyle " " ItemStyle(clm) else if curRow mod 2 = 0 then tbStyle = AlternateStyle " " ItemStyle(clm) else tbStyle = NormalStyle " " ItemStyle(clm) end if end if
tdStart = "td "tbStyle">" tdEnd = "/td>" vbCrLf
if Templates(clm) = Empty then tbContent = DataSource(clm) else tbContent = Templates(clm) Set regEx = New RegExp regEx.Pattern= "{[A-Za-z0-9_-]+}" regEx.IgnoreCase = True regEx.Global = True Set Matches=regEx.Execute(Templates(clm)) For each match in matches On Error Resume Next tbContent = Replace(tbContent,Match.Value,DataSource(Mid(Match.Value,2,Len(Match.Value)-2)),1) Next
end if
Response.Write(tdStart) Response.Write(tbContent) Response.Write(tdEnd) Next Response.Write("/tr>" vbCrLF)
DataSource.MoveNext Next
'Draw Pageing Row if DataSource.PageCount > 1 and LCase(pageingStyle) > "none" then Dim i,EndPage,StartPage response.write("tr>") response.write("td colspan=" Columns.Count " " PageingStyle ">") '改进分页功能 'Code by Redsun 'Date:2005-1-17 If CurPage>4 Then If CurPage+2DataSource.PageCount Then StartPage = CurPage-2 EndPage = CurPage+2 Else StartPage = DataSource.PageCount-4 EndPage = DataSource.PageCount End If Else StartPage = 1 If DataSource.PageCount>5 Then EndPage = 5 Else EndPage = DataSource.PageCount End If End If If CurPage>1 Then Response.Write "a title='首页' href='"GetUrl("page")"page=1'>font face=webdings>9/font>/a> " Response.Write "a title='上页' href='"GetUrl("page")"page="CurPage-1"'>font face=webdings>3/font>/a> " Else Response.Write "font face=webdings>9/font> " Response.Write "font face=webdings>3/font> " End If For i=StartPage to EndPage if i > CurPage then response.write("a title='第"i"页' href='"GetUrl("page")"page="i"'>"i"/a> ") Else response.write("b>"i"/b> ") End if next If CurPageDataSource.PageCount Then Response.Write "a title='下页' href='"GetUrl("page")"page="CurPage+1"'>font face=webdings>4/font>/a> " Response.Write "a title='尾页' href='"GetUrl("page")"page="DataSource.PageCount"'>font face=webdings>:/font>/a> " Else Response.Write "font face=webdings>4/font> " Response.Write "font face=webdings>:/font> " End If Response.Write " nbsp;nbsp;[共"DataSource.RecordCount"条] ["PageSize"条/页] [共"DataSource.PageCount"页]" Response.Write " PageExecute："Round((Timer-PageStart)*1000,2)" MS" response.write("/td>/tr>" vbCrLf) End if 'Draw Table end Response.Write("/table>") End sub
'==================================================================== '获取当前Url参数的函数 'Codeing by Redsun '==================================================================== Private Function GetUrl(RemoveList) Dim ScriptAddress, M_ItemUrl, M_item ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))"?"'取得当前地址 M_ItemUrl = "" For Each M_item In Request.QueryString If InStr(RemoveList,M_Item)=0 Then M_ItemUrl = M_ItemUrl M_Item "=" Server.URLEncode(Request.QueryString(""M_Item"")) "" End If Next GetUrl = ScriptAddress M_ItemUrl End Function
'============================= '实现列表排序 '返回Url参数并动态改变排序方式 '参数：需要进行排序的字段名,显示的名称 '============================= Private Function Sort(SortStr,DispName) If SortStr = "" Or DispName="" Then Exit Function Sort = GetUrl("SOrder,SSort") SSort = UCase(Request.QueryString("SSort")) If SSort = "DESC" Then SSort = "ASC" Else SSort = "DESC" End If Sort = "a class='headhref' href='"Sort"SOrder="SortStr"SSort="SSort"'>"DispNameSortType(SortStr)"/a>" End Function
'----------------------------------------------- '标识排序列为升序还是降序方式 '参数：排序列字段名称 '----------------------------------------------- Private Function SortType(FieldName) Dim SOrderName SOrderName = Request.QueryString("SOrder") If SOrderName>FieldName Then Exit Function Dim SSortImg SSortImg = Request.QueryString("SSort") SortType = "img src='/OrderFormSystem/images/"SSortImg".gif' border='0'>" End Function
End Class
'users Like { UserID,LoginName,Password,RealName,Age,Gender,} 'initDB Rs.Open "Select * from users",Cn Dim tbGrid1 Set tbGrid1 = New TBGrid Set tbGrid1.DataSource = Rs tbGrid1.Columns.add "LoginName","用户名" tbGrid1.HeadSort.add "LoginName",True tbGrid1.Columns.add "Password","密码" tbGrid1.AddTemplate "修改","a href='aaa.asp?id={UserID}'>font color=red>{RealName}/font>/a>" tbGrid1.ItemStyle.add "Password","align=right" tbGrid1.ItemStyle.add "修改","width=100" tbGrid1.PageSize = 5 tbGrid1.AllowPageing = true tbGrid1.PageingStyle = "align=right" tbGrid1.Show() 'CloseDB %>
