自動產生表格，自動完成刪除，編輯、填加、分頁功能，自訂樣式表頭樣式程式
碼用兩個類別來實現
一開始考慮得太多，功能想得太強大，通用性越強，asp類跑起來越慢，做到後來沒興趣，還有很多功能沒有完成，如字段類型驗證，顯示圖片、控件等，帖出代碼供大這一起學習研究，有興趣的可以將這些功能加上
示例：
set a = new DataGrid
'a.Connstr="Provider=SQLOLEDB.1;User ID=sa;Password=servser;Initial Catalog=temp_blue;Data Source=server;Connect Timeout=30;Auto Translate=True;Packet Size=4096;"
a.Connstr="Provider=Microsoft.Jet.OLEDB.4.0;"&" Data Source="&server.mappath("test.mdb") '連接ACCSS字串
a.SQLString="select * from table1" '產生datagrid所顯示的記錄集的sql語句
a.isAddnew = 1 '是否可以填寫新記錄
a.Table = "table1" 'datagrid控制的主表
a.UniqueField = "ID" '標誌字段，所有記錄不重複整型即可
a.PagePosition = "down" '分頁顯示位置，up上面，down下面updown上下,其它為不顯示
a.pagesize = 5 '每頁顯示記錄數
a.Pagenumber = 10 '顯示頁數
a.BorderColor="#ff0000" '預設效果圖顯示
a.BackGround="#00ff00" '預設為效果圖顯示
a.BorderWidth=1 預設為1
a.
set b1 = new column
b1.Field = "id" '此列所綁定的資料庫字段
b1.Title = "標誌" '標題
b1.Align = "center" ' 對齊方式
a.AddColumn(b1) '把此欄位插入datagrid
set b2 = new column
b2.Field="firstname"
b2.Title="姓"
a.AddColumn(b2)
set b3 = new column
b3.Field = "lastname"
b3.Title = "名"
a.AddColumn(b3)
set b4 = new column
b4.Field = "logintimes"
b4.Title = "登陸次數"
b4.ReadOnly = true '設為唯讀，不會出現在編輯框中和新增記錄中
a.AddColumn(b4)
set b5 = new column
b5.Title="編輯"
b5.Columntype ="edit" '編輯列
b5.EditCommandText = "編輯" '編輯按鈕文字
a.AddColumn(b5)
set b6 = new column
b6.align = "center"
b6.Width = 200
b6.Columntype = "delete"
b6.DeleteCommandText = "刪除按鈕"
b6.Title ="刪除"
a.AddColumn(b6)
a.CreateGrid()
set b1 = nothing
set b2 = nothing
set b3 = nothing
set b4 = nothing
set b5 = nothing
set b6 = nothing
類別檔案如下：
<%Class DataGrid
Private pages
Private strSQLString
Public Connstr
Private Columns
Private index
Private strUniqueField,strTable
Private rs
Private strCellspacing,strCellpadding,strCssClass
Private strBorderColorDark,strBorderColorLight,strBackGroundColor
Private intBorderWidth
Private strHeadStyle,strHeadBackgroudColor
Private strStyle,strAlternateStyle
Private UniqueKey,dg_action,currPage
Private actionURL,pageURL,operationURL,formURL
Public PagePosition,Pagesize,Pagenumber
Public isAddnew
Private Sub Class_Initialize()
set Columns = Server.CreateObject("Scripting.Dictionary")
index = 0
Pagesize = 10
Pagenumber = 10
PagePosition = "updown"
strSQLString = Session("DSN")
uniquekey = Request("uniquekey")
dg_action = Request("dg_action")
currPage = Request("Page")
actionURL = Request.ServerVariables("Script_name") & "?page=" & currPage
if dg_action= "edit" then formURL = actionURL& "&dg_action=update&uniquekey="&uniquekey
operationURL = Request.ServerVariables("Script_name") & "?page=" & currPage& "&uniquekey=" & uniquekey
pageURL = Request.ServerVariables("Script_name")&"?1=1"
if currPage = "" or isnull(currPage) then currPage = 1
strBorderColorDark ="#f7f7f7"
strBorderColorLight = "#cccccc"
strBackgroundColor = "#f7f7f7"
strHeadBackgroudColor = "#F2F2F2"
intBorderWidth = 1
strAlternateStyle ="bgcolor=#f6f6f6"
isAddnew = 1
Set rs = Server.CreateObject("Adodb.Recordset")
End Sub
Private Sub Class_Terminate()
rs.close
set rs = nothing
set Columns = nothing
End Sub
Public Property Get SQLString()
SQLString = strSQLString
End Property
Public Property Let SQLString(Value)
strSQLString = Value
End Property
Public Property Let Style(Value)
strStyle = Value()
End Property
Public Property Get Style()
Style = strStyle
End Property
Public Property Let UniqueField(Value)
strUniqueField = lcase(Value)
End Property
Public Property Get UniqueField()
UniqueField = strUniqueField
End Property
Public Property Let Table(Value)
strTable = lcase(Value)
End Property
Public Property Get Table()
Table = strTable
End Property
Public Property Let DbConn(Value)
strConn = Value
End Property
Public Property Get Version()
Version = "1.0"
End Property
Public Property Let Cellspacing(Value)
strcellspacing = Value
End Property
Public Property Get Cellspacing()
Cellspacing = strcellspacing
End Property
Public Property Let cellpadding(Value)
strcellpadding = Value
End Property
Public Property Get cellpadding()
cellpadding = strCellspacing
End Property
Public Property Let CssClass(Value)
strCssClass = Value
End Property
Public Property Get CssClass()
CssClass = strCssClass
End Property
Public Property Let BorderColor(value)
strBorderColorDark = value
End Property
Public Property Get BorderColor()
BorderColor = strBorderColorDark
End Property
Public Property Let BackGround(value)
strBorderColorDark = value
strBackgroundColor = value
End Property
Public Property Get BackGround()
BackGround = strBorderColorLight
End Property
Public Property Let BorderWidth(value)
intBorderWidth = value
End Property
Public Property Get BorderWidth()
BorderWidth = intBorderWidth
End Property
Public Property Get nColumns(intIndex)
nkeys = Columns.Keys
nItems = Columns.Items
for i = 0 to Columns.Count - 1
if intIndex = nkeys(i) then
set tmp = nItems(i)
end if
next
set nColumns = tmp
End Property
Private Function page(totalpage,pagenumber,thisPage)
MinPage = thisPage - pagenumber/2
if MinPage <= 0 then MinPage = 1
'if MinPage + pagenumber/2 > totalpage then Maxpage = totalpage else Maxpage = MinPage + pagenumber
for i = MinPage to MinPage + pagenumber -1
if i <= totalpage then
if cint(thisPage)<> cint(i) then
strtemp = strtemp & "<a href="&pageURL&"&page=" & i &">" & i & "</a> "
else
strtemp = strtemp & i&" "
end if
else
page = strtemp
Exit Function
end if
Next
page = strtemp
End Function
Public Sub CreateGrid()
nkeys = Columns.Keys
nItems = Columns.Items
If dg_action="update" then
dim strsql
strsql = "update "& table & " set "
dim j
j=0
For i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
if j <> 0 then strsql = strsql & ","
Select case nItems(i).DataType
Case "text"
strsql = strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
Case "number","int","bigint","tinyint"
strsql = strsql & nItems(i).field & "=" & Request(nItems(i).field) & " "
Case "date","time","datetime"
strsql = strsql & nItems(i).field & "=convert(datetime,'" & Request(nItems(i).field)&"',102) "
Case else
strsql = strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
End select
j=j+1
End if
Next
strsql = strsql & " where " & UniqueField &" = "& uniquekey
set rst = Server.CreateObject("adodb.recordset")
rst.Open strsql,connstr
'rst.Close
set rst = nothing
set strsql = nothing
End if
If dg_action="delete" then
strsql = ""
strsql = "delete from " & table & " where " & UniqueField &" = "& uniquekey
response.Write strsql
set rst = Server.CreateObject("adodb.recordset")
rst.Open strsql,connstr
'rst.Close
set rst = nothing
End if
IF dg_action = "addnew" and isAddnew = 1 then
'dim strsql
set rst = Server.CreateObject("adodb.recordset")
rst.open table,connstr,1,3,2
rst.addnew
j=0
For i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
if j <> 0 then strsql = strsql & ","
Select case nItems(i).DataType
Case "text"
rst(nItems(i).field) = Request(nItems(i).field)
Case "number","int","bigint","tinyint"
rst(nItems(i).field) = Request(nItems(i).field)
Case "date","time","datetime"
rst(nItems(i).field) = Request(nItems(i).field)
Case else
rst(nItems(i).field) = Request(nItems(i).field)
End select
j=j+1
End if
Next
rst.update
set rst = nothing
End if
rs.Open strSQLString,connstr,1,1
strTable= "<table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolorlight=" & strbordercolorlight & "class=" &cssclass & " cellspacing=0>" '加樣式
strTable = strTable & "<form action=" & formURL & " name=""gridform"" method=post>"
if PagePosition="up" or PagePosition="updown" then strTable = strTable & "<tr><td colspan="& index &">"& page(rs.PageCount,Pagenumber,currPage )&"</td>< /tr>"
strTable = strTable & "<tr bgcolor=" & strHeadBackgroudColor & ">"
for i = 0 to index - 1
if nItems(i).Title<>"" then
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & nItems(i).Title &"</td>"
else
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs.Fields(i).Item.Name &"</td>"
end if
Next
strTable = strTable & "</tr>"
if cint(currPage) > cint(rs.PageCount) then currPage = rs.PageCount
intPage = Pagesize
rs.PageSize = pagesize
rs.AbsolutePage = currPage
do while not rs.eof and intPage > 0
intPage = intPage - 1
dbuniquekey = rs(uniquefield)
If intPage mod 2 then
strTable = strTable & "<tr>"
Else
strTable = strTable & "<tr "& strAlternateStyle &">"
End if
'response.Write len(dg_action)>0 and int(dbuniquekey) = int(uniquekey)
if dg_action ="edit" and int(dbuniquekey) = int(uniquekey) then
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &""" value="" " & rs(nItems(i).field) &"""></td>"
else
Select case lcase(nItems(i).Columntype)
Case "label"
strTable = strTable & "<td "& nItems(i).HTMLstr &">" & rs(nItems(i).field) &"</td>"
Case "radio"
Case "image"
Case "checkbox"
Case "textbox"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=text name=""" & rs.Fields(i).Name &""" value=" & rs(nItems(i ).field) &"></td>"
Case "link"
Case "edit"
if UniqueField="" then ErrorMsg="UniqueField not set"
if dg_action = "edit" then
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href=""JavaScript:document.gridform.submit()"">"&nItems(i).UpdateCommandText&"</a> <a href ="&actionURL&">"&nItems(i).CancelCommandText&"</a></td>"
else
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href="&actionURL&"&dg_action=edit&uniquekey=" & rs(UniqueField) &">"&nItems(i).EditCommandText&"</a>< /td>"
end if
Case "delete"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href="&actionURL&"&dg_action=delete&uniquekey=" & rs(UniqueField) &">"&nItems(i).DeleteCommandText&"</a><Text&"</a><Text&"</a>< /td>"
Case "update"
Case else
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs(nItems(i).field) & "</td>"
End select
end if
Next
else
for i = 0 to index - 1
select case lcase(nItems(i).Columntype)
Case "label"
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs(nItems(i).field) &"</td>"
Case "radio"
Case "image"
Case "checkbox"
Case "textbox"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=text value=" & rs(nItems(i).field) &"></td>"
Case "link"
Case "edit"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td " & nItems(i).HTMLstr & "><a href=" & actionURL & "&dg_action=edit&uniquekey=" & rs(UniqueField) & ">" & nItems(i).EditCommandText & " </a></td>"
Case "delete"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><a href=" & actionURL & "&dg_action=delete&uniquekey=" & rs(UniqueField) &">" & nItems(i).DeleteCommandText&"< /a></td>"
Case "update"
Case else
strTable = strTable & "<td " & nItems(i).HTMLstr &">" & rs(nItems(i).Field) & "</td>"
End select
Next
End if
'End if
rs.movenext
strTable = strTable & "</tr>"& vbcrlf
loop
if PagePosition="down" or PagePosition="updown" then strTable = strTable & "<tr><td colspan="& index &">"& page(rs.PageCount,Pagenumber,currPage )
'strTable =strTable&"<tr>"
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
'strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &"""></ td>"
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &"> </td>"
end if
next
strTable =strTable&"</tr>"
strTable = strTable & "</form></table>"
If isAddnew = 1 then
strTable = strTable & "<form action=""?dg_action=addnew"" name=""dgridadd"" method=""post""><table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolor= " & strbordercolorlight & " cellspacing=0><tr>"
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &">" & rs.Fields(nItems(i).field).Name &"</td>"
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &">"&nItems(i).Title&"</td>"
end if
next
strTable = strTable & "<td rowspan=2><a href=""JavaScript:document.dgridadd.submit()"">New</a></td></tr><tr>"
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &"""></td >" & vbcrlf
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &"> </td>"
end if
next
strTable = strTable &"</tr></table></form>"
End if
Response.Write strTable
End Sub
Public Sub AddColumn(cColumn)
'set tem = new Column
'tem = cColumn
'response.Write cColumn.ColumnHTMLstr
Columns.Add index,cColumn
index = index + 1
'Columns.Items(i)
End Sub
End Class
Class Column
Private strType
Private strAlign
Private strStyle
Private ColumnText
Private intWidth
Private intHight
Private strfield
Private strTitle
Private strEvent
Private strCssClass
Private strText
Private strEditCommandText,strUpdateCommandText,strCancelCommandText,strDeleteCommandText
Private strRegExp
Private strReadOnly
Private strDataType
Public MaxValue,MinValue,MaxLength,MinLength,IsEmpty,IsChar,IsNumber,isCharNumber,isDate,isEmail
Private Sub Class_Initialize()
ColumnType = "Text"
strEditCommandText = "EDIT"
strUpdateCommandText = "UPDATE"
strCancelCommandText = "CANCEL"
strDeleteCommandText = "DELETE"
End Sub
Private Sub Class_Terminate()
End Sub
Public Property Let Columntype(Value)
strType = lcase(Value)
End Property
Public Property Get Columntype()
ColumnType = strType
End Property
Public Property Let Para(Value)
Para = Value
End Property
Public Property Let ParaLink(Value)
ParaLink = Replace(Value,"{0}",Para)
End Property
Public Property Let ControlName(Value)
ControlName = Value
End Property
Public Property Let Style(Value)
strStyle = Value
End Property
Public Property Let Eventstr(Value)
strEvent = Value
End Property
Public Property Let Align(Value)
strAlign = Value
End Property
Public Property Get Align()
Align = strAlign
End Property
Public Property Get Eventstr()
Eventstr = strEvent
End Property
Public Property Let Width(Value)
intWidth = Value
End Property
Public Property Let Field(Value)
strField = lcase(Value)
End Property
Public Property Get Field()
Field = strField
End Property
Public Property Let Title(Value)
if value="" then strTitle = strField else strTitle = Value
End Property
Public Property Get Title()
if strTitle="" then Title = strField else Title = strTitle
End Property
Public Property Let CssClass(Value)
strCssClass = Value
End Property
Public Property Get CssClass()
CssClass = strCssClass
End Property
Public Property Let DataType(Value)
strDataType = lcase(Value)
End Property
Public Property Get DataType()
DataType = strDataType
End Property
Public Property Let Text(Value)
select case value
case ""
strText = strType
case null
strText = strType
case else
strText = Value
end select
End Property
Public Property Get Text()
Text = strText
End Property
Public Property Let ReadOnly(Value)
if value="" or isnull(value) then strReadOnly = False else strReadOnly = value
End Property
Public Property Get ReadOnly()
ReadOnly = strReadOnly
End Property
Public Property Let EditCommandText(Value)
strEditCommandText = Value
End Property
Public Property Get EditCommandText()
EditCommandText = strEditCommandText
End Property
Public Property Let UpdateCommandText(Value)
strUpdateCommandText = Value
End Property
Public Property Get UpdateCommandText()
UpdateCommandText = strUpdateCommandText
End Property
Public Property Let CancelCommandText(Value)
strCancelCommandText = Value
End Property
Public Property Get CancelCommandText()
CancelCommandText = strCancelCommandText
End Property
Public Property Let DeleteCommandText(Value)
strDeleteCommandText = Value
End Property
Public Property Get DeleteCommandText()
DeleteCommandText = strDeleteCommandText
End Property
Public Property Let RegExp(Value)
strRegExp = Value
End Property
Public Property Get RegExp()
RegExp = strRegExp
End Property
Public Property Get HTMLstr()
tempstr = ""
if intWidth <> "" then tempstr = tempstr & " width=""" & intWidth & """"
if intHeight <> "" then tempstr = tempstr & " height =""" & intHeight & """"
if strStyle <> "" then tempstr = tempstr & " style=""" & strStyle & """"
if strEvent <> "" then tempstr = tempstr & " " & strEvent
if strAlign <> "" then tempstr = tempstr & " align=""" & strAlign & """"
HTMLstr = tempstr
End Property
End Class
%>