分享
 
 
 

ASP模仿asp.net的DataGrid

王朝asp·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

自动生成表格,自动完成删除,编辑、填加、分页功能,自定义样式表头样式

代码用两个类来实现

一开始考虑得太多,功能想得太强大,通用性越强,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></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 &">&nbsp;</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 & " 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 type=Text name=""" & rs.Fields(nItems(i).field).Name &"""></td>" & vbcrlf

else

'strTable = strTable & "<td " & nItems(i).HTMLstr &">&nbsp;</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

%>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有