git.infodrom.org Git - infodrom/rico3/blob - plugins/asp/SimpleGrid.vbs

   1 <%\r
   2 \r
   3 class SimpleGridCell\r
   4   public content\r
   5   private attr\r
   6 \r
   7   Private Sub Class_Initialize\r
   8     set attr = CreateObject("Scripting.Dictionary")\r
   9   End sub\r
  10 \r
  11   Private Sub Class_Terminate\r
  12     set attr = Nothing\r
  13   End sub\r
  14 \r
  15   Public Function HeadingCell()\r
  16     Dim s, span\r
  17     s="<td"\r
  18     span=1\r
  19     If attr.exists("colspan") Then\r
  20       span=attr("colspan")\r
  21       s=s & " colspan='" & span & "'"\r
  22     End If\r
  23     HeadingCell = Array(s & "><div class='ricoLG_col'>" & DataCell("") & "</div></td>", span)\r
  24   End Function\r
  25 \r
  26   Public Function DataCell(rowclass)\r
  27     dim s,k\r
  28     s = "<div"\r
  29     attr("class")=trim("ricoLG_cell " & attr("class") & " " & rowclass)\r
  30     for each k in attr.keys\r
  31       If k<>"colspan" Then s=s & " " & k & "='" & attr(k) & "'"\r
  32     next\r
  33     s=s & ">" & content & "</div>"\r
  34     DataCell=s\r
  35   End Function\r
  36 \r
  37   Public Function HtmlCell()\r
  38     dim s,k\r
  39     s = "<td"\r
  40     for each k in attr.keys\r
  41       s=s & " " & k & "='" & attr(k) & "'"\r
  42     next\r
  43     s=s & ">" & content & "</td>"\r
  44     HtmlCell=s\r
  45   End Function\r
  46 \r
  47   Public Sub SetAttr(name,value)\r
  48     attr(name)=value\r
  49   End Sub\r
  50 End class\r
  51 \r
  52 \r
  53 class SimpleGridRow\r
  54   public cells()\r
  55   private attr, CurrentCell\r
  56 \r
  57   Private Sub Class_Initialize\r
  58     redim cells(-1)\r
  59     set attr = CreateObject("Scripting.Dictionary")\r
  60   end sub\r
  61 \r
  62   Private Sub Class_Terminate\r
  63     set attr = Nothing\r
  64   end sub\r
  65   \r
  66   Public Sub AddCell(ByVal content)\r
  67     ReDim Preserve cells(ubound(cells)+1)\r
  68     set CurrentCell=new SimpleGridCell\r
  69     set cells(ubound(cells))=CurrentCell\r
  70     CurrentCell.content=content\r
  71   End Sub\r
  72   \r
  73   Public Function HeadingRow(ByVal c1, ByVal c2)\r
  74     dim cellidx,colidx,s,a\r
  75     cellidx=0\r
  76     colidx=0\r
  77     while colidx < c1 and cellidx <= ubound(cells)\r
  78       a=cells(cellidx).HeadingCell()\r
  79       colidx=colidx+CInt(a(1))\r
  80       cellidx=cellidx+1\r
  81     Wend\r
  82     while (colidx <= c2) and cellidx <= ubound(cells)\r
  83       a=cells(cellidx).HeadingCell()\r
  84       s=s & a(0)\r
  85       colidx=colidx+CInt(a(1))\r
  86       cellidx=cellidx+1\r
  87     wend\r
  88     HeadingRow = s\r
  89   End Function\r
  90   \r
  91   Public Function HeadingClass()\r
  92     HeadingClass=trim("ricoLG_hdg " & attr("class"))\r
  93   End Function\r
  94   \r
  95   Public Function CellCount()\r
  96     CellCount=ubound(cells)+1\r
  97   End Function\r
  98 \r
  99   Public Function GetRowAttr(ByVal name)\r
 100     GetRowAttr=attr(name)\r
 101   End Function\r
 102 \r
 103   Public Sub SetRowAttr(ByVal name, ByVal value)\r
 104     attr(name)=value\r
 105   End Sub\r
 106 \r
 107   Public Sub SetCellAttr(ByVal name, ByVal value)\r
 108     CurrentCell.SetAttr name,value\r
 109   End Sub\r
 110 end class\r
 111 \r
 112 \r
 113 class SimpleGrid\r
 114   public rows()\r
 115   private LastRow,LastHeadingRow,ResizeRowIdx\r
 116 \r
 117   Private Sub Class_Initialize\r
 118     redim rows(-1)\r
 119   End sub\r
 120 \r
 121   Public Function AddHeadingRow(ResizeRowFlag)\r
 122     LastHeadingRow=AddDataRow\r
 123     if ResizeRowFlag then ResizeRowIdx=LastHeadingRow\r
 124     AddHeadingRow=LastHeadingRow\r
 125   End Function\r
 126   \r
 127   Public Function AddDataRow()\r
 128     ReDim Preserve rows(ubound(rows)+1)\r
 129     set rows(ubound(rows))=new SimpleGridRow\r
 130     LastRow=ubound(rows)\r
 131     AddDataRow=LastRow\r
 132   End Function\r
 133   \r
 134   Public Function HeadingRowCount()\r
 135     if IsEmpty(LastHeadingRow) then\r
 136       HeadingRowCount=0\r
 137     else\r
 138       HeadingRowCount=LastHeadingRow+1\r
 139     end if\r
 140   End Function\r
 141   \r
 142   Public Function DataRowCount()\r
 143     if IsEmpty(LastRow) then\r
 144       DataRowCount=0\r
 145     else\r
 146       DataRowCount=LastRow+1-HeadingRowCount()\r
 147     end if\r
 148   End Function\r
 149   \r
 150   ' returns # of cells in the current row\r
 151   Public Function CellCount()\r
 152     CellCount=rows(LastRow).CellCount\r
 153   End Function\r
 154 \r
 155   Public Sub AddCell(ByVal content)\r
 156     rows(LastRow).AddCell content\r
 157   End Sub\r
 158   \r
 159   Public Sub AddCellToRow(ByVal RowIdx, ByVal content)\r
 160     LastRow=RowIdx\r
 161     AddCell content\r
 162   End Sub\r
 163   \r
 164   Public Sub SetRowAttr(ByVal name, ByVal value)\r
 165     rows(LastRow).SetRowAttr name,value\r
 166   End Sub\r
 167 \r
 168   Public Sub SetCellAttr(ByVal name, ByVal value)\r
 169     rows(LastRow).SetCellAttr name,value\r
 170   End Sub\r
 171 \r
 172   Private Function RenderColumns(ByVal c1, ByVal c2)\r
 173     dim r,c\r
 174     for c=c1 to c2\r
 175       response.write vbLf & "<td><div class='ricoLG_col'>"\r
 176       for r=LastHeadingRow+1 to ubound(rows)\r
 177         response.write rows(r).cells(c).DataCell(rows(r).GetRowAttr("class"))\r
 178       next\r
 179       response.write "</div></td>"\r
 180     next\r
 181   End Function\r
 182 \r
 183   ' Response.Buffer must be true\r
 184   Public Sub RenderExcel(fileName)\r
 185     dim r,c\r
 186     Response.Clear\r
 187     if fileName<>"" then Response.AddHeader "content-disposition", "attachment; filename=" & fileName\r
 188     'Response.ContentType = "application/vnd.ms-excel"\r
 189     Response.ContentType = "application/ms-excel"\r
 190 \r
 191     response.write vbLf & "<table>"\r
 192     for r=0 to ubound(rows)\r
 193       response.write vbLf & "<tr>"\r
 194       for c=0 to ubound(rows(r).cells)\r
 195         response.write rows(r).cells(c).HtmlCell\r
 196       next\r
 197       response.write vbLf & "</tr>"\r
 198     next\r
 199     response.write vbLf & "</table>"\r
 200     Response.End\r
 201   End Sub\r
 202 \r
 203   ' Response.Buffer must be true\r
 204   Public Sub RenderDelimited(fileName,delim,SubstituteChar)\r
 205     dim r,c\r
 206     Response.Clear\r
 207     if fileName<>"" then Response.AddHeader "content-disposition", "attachment; filename=" & fileName\r
 208     Response.ContentType = "text/csv"\r
 209 \r
 210     for r=0 to ubound(rows)\r
 211       for c=0 to ubound(rows(r).cells)\r
 212         if c > 0 then response.write delim\r
 213         response.write replace(rows(r).cells(c).content,delim,SubstituteChar)\r
 214       next\r
 215       response.write vbLf\r
 216     next\r
 217     Response.End\r
 218   End Sub\r
 219 \r
 220   Public Sub Render(ByVal id, FrozenCols)\r
 221     dim colcnt,r,c\r
 222     if IsEmpty(ResizeRowIdx) then exit sub\r
 223     colcnt=rows(ResizeRowIdx).CellCount\r
 224     response.write vbLf & "<div id='" & id & "_outerDiv'><table id='" & id & "' border='0' cellspacing='0' cellpadding='0'><tr valign='top'><td rowspan='2'>"\r
 225 \r
 226     '-------------------\r
 227     ' frozen columns\r
 228     '-------------------\r
 229     ' upper left\r
 230     response.write vbLf & "<table id='" & id & "_tab0h' class='ricoLG_table ricoLG_top ricoLG_left' cellspacing='0' cellpadding='0'><thead>"\r
 231     for r=0 to LastHeadingRow\r
 232       response.write vbLf & "<tr class='" & rows(r).HeadingClass & "'"\r
 233       if r=ResizeRowIdx then response.write " id='" & id & "_tab0h_main'"\r
 234       response.write ">"\r
 235       response.write rows(r).HeadingRow(0,FrozenCols-1)\r
 236       response.write vbLf & "</tr>"\r
 237     next\r
 238     response.write vbLf & "</thead></table>"\r
 239 \r
 240     ' lower left\r
 241     response.write vbLf & "<div id='" & id & "_frozenTabsDiv'>"\r
 242     response.write "<table id='" & id & "_tab0' class='ricoLG_table ricoLG_bottom ricoLG_left' cellspacing='0' cellpadding='0'>"\r
 243     response.write vbLf & "<tr>"\r
 244     RenderColumns 0,FrozenCols-1\r
 245     response.write vbLf & "</tr>"\r
 246     response.write vbLf & "</table>"\r
 247 \r
 248     response.write vbLf & "</div></td>"\r
 249 \r
 250 \r
 251     '-------------------\r
 252     ' scrolling columns\r
 253     '-------------------\r
 254 \r
 255     ' upper right\r
 256     response.write vbLf & "<td><div id='" & id & "_innerDiv'>"\r
 257     response.write vbLf & "<div id='" & id & "_scrollTabsDiv'>"\r
 258     response.write vbLf & "<table id='" & id & "_tab1h' class='ricoLG_table ricoLG_top ricoLG_right' cellspacing='0' cellpadding='0'><thead>"\r
 259     for r=0 to LastHeadingRow\r
 260       response.write vbLf & "<tr class='" & rows(r).HeadingClass & "'"\r
 261       if r=ResizeRowIdx then response.write " id='" & id & "_tab1h_main'"\r
 262       response.write ">"\r
 263       response.write rows(r).HeadingRow(FrozenCols,colcnt-1)\r
 264       response.write vbLf & "</tr>"\r
 265     next\r
 266     response.write vbLf & "</thead></table>"\r
 267     response.write vbLf & "</div>"\r
 268     response.write vbLf & "</div>"\r
 269 \r
 270     ' lower right\r
 271     response.write vbLf & "<tr valign='top'><td><div id='" & id & "_scrollDiv'>"\r
 272     response.write vbLf & "<table id='" & id & "_tab1' class='ricoLG_table ricoLG_bottom ricoLG_right' cellspacing='0' cellpadding='0'>"\r
 273     response.write vbLf & "<tr>"\r
 274     RenderColumns FrozenCols,colcnt-1\r
 275     response.write vbLf & "</tr>"\r
 276     response.write vbLf & "</table>"\r
 277     response.write vbLf & "</div></td></tr>"\r
 278 \r
 279     response.write vbLf & "</table></div>"\r
 280   End Sub\r
 281 end class\r
 282 \r
 283 %>\r