<HTML>
<HEAD>
<TITLE>Simple Stack Bar Chart</TITLE>
<STYLE TYPE="text/css">
BODY{ font-family:Arial, "Helvetica"; font-size:smaller }
</STYLE>
</HEAD>
<%
Dim I, J ' counters
Dim iMaxValue ' holds max value of row to scale graph
Dim tmp ' temp
' set full path of input data file; data is cross table and tab-delimited
Const DATA_FILE = "C:\TEMP\data1.txt"
Sub ShowChart(ByRef aValues, ByRef rowLabels, ByRef colLabels, ByRef strTitle, ByRef strXAxisLabel, ByRef strYAxisLabel)
' Some user changable graph defining constants
' All units are in screen pixels
Const CHART_WIDTH = 425 ' The width of the chart's body
Const CELL_HEIGHT = 25 ' The height of the cell containing the stacked bar
Const BAR_WIDTH = 15 ' The width of the stacked bar
Const STACK_NUMBER = 25 ' Number of images available for painting the stack bar
' Debugging constant so I can easily switch on borders in case
' the tables get messed up. Should be left at zero unless you're
' trying to figure out which table cells doing what.
Const TABLE_BORDER = 0
'Const TABLE_BORDER = 5
' Declare our variables
Dim iBarLength ' to contain the height of the bar
Dim rowMarkZero() ' array to indicate that a row(i.e. sum of all values in a row)
' is zero
' intialize to number of rowLabels
ReDim rowMarkZero(UBound(rowLabels))
' validating the number of column labels; should not exceed number of stack images
if UBound(colLabels) > STACK_NUMBER - 1 then
Response.Write "<B>Error</B>: Columns exceeded available stack images[ " & STACK_NUMBER - 1 & " ].<BR>"
Response.Write "Sorry, the stack bar chart cannot be created.</BODY></HTML>"
Response.End
end if
' checking if there are valid values in each row to be displayed as a stack bar.
' if not mark those invalid values as -1 to skip painting the stack bar. Later,
' find the max(sum of values in a row) to scale the width of the graph.
' if the sum of values in a row is less than 1 then mark that row, for no painting
tmp = 0
For J = 0 To UBound(aValues, 2)
tmp = 0
For I = 0 To UBound(aValues)
if IsNumeric(aValues(I, J)) = False then
aValues(I, J) = -1 ' -1 means NULL, used to skip without painting in canvas
elseif aValues(I, J) = 0 then
aValues(I, J) = -1 ' -1 means NULL, used to skip without painting in canvas
else
tmp = tmp + aValues(I, J)
end if
Next 'I
If iMaxValue < CDbl(tmp) Then iMaxValue = CDbl(tmp)
' set array rowMarkZero(J) to TRUE if its sum of col values < 1 ( invalid )
' we will leave a row blank if the sum of the values in a row are < 1.
If tmp < 1 then rowMarkZero(J) = "TRUE" else rowMarkZero(J) = "FALSE"
Next 'J
%>
<!-- Start drawing the graph -->
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0">
<TR>
<TD>
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0">
<TR>
<TD COLSPAN="4" ALIGN="center"><H4><%= strTitle %></H4></TD>
</TR>
<TR>
<TD VALIGN="center"><B><SMALL><%= strYAxisLabel %></B> </SMALL></TD>
<TD>
<!-- labeling the rows -->
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0">
<%
For J = 0 To UBound(rowLabels)
Response.Write vbTab & vbTab & vbTab & vbTab &"<TR>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"<TD height=""" & CELL_HEIGHT & """><SMALL>" & rowLabels(J) &" </SMALL></TD>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"</TR>" & vbCrLf
Next
%>
</TABLE>
</TD>
<!-- paint the vertical border of the graph; adding image to work with netscape -->
<TD BGCOLOR="#000000" WIDTH="2"><IMG SRC="../images/spacer.gif" BORDER="0" HEIGHT="1" WIDTH="1"></TD>
<TD>
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0" WIDTH="<%= CHART_WIDTH %>">
<%
For J = 0 To UBound(aValues, 2)
Response.Write vbTab & vbTab & vbTab & vbTab &"<TR>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"<TD>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"<TABLE BORDER="""& TABLE_BORDER &""" CELLSPACING=""0"" CELLPADDING=""0"">" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab & vbTab &"<TR>" & vbCrLf
' We're now in the body of the chart
' do the stack bar only when data is available for painting
if rowMarkZero(J) = "FALSE" then ' row data is not zero!!
'Loop through the data showing their values as bars!
For I = 0 To UBound(aValues)
if aValues(I, J) <> -1 then ' -1 is to skip without painting
iBarLength = CInt( (aValues(I, J) * CHART_WIDTH)/ iMaxValue )
' This is a hack since browsers ignore a 0 or 0.**(something) as an image dimension!
If iBarLength < 1 Then iBarLength = 1
' The foll. line of code is the stack bar, sized and colored to represent its value and
' series respectively. We had to embed the image inside an anchor( <A> ) tag to support
' tool tip text with IE/Netscape and their versions. Netscape 6.1 the latest did not
' support ALT attribute of IMG tag. So, the embedding with anchor tag.
Response.Write vbTab & vbTab & vbTab & vbTab & vbTab &"<TD WIDTH=""" & iBarLength & """ HEIGHT=""" & CELL_HEIGHT & """><A TITLE=""" & colLabels(I) & ": " & FormatNumber(aValues(I, J),,,,-2) & """><IMG SRC=""../images/stack" & I & ".gif"" BORDER=""0"" WIDTH=""" & iBarLength & """ HEIGHT=""" & BAR_WIDTH & """ ALT=""" & colLabels(I) & ": " & FormatNumber(aValues(I, J),,,,-2) & """></A></TD>" & vbCrLf
End if
Next ' I
Else ' rowMarkZero(J) = "TRUE"; sum of values in a row is zero!!
Response.Write vbTab & vbTab & vbTab & vbTab & vbTab &"<TD HEIGHT=""" & CELL_HEIGHT & """> </TD>" & vbCrLf
End if
Response.Write vbTab & vbTab & vbTab & vbTab & vbTab &"</TR>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"</TABLE>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"</TD>" & vbCrLf
Response.Write vbTab & vbTab & vbTab & vbTab &"</TR>" & vbCrLf
Next
%>
</TABLE>
</TD>
</TR>
<TR>
<TD HEIGHT="2" COLSPAN="2"><!-- Place holder for border at bottom --></TD>
<!-- paint the horizontal border of the graph; adding image to work with netscape -->
<TD BGCOLOR="#000000" HEIGHT="2" COLSPAN="2" WIDTH="<%= CHART_WIDTH %>"><IMG SRC="../images/spacer.gif" BORDER="0" HEIGHT="1" WIDTH="1"></TD>
</TR>
<TR>
<TD height="2" COLSPAN="2" VALIGN="top" ALIGN="right"><!-- Place holder for border at bottom --></TD>
<TD COLSPAN="2">
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0" WIDTH="100%">
<TR>
<TD height="2" VALIGN="top"><SMALL>0</SMALL></TD>
<TD VALIGN="top" ALIGN="right"><SMALL><%= FormatNumber(iMaxValue,,,,-2) %></SMALL></TD>
</TR>
</TABLE>
</TD>
</TR>
<TR>
<TD COLSPAN="3"><!-- Place holder for X Axis label centered --></TD>
<TD ALIGN="center"><SMALL><B><%= strXAxisLabel %></B></SMALL></TD>
</TR>
</TABLE>
</TD>
<TD> </TD>
<TD VALIGN="top"><BR><BR>
<TABLE BORDER="1" CELLSPACING="0" CELLPADDING="0">
<TR>
<TD>
<TABLE BORDER="<%= TABLE_BORDER %>" CELLSPACING="0" CELLPADDING="0">
<TR>
<TD COLSPAN="2"><SMALL><B> Legend - <%= strXAxisLabel %> </SMALL></B><BR> </TD>
</TR>
<TR>
<TD><SMALL>
<%
For I = 0 To UBound(colLabels) %>
<IMG SRC="../images/stack<%= I %>.gif" BORDER="0" HEIGHT="10" WIDTH="10">
<%= colLabels(I) %><BR>
<% if I Mod 12 = 0 and I > 0 then
Response.Write "</SMALL></TD><TD VALIGN=""TOP""><SMALL>" & vbCrLf
end if
Next ' I
%>
</SMALL></TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
<%
End Sub
Dim ts, fso, s
Dim arrValues, grid()
Dim Cnt
' Opening the input data file
Const ForReading = 1
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(DATA_FILE)) = False Then
Response.Write "Input file( " & DATA_FILE &" ) not found.<br>"
Response.Write "</BODY></HTML>"
Response.End
End if
Set ts = fso.OpenTextFile( DATA_FILE, ForReading)
I = 0
J = 0
' getting the numeric values from the file stream
For Cnt = 1 to 10
s = ts.ReadLine
arrValues = Split(s, vbTab, -1, 1)
ReDim Preserve grid(UBound(arrValues), J) ' declaring the 2d grid
For I = 0 To UBound(arrValues)
grid( I, J ) = arrValues(I)
Next ' I
J = J + 1
Next ' Cnt
ts.Close ' close the text stream
' show the bar chart...
ShowChart grid, Array ("Row_1", "Row_2", "Row_3", "Row_4", "Row_5", "Row_6", "Row_7", "Row_8", "Row_9", "Row_10"), Array ("Col_1", "Col_2", "Col_3", "Col_4", "Col_5", "Col_6"), "Chart Title", "X Label", "Y Label"
%>
</BODY>
</HTML>