<% 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 & "
" '------------------- ' scrolling columns '------------------- ' upper right response.write vbLf & "" 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 & "
" response.write vbLf & "" for r=0 to LastHeadingRow response.write vbLf & "" response.write rows(r).HeadingRow(FrozenCols,colcnt-1) response.write vbLf & "" next response.write vbLf & "
" response.write vbLf & "
" ' lower right response.write vbLf & "
" response.write vbLf & "" response.write vbLf & "" RenderColumns FrozenCols,colcnt-1 response.write vbLf & "" response.write vbLf & "
" response.write vbLf & "
" End Sub end class %>