GUI->TForm 类

 <textarea cols="50" rows="15" name="code" class="vb"><%
' TForm 类
' 不保证独立调用可靠性

Class TForm
Private FOrigin,FPage,FTable,FRow '由table控制
Private FInnerHtml,FAction,FSingleRow

Sub Class_initialize
' 转至Page属性设置时初始化
FSingleRow = false
End Sub

Property Set Page(value)
Set FPage = value
Set FOrigin = FPage.createElement("form")
Set FOrigin.Owner = me
Set FTable = FPage.table
FOrigin.attribute("class") = "form"
FOrigin.addchild FTable.Origin
End Property

Property Let SingleRow(value)
If Not FSingleRow Then
Dim tr
Set tr = FTable.tr(false)
FTable.tbody.addchild tr
Set FRow = FTable.td("")
tr.addchild FRow
FsingleRow = value
End if
End property

Property Get Origin()
Set Origin = FOrigin
End property

Sub AddField(label,ByRef field)
Dim tr,td
If FSingleRow Then
FRow.addchild Fpage.span(label)
FRow.addchild field
Else
Set tr = FTable.tr(true)
tr.addchild FTable.th(label)
Set td = FTable.td("")
tr.addchild td
td.addChild field
End if
End sub

Function field(t,name,value)
Dim e
Set e = FPage.createElement("input")
with e
.Attribute("type") = t
If name <> "" Then .Attribute("name") = name
If value <> "" Then .Attribute("value") = value
End with
Set field = e
End Function

Function textArea(name,value)
Dim e
Set e = FPage.createElement("textarea")
with e
.Attribute("name") = name
.innerHTML = value
End with
Set textArea = e
End Function

Function textField(name,value)
Set textField = field("text",name,value)
textField.attribute("onfocus") = "this.select()"
End Function

Function passwordField(name,value)
Set passwordField = field("password",name,value)
End Function

Function checkField(name,value,checked,label)
Dim e
Set e = field("checkbox",name,value)
If checked Then e.Attribute("checked") = "checked"
If label <> "" Then
e.Attribute("id") = name
Dim sp : Set sp = FPage.createElement("span")
sp.addchild e
Dim lb : Set lb = FPage.createElement("label")
lb.Attribute("for") = name
lb.innerHtml = label
sp.addchild lb
Set e = sp
End if
Set checkField = e
End Function

Function dateField(name,value)
Set dateField = field("text",name,value)
dateField.Attribute("maxlength") = "10"
dateField.Attribute("class") = "calendar"
dateField.Attribute("onclick") = "calendar.show(this)"
End Function

Sub AddOptions(field,value,rs)
Dim o
rs.movefirst
While Not rs.eof
Set o = FPage.optionItem(rs(0).value,rs(1).value)
If sys.tostr(value) = sys.tostr(rs(0).value) Then o.Attribute("selected") = "selected"
field.addchild o
rs.movenext
wend
End sub

Function selectField(ByVal name,ByRef firstOption)
Dim e
Set e = FPage.createElement("select")
e.Attribute("name") = name
If IsObject(firstOption) Then e.addchild firstOption
Set selectField = e
End Function

Function hiddenField(name,value)
Set hiddenField = field("hidden",name,value)
End Function

Function submitButton(name,value)
Set submitButton = field("submit",name,value)
submitButton.Attribute("class") = "button"
End Function

Function resetButton(name,value)
Set resetButton = field("reset",name,value)
resetButton.Attribute("class") = "button"
End Function
End Class
%></textarea>