<!--#include file="gui/element.asp"--> <!--#include file="gui/table.asp"--> <!--#include file="gui/frame.asp"--> <!--#include file="gui/form.asp"--> <% '-------------------------------------------------------------- '利用Origin属性防继承 Class TPage Private FDocType,FXmlns,FCharset,FInitHead,FIsHtml,FVisible Private FOrigin,FHead,FBody,FElements,FCurElement Private FOnBeforeEcho,FOnEcho,FOnAfterEcho Private FTitle,FResult Private sub initResponse() Response.codepage = 65001 Response.charset = FCharset End Sub Sub class_initialize FResult = "<!-- element count:{0} ; consuming time:{1}(ms) -->" FDocType = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" FXmlns = "http://www.w3.org/1999/xhtml" FCharset = "utf-8" FInitHead = False FIsHtml = True FVisible = True Call initResponse Set FElements = sys.getObj(SO_DICT) Set FOrigin = createElement("html") FOrigin.Attribute("xmlns") = FXmlns Set FHead = newElement("head",FOrigin) Call initHead Set FBody = newElement("body",FOrigin) End Sub Sub Class_Terminate Set FHead = Nothing Set FBody = Nothing Set FOrigin = Nothing Set FElements = nothing End sub '------------------------------------- Property let OnBeforeEcho(value) ' write only Set FOnBeforeEcho = GetRef(value) End Property Property let OnEcho(value) ' write only Set FOnEcho = GetRef(value) End Property Property let OnAfterEcho(value) ' write only Set FOnAfterEcho = GetRef(value) End Property Property let IsHtml(value) ' read only FIsHtml = value End Property Property Set Visible(value) 'write only FVisible = value End Property Property Let Title(value) ' write only FTitle.InnerHtml = value End Property Property Get Head ' return head Set Head = FHead End Property Property Get Body ' return body Set Body = FBody End Property Property Get Element(key) ' return element If FElements.exists(key) Then Set Element = FElements.item(key) End Property Property Get CurElement() Set CurElement = FCurElement End Property Property Get currentElement() Set currentElement = FCurElement End property '====================================================== Sub message(title,msg) Dim e : Set e = createElement("script") e.innerHtml = Join(Array("if(top.Ext){" , _ sys.format("top.msg('{0}','{1}');",Array(title,msg)) , _ "}else{" , _ Replace("alert('{0}');","{0}",msg) ,_ "}")," ") sys.print e.html End Sub Sub goback(msg) Dim alert : alert = "if(top.Ext){top.alert('{0}');}else{alert('{0}')};self.history.go(-1);" Dim js : Set js = script("") js.innerHtml = Replace(alert,"{0}",Replace(msg,"'","/'")) sys.print js.html sys.halt End Sub Sub go(href) Dim js,e js = "self.location.href=""{0}"";" Set e = script("") e.innerHtml = Replace(js,"{0}",href) sys.print e.html sys.halt End Sub Private Sub initHead() Dim meta,ico Set FTitle = newElement("title",FHead) Set meta = newElement("meta",FHead) meta.Attribute("http-equiv") = "Content-Type" meta.Attribute("content") = "text/html; charset=" & FCharset Set ico = newElement("link",FHead) ico.Attribute("rel") = "shortcut icon" ico.Attribute("href") = "favicon.ico" FInitHead = True End sub Sub echo Dim tBegin : tBegin = Now() If IsObject(FOnBeforeEcho) Then FOnBeforeEcho(me) If Not FVisible Then Exit sub If FIsHtml Then sys.print FDocType & vbCrLf If IsObject(FOnEcho) Then FOnEcho(me) If FIsHtml Then FOrigin.echo Else sys.print FBody.InnerHtml End If If IsObject(FOnAfterEcho) Then FOnAfterEcho(me) Dim tEnd : tEnd = Now() sys.print Chr(13) & sys.format(FResult,Array(Felements.count,FormatNumber((tEnd-tBegin)*1000,4))) End sub Private function getNewName(tag) getNewName = tag & FElements.count End function Sub AddElement(ByRef e) If e.name = "" Then e.name = getNewName(e.tag) If Not FElements.exists(e.Name) then FElements.add e.Name,e End If End Sub Function createElement(tag) Dim e Set e = new TElement e.Tag = tag Set e.Page = me ' Page 存储管理对象 Set FCurElement = e Set createElement = e End Function Function newElement(ByVal tag,ByRef Parent) Dim e Set e = createElement(tag) If IsObject(Parent) Then Parent.addchild e Set newElement = e End Function '--- 防继承类 '--- frame Function frame(title) Dim e : Set e = new TFrame Set e.Page = me e.title = title Set frame = e End Function Function newFrame(parent) Dim e : Set e = new TFrame Set e.Page = me If IsObject(parent) Then parent.addchild e.Origin Set newFrame = e End Function '--- table 类 Function table() Dim e : Set e = new TTable Set e.Page = me Set table = e End Function Function newTable(parent) Dim e : Set e = new TTable Set e.Page = me If IsObject(parent) Then parent.addchild e.Origin Set newTable = e End Function '---- form 类 Function form() Dim e : Set e = new TForm Set e.Page = me Set form = e End Function Function newForm(parent) Dim e : Set e = new TForm Set e.Page = me If IsObject(parent) Then parent.addchild e.Origin Set newForm = e End Function '--常见元素 Function text(str) Set text = createElement("") text.innerHtml = str End Function Function label(text) Set label = createElement("label") label.innerHtml = text End Function Function li(text) Set li = createElement("li") li.innerHtml = text End function Function script(src) Dim e : Set e = createElement("script") e.Attribute("type") = "text/javascript" If src <> "" Then e.Attribute("src") = src Set script = e End Function Function link(href) Dim e : Set e = createElement("link") e.Attribute("type") = "text/css" e.Attribute("rel") = "stylesheet" e.Attribute("href") = href Set link = e End Function Function br(parent) Set br = newElement("br",parent) End Function Function img(src) Dim e : Set e = createElement("img") e.Attribute("src") = src Set img = e End function Function a(href,text) Dim e : Set e = createElement("a") e.Attribute("href") = href If text <> "" Then e.innerHtml = text Set a = e End Function Function div(text) Dim e : Set e = createElement("div") If text <> "" Then e.innerHTML = text Set div = e End Function Function span(text) Dim e : Set e = createElement("span") If text <> "" Then e.innerHTML = text Set span = e End Function Function input(aType) Dim e Set e = createElement("input") e.Attribute("type") = aType Set input = e End Function Function optionItem(value,text) ' Option 关键字 Dim e Set e = createElement("option") e.Attribute("value") = value e.innerHTML = text Set optionItem = e End function Sub changeName(oldName,newName) If FElements.exists(oldName) Then FElements.key(oldName) = newName End If End sub End Class %>