自动生成表格，自动完成删除，编辑、填加、分页功能，自定义样式表头样式
代码用两个类来实现
一开始考虑得太多，功能想得太强大，通用性越强，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
类文件如下：
1Class DataGrid
2Private pages
3Private strSQLString
4Public Connstr
5Private Columns
6Private index
7Private strUniqueField,strTable
8Private rs
9Private strCellspacing,strCellpadding,strCssClass
10Private strBorderColorDark,strBorderColorLight,strBackGroundColor
11Private intBorderWidth
12Private strHeadStyle,strHeadBackgroudColor
13Private strStyle,strAlternateStyle
14Private UniqueKey,dg_action,currPage
15Private actionURL,pageURL,operationURL,formURL
16Public PagePosition,Pagesize,Pagenumber
17
18Public isAddnew
19
20Private Sub Class_Initialize()
21set Columns = Server.CreateObject("Scripting.Dictionary")
22index = 0
23Pagesize = 10
24Pagenumber = 10
25PagePosition = "updown"
26strSQLString = Session("DSN")
27uniquekey = Request("uniquekey")
28dg_action = Request("dg_action")
29currPage = Request("Page")
30actionURL = Request.ServerVariables("Script_name") & "?page=" & currPage
31if dg_action= "edit" then formURL = actionURL& "&dg_action=update&uniquekey="&uniquekey
32operationURL = Request.ServerVariables("Script_name") & "?page=" & currPage& "&uniquekey=" & uniquekey
33pageURL = Request.ServerVariables("Script_name")&"?1=1"
34if currPage = "" or isnull(currPage) then currPage = 1
35
36strBorderColorDark ="#f7f7f7"
37strBorderColorLight = "#cccccc"
38strBackgroundColor = "#f7f7f7"
39strHeadBackgroudColor = "#F2F2F2"
40intBorderWidth = 1
41strAlternateStyle ="bgcolor=#f6f6f6"
42isAddnew = 1
43Set rs = Server.CreateObject("Adodb.Recordset")
44
45End Sub
46
47Private Sub Class_Terminate()
48rs.close
49set rs = nothing
50set Columns = nothing
51End Sub
52
53Public Property Get SQLString()
54SQLString = strSQLString
55End Property
56
57Public Property Let SQLString(Value)
58strSQLString = Value
59End Property
60
61
62Public Property Let Style(Value)
63strStyle = Value()
64End Property
65
66Public Property Get Style()
67Style = strStyle
68End Property
69
70Public Property Let UniqueField(Value)
71strUniqueField = lcase(Value)
72End Property
73
74Public Property Get UniqueField()
75UniqueField = strUniqueField
76End Property
77
78Public Property Let Table(Value)
79strTable = lcase(Value)
80End Property
81
82Public Property Get Table()
83Table = strTable
84End Property
85
86Public Property Let DbConn(Value)
87strConn = Value
88End Property
89
90Public Property Get Version()
91Version = "1.0"
92End Property
93
94Public Property Let Cellspacing(Value)
95strcellspacing = Value
96End Property
97
98Public Property Get Cellspacing()
99Cellspacing = strcellspacing
100End Property
101
102Public Property Let cellpadding(Value)
103strcellpadding = Value
104End Property
105
106Public Property Get cellpadding()
107cellpadding = strCellspacing
108End Property
109
110
111Public Property Let CssClass(Value)
112strCssClass = Value
113End Property
114
115Public Property Get CssClass()
116CssClass = strCssClass
117End Property
118
119Public Property Let BorderColor(value)
120strBorderColorDark = value
121End Property
122
123Public Property Get BorderColor()
124BorderColor = strBorderColorDark
125End Property
126
127Public Property Let BackGround(value)
128strBorderColorDark = value
129strBackgroundColor = value
130End Property
131
132Public Property Get BackGround()
133BackGround = strBorderColorLight
134End Property
135
136Public Property Let BorderWidth(value)
137intBorderWidth = value
138End Property
139
140Public Property Get BorderWidth()
141BorderWidth = intBorderWidth
142End Property
143
144Public Property Get nColumns(intIndex)
145nkeys = Columns.Keys
146nItems = Columns.Items
147for i = 0 to Columns.Count - 1
148if intIndex = nkeys(i) then
149set tmp = nItems(i)
150end if
151next
152set nColumns = tmp
153End Property
154
155
156Private Function page(totalpage,pagenumber,thisPage)
157MinPage = thisPage - pagenumber/2
158if MinPage <= 0 then MinPage = 1
159'if MinPage + pagenumber/2 > totalpage then Maxpage = totalpage else Maxpage = MinPage + pagenumber
160for i = MinPage to MinPage + pagenumber -1
161if i <= totalpage then
162if cint(thisPage)<> cint(i) then
163strtemp = strtemp & "
<a &page=" & i &" href="&pageURL&">" & i & "</a>
1"
2else
3strtemp = strtemp & i&" "
4end if
5else
6page = strtemp
7Exit Function
8end if
9Next
10page = strtemp
11End Function
12
13Public Sub CreateGrid()
14nkeys = Columns.Keys
15nItems = Columns.Items
16If dg_action="update" then
17dim strsql
18strsql = "update "& table & " set "
19dim j
20j=0
21For i = 0 to index - 1
22if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
23if j <> 0 then strsql = strsql & ","
24Select case nItems(i).DataType
25Case "text"
26strsql = strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
27Case "number","int","bigint","tinyint"
28strsql = strsql & nItems(i).field & "=" & Request(nItems(i).field) & " "
29Case "date","time","datetime"
30strsql = strsql & nItems(i).field & "=convert(datetime,'" & Request(nItems(i).field)&"',102) "
31Case else
32strsql = strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
33End select
34j=j+1
35End if
36
37Next
38strsql = strsql & " where " & UniqueField &" = "& uniquekey
39set rst = Server.CreateObject("adodb.recordset")
40rst.Open strsql,connstr
41'rst.Close
42set rst = nothing
43set strsql = nothing
44End if
45
46If dg_action="delete" then
47strsql = ""
48strsql = "delete from " & table & " where " & UniqueField &" = "& uniquekey
49response.Write strsql
50set rst = Server.CreateObject("adodb.recordset")
51rst.Open strsql,connstr
52'rst.Close
53set rst = nothing
54End if
55
56IF dg_action = "addnew" and isAddnew = 1 then
57'dim strsql
58set rst = Server.CreateObject("adodb.recordset")
59rst.open table,connstr,1,3,2
60rst.addnew
61j=0
62For i = 0 to index - 1
63if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
64if j <> 0 then strsql = strsql & ","
65Select case nItems(i).DataType
66Case "text"
67rst(nItems(i).field) = Request(nItems(i).field)
68Case "number","int","bigint","tinyint"
69rst(nItems(i).field) = Request(nItems(i).field)
70Case "date","time","datetime"
71rst(nItems(i).field) = Request(nItems(i).field)
72Case else
73rst(nItems(i).field) = Request(nItems(i).field)
74End select
75j=j+1
76End if
77Next
78rst.update
79set rst = nothing
80End if
81
82
83rs.Open strSQLString,connstr,1,1
84
85strTable= "
<table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolorlight=" & strbordercolorlight & " cellspacing="0" class="&cssclass &">" '加样式
strTable = strTable & "<form action=" & formURL & " gridform""="" method="post" name="">"
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 "="" &="" &"""="" name="" rs(nitems(i).field)="" rs.fields(nitems(i).field).name="" type="Text" value=""/></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 "="" &="" &"""="" name="" rs.fields(i).name="" type="text" 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 &="" &"="" &dg_action='edit&uniquekey="' href="&actionURL&" 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 &="" &"="" &dg_action='delete&uniquekey="' href="&actionURL&" rs(uniquefield)="">"&nItems(i).DeleteCommandText&"</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 "="" &="" &dg_action='edit&uniquekey="' href=" & actionURL & " rs(uniquefield)="">" & nItems(i).EditCommandText & "</a></td>"
Case "delete"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td "="" &="" &"="" nitems(i).htmlstr=""><a &="" &"="" &dg_action='delete&uniquekey="' href=" & actionURL & " 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 "="" &="" &"""="" name="" rs.fields(nitems(i).field).name="" type="Text"/></td>"
else
'strTable = strTable & "<td "="" &="" &"="" nitems(i).htmlstr=""> </td>"
end if
next
strTable =strTable&"</tr>"
strTable = strTable & "</td></tr></tr></form></table>
1"
2If isAddnew = 1 then
3strTable = strTable & "
<form ?dg_action='addnew""' action="" dgridadd""="" method="" name="" post""=""><table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolorlight=" & 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 "="" &="" &"""="" name="" rs.fields(nitems(i).field).name="" type="Text"/></td>" & vbcrlf
else
'strTable = strTable & "<td "="" &="" &"="" nitems(i).htmlstr=""> </td>"
end if
next
strTable = strTable &"</tr></table></form>
1"
2End if
3Response.Write strTable
4
5End Sub
6
7Public Sub AddColumn(cColumn)
8'set tem = new Column
9'tem = cColumn
10'response.Write cColumn.ColumnHTMLstr
11Columns.Add index,cColumn
12index = index + 1
13'Columns.Items(i)
14End Sub
15
16End Class
17
18Class Column
19Private strType
20Private strAlign
21Private strStyle
22Private ColumnText
23Private intWidth
24Private intHight
25Private strfield
26Private strTitle
27Private strEvent
28Private strCssClass
29Private strText
30Private strEditCommandText,strUpdateCommandText,strCancelCommandText,strDeleteCommandText
31Private strRegExp
32Private strReadOnly
33Private strDataType
34Public MaxValue,MinValue,MaxLength,MinLength,IsEmpty,IsChar,IsNumber,isCharNumber,isDate,isEmail
35
36
37Private Sub Class_Initialize()
38
39ColumnType = "Text"
40strEditCommandText = "EDIT"
41strUpdateCommandText = "UPDATE"
42strCancelCommandText = "CANCEL"
43strDeleteCommandText = "DELETE"
44
45End Sub
46
47Private Sub Class_Terminate()
48
49End Sub
50
51Public Property Let Columntype(Value)
52strType = lcase(Value)
53End Property
54
55Public Property Get Columntype()
56ColumnType = strType
57End Property
58
59Public Property Let Para(Value)
60Para = Value
61End Property
62
63
64Public Property Let ParaLink(Value)
65ParaLink = Replace(Value,"{0}",Para)
66End Property
67
68Public Property Let ControlName(Value)
69ControlName = Value
70End Property
71
72Public Property Let Style(Value)
73strStyle = Value
74End Property
75
76Public Property Let Eventstr(Value)
77strEvent = Value
78End Property
79
80Public Property Let Align(Value)
81strAlign = Value
82End Property
83
84Public Property Get Align()
85Align = strAlign
86End Property
87
88Public Property Get Eventstr()
89Eventstr = strEvent
90End Property
91
92Public Property Let Width(Value)
93intWidth = Value
94End Property
95
96Public Property Let Field(Value)
97strField = lcase(Value)
98End Property
99
100Public Property Get Field()
101Field = strField
102End Property
103
104Public Property Let Title(Value)
105if value="" then strTitle = strField else strTitle = Value
106End Property
107
108Public Property Get Title()
109if strTitle="" then Title = strField else Title = strTitle
110End Property
111
112Public Property Let CssClass(Value)
113strCssClass = Value
114End Property
115
116Public Property Get CssClass()
117CssClass = strCssClass
118End Property
119
120Public Property Let DataType(Value)
121strDataType = lcase(Value)
122End Property
123
124Public Property Get DataType()
125DataType = strDataType
126End Property
127
128Public Property Let Text(Value)
129select case value
130case ""
131strText = strType
132case null
133strText = strType
134case else
135strText = Value
136end select
137End Property
138
139Public Property Get Text()
140Text = strText
141End Property
142
143Public Property Let ReadOnly(Value)
144if value="" or isnull(value) then strReadOnly = False else strReadOnly = value
145End Property
146
147Public Property Get ReadOnly()
148ReadOnly = strReadOnly
149End Property
150
151Public Property Let EditCommandText(Value)
152strEditCommandText = Value
153End Property
154
155Public Property Get EditCommandText()
156EditCommandText = strEditCommandText
157End Property
158
159
160Public Property Let UpdateCommandText(Value)
161strUpdateCommandText = Value
162End Property
163
164Public Property Get UpdateCommandText()
165UpdateCommandText = strUpdateCommandText
166End Property
167
168
169Public Property Let CancelCommandText(Value)
170strCancelCommandText = Value
171End Property
172
173Public Property Get CancelCommandText()
174CancelCommandText = strCancelCommandText
175End Property
176
177
178
179Public Property Let DeleteCommandText(Value)
180strDeleteCommandText = Value
181End Property
182
183Public Property Get DeleteCommandText()
184DeleteCommandText = strDeleteCommandText
185End Property
186
187Public Property Let RegExp(Value)
188strRegExp = Value
189End Property
190
191Public Property Get RegExp()
192RegExp = strRegExp
193End Property
194
195Public Property Get HTMLstr()
196tempstr = ""
197if intWidth <> "" then tempstr = tempstr & " width=""" & intWidth & """"
198if intHeight <> "" then tempstr = tempstr & " height =""" & intHeight & """"
199if strStyle <> "" then tempstr = tempstr & " style=""" & strStyle & """"
200if strEvent <> "" then tempstr = tempstr & " " & strEvent
201if strAlign <> "" then tempstr = tempstr & " align=""" & strAlign & """"
202HTMLstr = tempstr
203
204End Property
205End Class