%
class SimpleGridCell
public content
private attr
Private Sub Class_Initialize
set attr = CreateObject("Scripting.Dictionary")
End sub
Private Sub Class_Terminate
set attr = Nothing
End sub
Public Function HeadingCell()
Dim s, span
s="
" & DataCell("") & " | ", span)
End Function
Public Function DataCell(rowclass)
dim s,k
s = ""colspan" Then s=s & " " & k & "='" & attr(k) & "'"
next
s=s & ">" & content & "
"
DataCell=s
End Function
Public Function HtmlCell()
dim s,k
s = "" & content & " | "
HtmlCell=s
End Function
Public Sub SetAttr(name,value)
attr(name)=value
End Sub
End class
class SimpleGridRow
public cells()
private attr, CurrentCell
Private Sub Class_Initialize
redim cells(-1)
set attr = CreateObject("Scripting.Dictionary")
end sub
Private Sub Class_Terminate
set attr = Nothing
end sub
Public Sub AddCell(ByVal content)
ReDim Preserve cells(ubound(cells)+1)
set CurrentCell=new SimpleGridCell
set cells(ubound(cells))=CurrentCell
CurrentCell.content=content
End Sub
Public Function HeadingRow(ByVal c1, ByVal c2)
dim cellidx,colidx,s,a
cellidx=0
colidx=0
while colidx < c1 and cellidx <= ubound(cells)
a=cells(cellidx).HeadingCell()
colidx=colidx+CInt(a(1))
cellidx=cellidx+1
Wend
while (colidx <= c2) and cellidx <= ubound(cells)
a=cells(cellidx).HeadingCell()
s=s & a(0)
colidx=colidx+CInt(a(1))
cellidx=cellidx+1
wend
HeadingRow = s
End Function
Public Function HeadingClass()
HeadingClass=trim("ricoLG_hdg " & attr("class"))
End Function
Public Function CellCount()
CellCount=ubound(cells)+1
End Function
Public Function GetRowAttr(ByVal name)
GetRowAttr=attr(name)
End Function
Public Sub SetRowAttr(ByVal name, ByVal value)
attr(name)=value
End Sub
Public Sub SetCellAttr(ByVal name, ByVal value)
CurrentCell.SetAttr name,value
End Sub
end class
class SimpleGrid
public rows()
private LastRow,LastHeadingRow,ResizeRowIdx
Private Sub Class_Initialize
redim rows(-1)
End sub
Public Function AddHeadingRow(ResizeRowFlag)
LastHeadingRow=AddDataRow
if ResizeRowFlag then ResizeRowIdx=LastHeadingRow
AddHeadingRow=LastHeadingRow
End Function
Public Function AddDataRow()
ReDim Preserve rows(ubound(rows)+1)
set rows(ubound(rows))=new SimpleGridRow
LastRow=ubound(rows)
AddDataRow=LastRow
End Function
Public Function HeadingRowCount()
if IsEmpty(LastHeadingRow) then
HeadingRowCount=0
else
HeadingRowCount=LastHeadingRow+1
end if
End Function
Public Function DataRowCount()
if IsEmpty(LastRow) then
DataRowCount=0
else
DataRowCount=LastRow+1-HeadingRowCount()
end if
End Function
' returns # of cells in the current row
Public Function CellCount()
CellCount=rows(LastRow).CellCount
End Function
Public Sub AddCell(ByVal content)
rows(LastRow).AddCell content
End Sub
Public Sub AddCellToRow(ByVal RowIdx, ByVal content)
LastRow=RowIdx
AddCell content
End Sub
Public Sub SetRowAttr(ByVal name, ByVal value)
rows(LastRow).SetRowAttr name,value
End Sub
Public Sub SetCellAttr(ByVal name, ByVal value)
rows(LastRow).SetCellAttr name,value
End Sub
Private Function RenderColumns(ByVal c1, ByVal c2)
dim r,c
for c=c1 to c2
response.write vbLf & ""
for r=LastHeadingRow+1 to ubound(rows)
response.write rows(r).cells(c).DataCell(rows(r).GetRowAttr("class"))
next
response.write " | "
next
End Function
' Response.Buffer must be true
Public Sub RenderExcel(fileName)
dim r,c
Response.Clear
if fileName<>"" then Response.AddHeader "content-disposition", "attachment; filename=" & fileName
'Response.ContentType = "application/vnd.ms-excel"
Response.ContentType = "application/ms-excel"
response.write vbLf & ""
for r=0 to ubound(rows)
response.write vbLf & ""
for c=0 to ubound(rows(r).cells)
response.write rows(r).cells(c).HtmlCell
next
response.write vbLf & "
"
next
response.write vbLf & "
"
Response.End
End Sub
' Response.Buffer must be true
Public Sub RenderDelimited(fileName,delim,SubstituteChar)
dim r,c
Response.Clear
if fileName<>"" then Response.AddHeader "content-disposition", "attachment; filename=" & fileName
Response.ContentType = "text/csv"
for r=0 to ubound(rows)
for c=0 to ubound(rows(r).cells)
if c > 0 then response.write delim
response.write replace(rows(r).cells(c).content,delim,SubstituteChar)
next
response.write vbLf
next
Response.End
End Sub
Public Sub Render(ByVal id, FrozenCols)
dim colcnt,r,c
if IsEmpty(ResizeRowIdx) then exit sub
colcnt=rows(ResizeRowIdx).CellCount
response.write vbLf & ""
'-------------------
' frozen columns
'-------------------
' upper left
response.write vbLf & ""
for r=0 to LastHeadingRow
response.write vbLf & ""
response.write rows(r).HeadingRow(0,FrozenCols-1)
response.write vbLf & " "
next
response.write vbLf & " "
' lower left
response.write vbLf & ""
response.write " "
response.write vbLf & ""
RenderColumns 0,FrozenCols-1
response.write vbLf & " "
response.write vbLf & " "
response.write vbLf & " | "
'-------------------
' scrolling columns
'-------------------
' upper right
response.write vbLf & ""
response.write vbLf & " "
response.write vbLf & " "
' lower right
response.write vbLf & " |
|
"
response.write vbLf & "
"
End Sub
end class
%>