% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 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 %>
