'File source from Holyguard.net
'******************************************************************************************
'======================= QChart: A Charting Object for Rapid-Q ===========================
'========================= Copyright (c) 2003 Michael J. Zito ============================
'QChart provides a set of 2-D charting routines for Rapid-Q programmers.
'It generates histograms, bar charts, XY-scatter graphs, line graphs
'and box plots. Each charting routine will calculate an appropriate scale
'and plot the data contained in the .Data component of the object. The user may optionally
'specify the scaling as well as fonts, grids or other properties (see code)
'Once the data is formatted graphs can be called with very few lines of simple code:
' .Initialize
' ------->Change Desired Options Here
' ------->Dimension .Data Grid Here
' ------->Load Data Into .Data Grid Here
' .ChartType = ctXXXX
' .ChartStyle = csXXXX
' .DrawYYYY (Overlay T or F)
'SEE QChartEx.rqb for examples of setting up and calling each chart type.
'
'NOTE: There is little error checking in this object. It is up to the user
'to insure that the data is formatted properly before calling each routine.
'The .Data component is a non-visible QStringGrid which offers the user the
'ability to set the row and column count prior to filling the grid with data.
'The expected data formats for each chart type are listed below:
'
'Bar and Line Charts: Data groups are in columns, data values are in each row
' Set .Data.ColCount to the number of groups
' Set .Data.RowCount to the number of data points in the largest group
' Row 0 is for legend text
' Col 0 is for X Axis Labels
'
' 0 1 2 . . . n
' 0 (*) <<======Legend======>>
' 1 X A1 B1 . . . n1
' 2 = A2 B2 . . . n2
' . L . . . . . .
' . b . . . . . .
' . l . . . . . .
' n s An Bn . . . nn
'
'XY Scatter Charts: Data pairs are in adjacent columns: Col1 = X val, Col2 = Y val
' Data values are in each row
' Set .Data.ColCount to the number of XY pairs * 2
' Set .Data.RowCount to the number of data points in the largest group
' Row 0 of the X Col is for group labels / legend text
' Col 0 and Row 0 of the Y Col are not used (*)
' Data for each pair should be in ascending order on the X value
'
' Pair 1 Pair 2 Pair n
' ======= ======= ======
' 0 1 2 3 4 . . . m n
' 0 * Lgd * Lgd * Lgd *
' 1 * x11 y11 x21 y21 . . . m1 n1
' 2 * x12 y12 x22 y22 . . . m2 n2
' . * . . . . . . . . .
' . * . . . . . . . . .
' . * . . . . . . . . .
' n * x1n y1n x2n y2n . . . mn nn
'
'Box Plots: Data groups are in columns, data values are in each row
' Set .Data.ColCount to the number of groups
' Set .Data.RowCount to 5
' Data must be set up with the highest value in row 1
' the lowest value in row 5 and intermediate values in
' descending order from row 1 to row 5.
' Row 0 is for legend text
' Col 0 is not used (*)
'
' Box Plots
' 0 1 2 3 . . n
' 0 * <<=====Legend======>>
' 1 * Max
' 2 * 3rd Quartile
' 3 * 2nd Quartile (Median)
' 4 * 1st Quartile
' 5 * Min
'******************************************************************************************
'----- Compiler Directives
$TYPECHECK ON
'----- Debug Stuff
DECLARE SUB watch (watch$) 'Displays watch$ in a MessageDlg
'----- FUNCTIONs
DECLARE FUNCTION Log10 (Value AS SINGLE) AS SINGLE
DECLARE FUNCTION RoundUp (Num AS SINGLE, Decs AS INTEGER) AS SINGLE
DECLARE FUNCTION RoundDown (Num AS SINGLE, Decs AS INTEGER) AS SINGLE
DECLARE FUNCTION ScaleMin (Mn AS SINGLE, Div AS INTEGER) AS SINGLE
DECLARE FUNCTION ScaleMax (Mx AS SINGLE, Div AS INTEGER) AS SINGLE
'----- Method SUBs
DECLARE SUB Initialize
DECLARE SUB ClearBuffer
DECLARE SUB ImagePaint
DECLARE SUB SetSize
DECLARE SUB SetScale
DECLARE SUB DrawAxes
DECLARE SUB DrawTitles
DECLARE SUB DrawLabels
DECLARE SUB DrawLegend
DECLARE SUB DrawBar (Overlay AS INTEGER)
DECLARE SUB DrawXY (Overlay AS INTEGER)
DECLARE SUB DrawLine (Overlay AS INTEGER)
DECLARE SUB DrawBox (Overlay AS INTEGER)
DECLARE SUB SaveChart (FileNam AS STRING)
DECLARE SUB PrintChart (Prn AS INTEGER, Orient AS INTEGER, Margin AS INTEGER)
'----- Event SUBs
DECLARE SUB chtResize
'----- UDTs
TYPE AxisType
Len AS SINGLE ' Axis length in pixels
Ori AS SINGLE ' Logical Origin in pixels
Min AS SINGLE ' Minimum scale value
Max AS SINGLE ' Maximum scale value
Div AS INTEGER ' Number of divisions on axis
ScaleFactor AS SINGLE ' Factor for scaling values on axis
AutoScale AS INTEGER ' Boolean
AxisColor AS INTEGER ' Color of axis
Grid AS INTEGER ' Boolean
Labeled AS INTEGER ' Boolean
Zero AS SINGLE ' Location of zero in Pixels
DrawZero AS INTEGER ' Boolean
ZeroColor AS INTEGER ' Color of Zero Line
Tics AS INTEGER ' Boolean
TicIntvl AS SINGLE ' Distance between tics in world coordinates
TicLen AS SINGLE ' Size of tic mark in Pixels
TicDecimals AS INTEGER ' Number of decimals in value label
LogScale AS INTEGER ' 0=Linear, 1=Log
END TYPE
TYPE TitleType
Top AS INTEGER
Left AS INTEGER
Text AS STRING * 70
END TYPE
'----- Constants
CONST ctBar = 0 'Chart Type Flags
CONST ctLine = 1
CONST ctXY = 2
CONST ctBox = 3
CONST csHisto = 0 'Chart Style Flags
CONST csBar = 1
CONST csPointsOnly = 2
CONST csLinesOnly = 3
CONST csBoth =4
CONST csWhisker = 5
CONST csHiLo = 6
'----- Begin Object Definition ***********************************************************
TYPE QChart EXTENDS QPanel
'---- Properties
PRIVATE:
AppStart AS INTEGER 'Conditional Flags
ChartExists AS INTEGER
DataMissing AS INTEGER
Success AS INTEGER
Image AS QCanvas 'Displayed Image
Buffer AS QBitmap 'Hidden drawing buffer
PUBLIC:
Data AS QStringGrid 'Data to be plotted
XAxis AS AxisType 'X-axis options
YAxis AS AxisType 'Y-axis options
bgColor AS INTEGER
fgColor AS INTEGER
ChartType AS INTEGER 'ctBar, ctXY, ctBox etc...
ChartStyle AS INTEGER 'csHisto, csLines, csPoints, csBoth etc...
MainTitle AS TitleType
MainFont AS QFont
SubTitle AS TitleType
SubFont AS QFont
XTitle AS TitleType
YTitle AS TitleType
AxisLbl AS TitleType
AxisFont AS QFont
ChartBorder AS INTEGER
AxisBorder AS INTEGER
DoLegend AS INTEGER 'True = Draw Legend, False = No Legend
Legend AS TitleType
LegendFont AS QFont
Colors(15) AS INTEGER
dlgSave AS QSaveDialog
CONSTRUCTOR
Parent = QForm
Width = QForm.ClientWidth
Height = QForm.ClientHeight
BevelOuter = bvNone
BevelWidth = 0
Visible = True
WITH Image
.Parent = QChart
.Width = QChart.ClientWidth
.Height = QChart.ClientHeight
.Align = alClient
.Visible = True
END WITH
WITH Buffer
.Width = QChart.Image.Width
.Height = QChart.Image.Height
.FillRect(0, 0, .Width, .Height, QChart.bgColor)
END WITH
'--- Copied from QBColors() Redefine any way you like
Colors(0) = 0 '-- Black
Colors(1) = &H800000 '-- Blue
Colors(2) = &H8000 '-- Green
Colors(3) = &H808000 '-- Cyan
Colors(4) = &H80 '-- Red
Colors(5) = &H800080 '-- Magenta
Colors(6) = &H8080 '-- Brown
Colors(7) = &HC0C0C0 '-- White
Colors(8) = &H808080 '-- Grey
Colors(9) = &HFF0000 '-- Light Blue
Colors(10) = &HFF00 '-- Light Green
Colors(11) = &HFFFF00 '-- Light Cyan
Colors(12) = &HFF '-- Light Red
Colors(13) = &HFF00FF '-- Light Magenta
Colors(14) = &HFFFF '-- Yellow
Colors(15) = &HFFFFFF '-- Bright White
AppStart = True 'Set flags
ChartExists = False
DataMissing = False
END CONSTRUCTOR
'----- FUNCTIONS
FUNCTION Log10 (Value AS SINGLE) AS SINGLE
IF Value > 0 THEN
Log10 = Log(Value) / Log(10)
ELSE
MESSAGEDLG("Log10: Log of Value <= 0 Undefined", 1, 4, 0)
QChart.Success = False
EXIT FUNCTION
END IF
END FUNCTION
'------------------------------------------------------------------------------------------
FUNCTION RoundUp (Num AS SINGLE, Decs AS INTEGER) AS SINGLE
RoundUp = FIX(Num * 10^(ABS(Decs)) + .5) / 10^(ABS(Decs)) 'Round up (+.5)
END FUNCTION
'------------------------------------------------------------------------------------------
FUNCTION RoundDown (Num AS SINGLE, Decs AS INTEGER) AS SINGLE
RoundDown = FIX(Num * 10^(ABS(Decs)) - .5) / 10^(ABS(Decs)) 'Round down (-.5)
END FUNCTION
'------------------------------------------------------------------------------------------
FUNCTION ScaleMin (Mn AS SINGLE, Div AS INTEGER) AS SINGLE
DIM LMin AS SINGLE
DIM pwr AS INTEGER
DIM Test AS SINGLE
IF QChart.Success = False THEN EXIT FUNCTION 'Previous instance failed
LMin = Mn 'Make a local copy
IF Div < 1 THEN Div = 1 'Avoid zero division
SELECT CASE LMin
CASE IS < 0
IF QChart.XAxis.LogScale = True OR QChart.YAxis.LogScale = TRUE THEN
MESSAGEDLG("Log Scale: Log of Value <= 0 Undefined", 1, 4, 0)
QChart.Success = False
EXIT FUNCTION
END IF
LMin = ABS(LMin) 'Change sign
pwr = CEIL(QChart.Log10(LMin))
FOR Test = 10^(pwr - 1) TO 10^(pwr) STEP 10^(pwr -1)/Div
IF Test >= LMin THEN EXIT FOR
NEXT Test
LMin = -Test 'Change sign back
CASE IS > 0
pwr = FLOOR(QChart.Log10(LMin))
IF pwr < 1 THEN pwr = pwr -1 'For values between 0 and 1
FOR Test = 10^(pwr + 1) TO 10^(pwr) STEP -10^(pwr)/Div
IF Test <= LMin THEN EXIT FOR
NEXT Test
LMin = Test
CASE ELSE
LMin = 0
END SELECT
'--- Round values for precision and avoid errors
LMin = QChart.RoundDown(LMin, pwr)
IF LMin < 0 AND Mn >= 0 THEN LMin = 0
IF LMin > Mn THEN LMin = Mn
QChart.Success = True
ScaleMin = LMin
END FUNCTION
'------------------------------------------------------------------------------------------
FUNCTION ScaleMax (Mx AS SINGLE, Div AS INTEGER) AS SINGLE
DIM LMax AS SINGLE
DIM pwr AS INTEGER
DIM Test AS SINGLE
IF QChart.Success = False THEN EXIT FUNCTION 'Previous instance failed
LMax = Mx 'Make a local copy
IF Div < 1 THEN Div = 1 'Avoid zero division
SELECT CASE LMax
CASE IS < 0
IF QChart.XAxis.LogScale = True OR QChart.YAxis.LogScale = TRUE THEN
MESSAGEDLG("Log Scale: Log of Value <= 0 Undefined", 1, 4, 0)
QChart.Success = False
EXIT FUNCTION
END IF
LMax = ABS(LMax) 'Change sign
pwr = FLOOR(QChart.Log10(LMax))
IF pwr < 1 THEN pwr = pwr - 1 'For values between 0 and 1
FOR Test = 10^(pwr + 1) TO 10^(pwr) STEP -10^(pwr) / Div
IF Test <= LMax THEN EXIT FOR
NEXT Test
LMax = -Test 'Change sign back
CASE IS > 0
pwr = CEIL(QChart.Log10(LMax))
FOR Test = 10^(pwr - 1) TO 10^(pwr) STEP 10^(pwr -1) / Div
IF Test >= LMax THEN EXIT FOR
NEXT Test
LMax = Test
CASE ELSE
LMax = 0
END SELECT
'--- Round values for precision and avoid errors
LMax = QChart.RoundUp(LMax, pwr)
IF LMax > 0 AND Mx <= 0 THEN LMax = 0
IF LMax < Mx THEN LMax = Mx
QChart.Success = True
ScaleMax = LMax
END FUNCTION
'------------------------------------------------------------------------------------------
'----- Method SUBs
SUB Initialize 'Sets default values, make global changes here
DIM i AS INTEGER 'Loop Counters
DIM j AS INTEGER
WITH QChart
.ChartExists = False
.Success = True
.bgColor = QChart.Colors(15)
.fgColor = QChart.Colors(0)
.ChartBorder = True
.AxisBorder = True
.MainFont.Name = "Arial"
.MainFont.Color = QChart.Colors(9)
.MainTitle.Text = ""
.MainFont.AddStyles(fsBold)
.SubFont.Name = "Arial"
.SubFont.Color = QChart.Colors(9)
.SubTitle.Text = ""
.SubFont.AddStyles(fsBold)
.AxisFont.Name = "Arial"
.AxisFont.Color = QChart.Colors(12)
.XTitle.Text = ""
.YTitle.Text = ""
.DoLegend = True
.LegendFont.Name = "Arial"
.LegendFont.Color = QChart.Colors(0)
.XAxis.Div = 10
.XAxis.AutoScale = True
.XAxis.Labeled = True
.XAxis.Tics = True
.XAxis.Grid = True
.XAxis.DrawZero = True
.XAxis.LogScale = False
.XAxis.AxisColor = QChart.Colors(9)
.XAxis.ZeroColor = QChart.Colors(12)
.YAxis.Div = 10
.YAxis.AutoScale = True
.YAxis.Labeled = True
.YAxis.Tics = True
.YAxis.Grid = True
.YAxis.DrawZero = True
.YAxis.LogScale = False
.YAxis.AxisColor = QChart.Colors(9)
.YAxis.ZeroColor = QChart.Colors(12)
FOR i = 0 TO .Data.ColCount 'Clear any residual data from last call
FOR j = 0 TO .Data.RowCount
.Data.Cell(i,j) = ""
NEXT
NEXT
END WITH
END SUB
'------------------------------------------------------------------------------------------
SUB ClearBuffer 'Erase off screen drawing buffer
WITH QChart.Buffer
.FillRect(0, 0, .Width, .Height, QChart.bgColor)
END WITH
QChart.ChartExists = False 'Set flag
END SUB
'------------------------------------------------------------------------------------------
SUB ImagePaint 'Called by OnPaint Proc
'Draws Buffer.BMP to Canvas
WITH QChart
.Image.Draw(0, 0, .Buffer.BMP)
END WITH
END SUB
'----------------------------------------------------------------------------------------
SUB SetSize
WITH QChart 'Set Origin and Axis Lengths relative to window size
IF .DoLegend = False THEN 'Make X Axis larger
.XAxis.Len = .Buffer.Width * .85
.XAxis.Ori = (.Buffer.Width - .XAxis.Len) * .66
ELSE 'Leave room for Legend
.XAxis.Len = .Buffer.Width * .75
.XAxis.Ori = (.Buffer.Width - .XAxis.Len) * .4
END IF
.YAXis.Len = .Buffer.Height * .75
.YAxis.Ori = .Buffer.Height - .Buffer.TextHeight(.XTitle.Text) * 4.5
.MainFont.Size = .036 * QChart.Buffer.Height 'Change Font Size to fit resized forms
.SubFont.Size = .5 * QChart.MainFont.Size
.AxisFont.Size = .SubFont.Size
.LegendFont.Size = .SubFont.Size
END WITH
END SUB
'------------------------------------------------------------------------------------------
SUB SetScale
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM XMax AS SINGLE
DIM XMin AS SINGLE
DIM YMax AS SINGLE
DIM YMin AS SINGLE
XMax = -1e30 'Start Small
XMin = 10e30 'Start Big
YMax = -1e30 'Ditto
YMin = 10e30
WITH QChart
SELECT CASE QChart.ChartType
CASE ctBar, ctLine
IF .YAxis.AutoScale = True THEN 'Find Data Min and Max
FOR i = 1 to .Data.ColCount
FOR j = 1 to .Data.RowCount
IF VAL(.Data.Cell(i,j)) < YMin THEN YMin = VAL(.Data.Cell(i,j))
IF VAL(.Data.Cell(i,j)) > YMax THEN YMax = VAL(.Data.Cell(i,j))
NEXT j
NEXT i
.YAxis.Min = .ScaleMin(YMin, .YAxis.Div) 'Scale the Min and Max
.YAxis.Max = .ScaleMax(YMax, .YAxis.Div)
END IF
CASE ctXY
IF .XAxis.AutoScale = True THEN 'Find X Data Min and Max
FOR i = 1 to .Data.ColCount - 1 STEP 2
FOR j = 1 to .Data.RowCount
IF VAL(.Data.Cell(i , j)) < XMin THEN XMin = VAL(.Data.Cell(i , j))
IF VAL(.Data.Cell(i , j)) > XMax THEN XMax = VAL(.Data.Cell(i , j))
NEXT j
NEXT i
.XAxis.Min = .ScaleMin(XMin, .XAxis.Div) 'Scale the Min and Max
.XAxis.Max = .ScaleMax(XMax, .XAxis.Div)
END IF
IF .YAxis.AutoScale = True THEN 'Find Y Data Min and Max
FOR i = 2 to .Data.ColCount STEP 2
FOR j = 1 to .Data.RowCount
IF VAL(.Data.Cell(i , j)) < YMin THEN YMin = VAL(.Data.Cell(i , j))
IF VAL(.Data.Cell(i , j)) > YMax THEN YMax = VAL(.Data.Cell(i , j))
NEXT j
NEXT i
.YAxis.Min = .ScaleMin(YMin, .YAxis.Div) 'Scale the Min and Max
.YAxis.Max = .ScaleMax(YMax, .YAxis.Div)
END IF
CASE ctBox
IF .YAxis.AutoScale = True THEN 'Find Data Min and Max
FOR i = 1 to .Data.ColCount
IF VAL(.Data.Cell(i,5)) < YMin THEN YMin = VAL(.Data.Cell(i,5))
IF VAL(.Data.Cell(i,1)) > YMax THEN YMax = VAL(.Data.Cell(i,1))
NEXT i
.YAxis.Min = .ScaleMin(YMin, .YAxis.Div) 'Scale the Min and Max
.YAxis.Max = .ScaleMax(YMax, .YAxis.Div)
END IF
END SELECT
'----- Scale the difference so tic labels will be even
DIM Diff1 AS SINGLE
DIM Diff2 AS SINGLE
DIM LMin AS SINGLE
IF .XAxis.AutoScale = True AND .XAxis.LogScale = False THEN
Diff1 = .XAxis.Max - .XAxis.Min
Diff2 = .ScaleMax(Diff1, .XAxis.Div)
LMin = .XAxis.Min - (Diff2 - Diff1)
IF LMin < 0 and .XAxis.Min >= 0 THEN LMin = 0 'Avoid crossing zero if not needed
IF LMin < .XAxis.Min THEN .XAxis.Min = LMin
.XAxis.Max = .XAxis.Min + Diff2
END IF
IF .YAxis.AutoScale = True AND .YAxis.LogScale = False THEN
Diff1 = .YAxis.Max - .YAxis.Min
Diff2 = .ScaleMax(Diff1, .YAxis.Div)
Lmin = .YAxis.Min - (Diff2 - Diff1)
IF LMin < 0 and .YAxis.Min >= 0 THEN LMin = 0
IF LMin < .YAxis.Min THEN .YAxis.Min = LMin
.YAxis.Max = .YAxis.Min + Diff2
END IF
'--- Calculate the axis scalefactor and zero point
IF .XAxis.LogScale = False THEN
IF .XAxis.Max = .XAxis.Min THEN .XAxis.Max = .XAxis.Min + 1
.XAxis.ScaleFactor = .XAxis.Len / (.XAxis.Max - .XAxis.Min)
.XAxis.Zero = .XAxis.Ori - .XAxis.Min * .XAxis.ScaleFactor
ELSE 'Log Scale
.XAxis.Min = FIX(.Log10(.XAxis.Min)) 'Set Min to Lowest power of ten
.XAxis.Max = CEIL(.Log10(.XAxis.Max)) 'Set Max to Greatest power of ten
.XAxis.Div = (.XAxis.Max - .XAxis.Min) 'Div = # of Log Cycles
.XAxis.ScaleFactor = .XAxis.Len / .XAxis.Div
.XAxis.TicIntvl = .XAxis.ScaleFactor
END IF
IF .YAxis.LogScale = False THEN
IF .YAxis.Max = .YAxis.Min THEN .YAxis.Max = .YAxis.Min + 1
.YAxis.ScaleFactor = .YAxis.Len / (.YAxis.Max - .YAxis.Min)
.YAxis.Zero = .YAxis.Ori + .YAxis.Min * .YAxis.ScaleFactor
ELSE 'See above for explanantion
.YAxis.Min = FIX(.Log10(.YAxis.Min))
.YAxis.Max = CEIL(.Log10(.YAxis.Max))
.YAxis.Div = (.YAxis.Max - .YAxis.Min)
.YAxis.ScaleFactor = .YAxis.Len / .YAxis.Div
.YAxis.TicIntvl = .YAxis.ScaleFactor
END IF
END WITH
END SUB
'------------------------------------------------------------------------------------------
SUB DrawAxes
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
WITH QChart
IF .XAxis.Tics = True THEN 'Set Tic Size
.XAxis.TicLen = .YAxis.Len * .02
ELSE
.XAxis.TicLen = 0
END IF
IF .XAxis.Grid = True THEN 'Draw a grid and tics
y1 = .YAxis.Ori + .XAxis.TicLen
y2 = .YAxis.Ori - .YAxis.Len
ELSE 'Draw Tics only
y1 = .YAxis.Ori + .XAxis.TicLen
y2 = .YAxis.Ori
END IF
IF .XAxis.LogScale = False THEN 'draw linear grid lines
IF .XAxis.Div < 1 THEN .XAxis.Div = 1 'Avoid division by zero
.XAxis.TicIntvl = .XAxis.Len / .XAxis.Div
FOR i = 0 TO .XAxis.Div
x1 = .XAxis.Ori + .XAxis.TicIntvl * i
x2 = x1
.Buffer.Line (x1,y1,x2,y2,.Colors(7))
NEXT
ELSE 'draw log grid lines
FOR i = .XAxis.Min TO .XAxis.Max - 1
FOR j = 1 TO 9
x1 = .XAxis.Ori + (.Log10(10 ^ i * j) - .XAxis.Min) * .XAxis.ScaleFactor
x2 = x1
.Buffer.Line (x1,y1,x2,y2,.Colors(7))
NEXT j
NEXT i
END IF
IF .YAxis.Tics = True THEN 'Set Tic Size
.YAxis.TicLen = .XAxis.Len * .01
ELSE
.YAxis.TicLen = 0
END IF
IF .YAxis.Grid = True THEN 'Draw a grid and tics
x1 = .XAxis.Ori - .YAxis.TicLen
x2 = .XAxis.Ori + .XAxis.Len
ELSE 'Draw Tics only
x1 = .XAxis.Ori - .YAxis.TicLen
x2 = .XAxis.Ori
END IF
IF .YAxis.LogScale = False THEN 'draw linear grid lines
IF .YAxis.Div < 1 THEN .YAxis.Div = 1 'Avoid division by zero
.YAxis.TicIntvl = .YAxis.Len / .YAxis.Div
FOR i = 0 TO .YAxis.Div
y1 = .YAxis.Ori - .YAxis.TicIntvl * i
y2 = y1
.Buffer.Line (x1,y1,x2,y2,.Colors(7))
NEXT
ELSE 'draw log grid lines
FOR i = .YAxis.Min TO .YAxis.Max - 1
FOR j = 1 TO 9
y1 = .YAxis.Ori - (.Log10(10 ^ i * j) - .YAxis.Min) * .YAxis.ScaleFactor
y2 = y1
.Buffer.Line (x1,y1,x2,y2,.Colors(7))
NEXT j
NEXT i
END IF
x1 = 2 'Draw a frame around entire chart
y1 = 2
x2 = .Width - 4
y2 = .Height - 4
IF .ChartBorder = True THEN .Buffer.Rectangle (x1, y1, x2, y2, .fgColor)
x1 = .XAxis.Ori 'Draw a box around Plot Area
y1 = .YAxis.Ori
x2 = .XAxis.Ori + .XAxis.Len
y2 = .YAxis.Ori - .YAxis.Len
IF .AxisBorder = True THEN .Buffer.Rectangle (x1, y1, x2, y2, .Colors(7))
x2 = .XAxis.Ori + .XAxis.Len 'Overwrite XAxis in its color
y2 = .YAxis.Ori
.Buffer.Line (x1, y1, x2, y2, .XAxis.AxisColor)
x2 = .XAxis.Ori
y2 = .YAxis.Ori - .YAxis.Len 'Overwrite YAxis in its color
.Buffer.Line (x1, y1, x2, y2, .YAxis.AxisColor)
IF .XAxis.DrawZero = True THEN 'Draw the Y Zero Line
IF .XAxis.Min * .XAxis.Max < 0 THEN 'Data Spans zero
x1 = .XAxis.Zero
y1 = .YAxis.Ori
x2 = .XAxis.Zero
y2 = .YAxis.Ori - .YAxis.Len + 1
.Buffer.Line (x1,y1,x2,y2,.XAxis.ZeroColor)
END IF
END IF
IF .YAxis.DrawZero = True THEN 'Draw the Y Zero Line
IF .YAxis.Min * .YAxis.Max < 0 THEN 'Data Spans zero
x1 = .XAxis.Ori
y1 = .YAxis.Zero
x2 = .XAxis.Ori + .XAxis.Len - 1
y2 = .YAxis.Zero
.Buffer.Line (x1,y1,x2,y2,.YAxis.ZeroColor)
END IF
END IF
END WITH
END SUB
'---------------------------------------------------------------------------------------
SUB DrawTitles
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
WITH QChart
'--- Main Title
.Buffer.Font = .MainFont
.MainTitle.Left = .XAxis.Ori + (.XAxis.Len - .Buffer.TextWidth(RTRIM$(.MainTitle.Text))) / 2
.MainTitle.Top = 3
.Buffer.TextOut (.MainTitle.Left, .MainTitle.Top, RTRIM$(.MainTitle.Text),_
.MainFont.Color, .bgColor)
'--- Sub Title
DIM Spacer AS INTEGER 'Calc this before Font is Changed
Spacer = .Buffer.TextHeight(.MainTitle.Text)
.Buffer.Font = .SubFont
.SubTitle.Left = .XAxis.Ori + (.XAxis.Len - .Buffer.TextWidth(RTRIM$(.SubTitle.Text))) / 2
.SubTitle.Top = .MainTitle.Top + Spacer
.Buffer.TextOut (.SubTitle.Left, .SubTitle.Top, RTRIM$(.SubTitle.Text),_
.SubFont.Color, .bgColor)
'--- X Axis Title
.Buffer.Font = .AxisFont 'both x and y axis
.XTitle.Left = .XAxis.Ori + (.XAxis.Len - .Buffer.TextWidth(RTRIM$(.XTitle.Text))) / 2
.XTitle.Top =.YAxis.Ori + .Buffer.TextHeight(.XTitle.Text) * 3
.Buffer.TextOut (.XTitle.Left, .XTitle.Top, RTRIM$(.XTitle.Text),_
.AxisFont.Color, .bgColor)
'--- Y Axis Title
j = LEN(RTRIM$ (.YTitle.Text))
.YTitle.Left = .XAxis.Ori / 6
.YTitle.Top = (.Buffer.Height - .Buffer.TextHeight(.YTitle.Text)*j) / 2
FOR i = 1 TO j '--- Draw Y label vertically
.Buffer.TextOut (.YTitle.Left, .YTitle.Top, MID$(.YTitle.Text, i ,1),_
.AxisFont.Color, .bgColor)
.YTitle.Top = .YTitle.Top + .Buffer.TextHeight(.YTitle.Text)
NEXT i
END WITH'QChart.Buffer
END SUB
'---------------------------------------------------------------------------------------
SUB DrawLabels
DIM i AS INTEGER
DIM TicInc AS SINGLE 'increment by which tics change
DIM TicVal AS SINGLE 'Value of tic label
WITH QChart
IF .XAxis.Labeled = False AND .YAxis.Labeled = FALSE THEN EXIT SUB
.Buffer.Font = .LegendFont 'Assign Legend font to buffer
IF .XAxis.Div < 1 THEN .XAXis.Div = 1 'Avoid division by zero
IF .YAxis.Div < 1 THEN .YAxis.Div = 1
SELECT CASE .ChartType
CASE ctXY
IF .XAxis.Labeled THEN
TicInc = (.XAxis.Max - .XAxis.Min) / .XAxis.Div
FOR i = 0 TO .XAxis.Div
IF .XAxis.LogScale = False THEN
TicVal = .XAxis.Min + TicInc * i 'below avoids precision artifact at 0
IF FIX(.XAxis.Ori + .XAxis.TicIntvl * i) = FIX(.XAxis.Zero) THEN TicVal = 0
ELSE 'Log Scale
TicVal = 10^(i + .XAxis.Min)
END IF
.AxisLbl.Text = FORMAT$("%-5.3g", TicVal)
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) / 2
.AxisLbl.Left = .XAxis.Ori + .XAxis.TicIntvl * i -_
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top, RTRIM$(.AxisLbl.Text),_
.Buffer.Font.Color, .bgColor)
NEXT
END IF
CASE ELSE 'X data are labels not values
IF .XAxis.Labeled = True THEN
SELECT CASE .ChartType
CASE ctLine
.XAxis.TicIntvl = .XAxis.Len / (.Data.RowCount -1)
CASE ELSE
.XAxis.TicIntvl = .XAxis.Len / .Data.RowCount
END SELECT
FOR i = 1 to .Data.RowCount
.AxisLbl.Text = .Data.Cell(0,i) 'Labels stored in Col 0 of each Row
SELECT CASE .ChartType
CASE ctLine
.AxisLbl.Left = .XAxis.Ori + (i - 1) * .Xaxis.TicIntvl -_
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
CASE ELSE
.AxisLbl.Left = .XAxis.Ori + (i-1) * .Xaxis.TicIntvl + [.Xaxis.TicIntvl -_
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text))] / 2
END SELECT
IF .Data.RowCount < 11 THEN
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) / 2
ELSE 'alternate up and down for room
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) *_
((i MOD 2) + .5)
END IF
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,RTRIM$(.AxisLbl.Text),_
.Buffer.Font.Color, .bgColor)
NEXT i
END IF
END SELECT
'ALL Charts have values on the Y Axis
IF .YAxis.Labeled = True THEN
TicInc = (.YAxis.Max - .YAxis.Min) / .YAxis.Div
FOR i = 0 TO .YAxis.Div
IF .YAXIS.LogScale = False THEN
TicVal = .YAxis.Min + TicInc * i 'below avoids precision artifact at 0
IF FIX(.YAxis.Ori - .YAxis.TicIntvl * i) = FIX(.YAxis.Zero) THEN TicVal = 0
ELSE 'Log Scaling
TicVal = 10^(i + .YAxis.Min)
END IF
.AxisLbl.Text = FORMAT$("%-5.3g",TicVal)
.AxisLbl.Top = .YAxis.Ori - .YAxis.TicIntvl * i_
- .Buffer.TextHeight(.AxisLbl.Text) / 2
.AxisLbl.Left = .XAxis.Ori - .Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) - 3
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,RTRIM$(.AxisLbl.Text),_
.Buffer.Font.Color, .bgColor)
NEXT
END IF
END WITH
END SUB
'---------------------------------------------------------------------------------------
SUB DrawLegend
DIM i AS INTEGER 'Loop counter...
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM GrpColor AS INTEGER
DIM BorderHgt AS INTEGER
WITH QChart
IF .DoLegend = False THEN EXIT SUB 'Don't perform task
.Buffer.Font = .LegendFont
x1 = (.XAxis.Ori + .XAxis.Len) + 6 'Draw a box for the legend
x2 = .Buffer.Width - 9
BorderHgt = .Buffer.TextHeight("Dummy") * (.Data.ColCount) + 5
IF .ChartType = ctXY THEN 'Special Case
BorderHgt = .Buffer.TextHeight("Dummy") * (.Data.ColCount / 2) + 5
END IF
y1 = .YAxis.Ori - (.YAxis.Len + BorderHgt) / 2
y2 = y1 + BorderHgt
.Buffer.Rectangle (x1,y1,x2,y2,.LegendFont.Color)
SELECT CASE .ChartType
CASE ctXY
FOR i = 2 to .Data.ColCount STEP 2
.Legend.Text = .Data.Cell(i - 1, 0)
.Legend.Top = y1 + .Buffer.TextHeight(.Legend.Text) * (i \ 2 -1) + 2
.Legend.Left = x1 + 4
x2 = .Legend.Left + .Buffer.TextHeight(.Legend.Text)
y2 = .Legend.Top + .Buffer.TextHeight(.Legend.Text)
GrpColor = .Colors((i \ 2 - 1) MOD UBOUND(QChart.Colors))'Cycle available colors
.Buffer.Rectangle(.Legend.Left, .Legend.Top + 2, x2, y2, .fgColor)
.Buffer.FillRect(.Legend.Left+1, .Legend.Top + 3, x2-1, y2-1, GrpColor)
.Buffer.TextOut (x2 + 2, .Legend.Top, RTRIM$(.Legend.Text),_
.fgColor, .bgColor)
NEXT
CASE ELSE 'Below works for all other charts
FOR i = 1 to .Data.ColCount
.Legend.Text = .Data.Cell(i,0)
.Legend.Top = y1 + .Buffer.TextHeight(.Legend.Text) * (i-1) + 2
.Legend.Left = x1 + 4
x2 = .Legend.Left + .Buffer.TextHeight(.Legend.Text)
y2 = .Legend.Top + .Buffer.TextHeight(.Legend.Text)
GrpColor = .Colors((i-1) MOD UBOUND(QChart.Colors))'Cycle through available colors
.Buffer.Rectangle(.Legend.Left, .Legend.Top + 2, x2, y2, .fgColor)
.Buffer.FillRect(.Legend.Left+1, .Legend.Top + 3, x2-1, y2-1, GrpColor)
.Buffer.TextOut (x2 + 2, .Legend.Top, RTRIM$(.Legend.Text),_
.fgColor, .bgColor)
NEXT
END SELECT
END WITH
END SUB
'---------------------------------------------------------------------------------------
SUB DrawBar (Overlay AS INTEGER)
'X Points are (OriX + VAL * XScaleFactor - XMin) (ScaleFactor = Axis.Len / Axis.Max)
'Y Points are (OriY - VAL * YScaleFactor - YMin) (i.e. ^^ = Pixels per Unit)
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM GrpColor AS INTEGER 'Color to use when drawing
DIM GrpWidth AS SINGLE
DIM BoxWidth AS SINGLE 'Width of bars in bar and box plots
IF Overlay = FALSE THEN
WITH QChart 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale
.XAxis.Div = .Data.RowCount 'Forces a grid line for each X Label
.XAxis.DrawZero = False 'No Values on the X
.DrawAxes
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
SELECT CASE QChart.ChartStyle
CASE csHisto 'Histogram (no spaces between bars)
WITH QChart 'Plot the data
BoxWidth = (.XAxis.Len - 2) / .Data.RowCount 'Leave some space at axis
FOR i = 1 to .Data.ColCount
IF .YAxis.Min * .YAxis.Max > 0 THEN 'Data does NOT span zero
FOR j = 1 to .Data.RowCount 'Draw the bars from X Axis up
x1 = (.XAxis.Ori + 1) + BoxWidth * (j-1)
y1 = .YAxis.Ori
x2 = (.XAxis.Ori + 1) + BoxWidth * (j)
y2 = .YAxis.Ori - ([VAL(.Data.Cell(i,j)) -.YAxis.Min] * .YAxis.ScaleFactor)
GrpColor = .Colors(7)
.Buffer.Rectangle(x1, y1, x2, y2, .fgColor)
.Buffer.FillRect(x1+1, y1, x2-1, y2+1, GrpColor)
NEXT j
ELSE 'Data spans zero
FOR j = 1 to .Data.RowCount 'Draw the bars From YAxis.Zero
x1 = (.XAxis.Ori + 1) + BoxWidth * (j-1) 'up for pos, down for neg
IF VAL(.Data.Cell(i,j)) > 0 THEN
y1 = .YAxis.Zero
ELSE 'let 0 line show
y1 = .YAxis.Zero + 1
END IF
x2 = (.XAxis.Ori + 1) + BoxWidth * (j)
y2 = .YAxis.Zero - (VAL(.Data.Cell(i,j)) * .YAxis.ScaleFactor)
GrpColor = .Colors(7)
.Buffer.Rectangle(x1, y1, x2, y2, .fgColor)
IF VAL(.Data.Cell(i,j)) > 0 THEN y2 = y2+1 ELSE y2 = y2-1
.Buffer.FillRect(x1+1, y1, x2-1, y2, GrpColor)
NEXT j
END IF
NEXT i
END WITH
CASE csBar 'Grouped Bar Chart (spaces between bars)
WITH QChart
GrpWidth = (.XAxis.Len - 2) / .Data.RowCount
BoxWidth = GrpWidth / (.Data.ColCount + .5)
FOR i = 1 to .Data.ColCount
GrpColor = .Colors((i-1) MOD UBOUND(QChart.Colors))'Cycle available colors
IF .YAxis.Min * .YAxis.Max > 0 THEN 'Data does NOT span zero
FOR j = 1 to .Data.RowCount 'Draw the bars from X Axis up
x1 = (.XAxis.Ori + BoxWidth / 4) + GrpWidth * (j - 1) + BoxWidth * (i - 1)
y1 = .YAxis.Ori
x2 = x1 + BoxWidth
y2 = .YAxis.Ori - ([VAL(.Data.Cell(i,j)) - .YAxis.Min] * .YAxis.ScaleFactor)
.Buffer.Rectangle(x1, y1, x2, y2, .fgColor)
.Buffer.FillRect(x1+1, y1, x2-1, y2+1, GrpColor)
NEXT j
ELSE 'Data spans zero
FOR j = 1 to .Data.RowCount 'Draw the bars From YAxis.Zero
x1 = (.XAxis.Ori + BoxWidth / 4) + GrpWidth * (j - 1) + BoxWidth * (i - 1)
IF VAL(.Data.Cell(i,j)) > 0 THEN
y1 = .YAxis.Zero
ELSE 'let 0 line show
y1 = .YAxis.Zero + 1
END IF
x2 = x1 + BoxWidth
y2 = .YAxis.Zero - (VAL(.Data.Cell(i,j)) * .YAxis.ScaleFactor)
.Buffer.Rectangle(x1, y1, x2, y2, .fgColor)
IF VAL(.Data.Cell(i,j)) > 0 THEN y2 = y2+1 ELSE y2 = y2-1
.Buffer.FillRect(x1+1, y1, x2-1, y2, GrpColor)
NEXT j
END IF
NEXT i
END WITH
END SELECT
QChart.ChartExists = True
QChart.Image.RePaint
END SUB
'---------------------------------------------------------------------------------------
SUB DrawXY (Overlay AS INTEGER)
'X Points are (OriX + VAL * XScaleFactor - XMin) (ScaleFactor = Axis.Len / Axis.Max)
'Y Points are (OriY - VAL * YScaleFactor - YMin) (i.e. ^^ = Pixels per Unit)
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM GrpColor AS INTEGER 'Color to use when drawing
DIM Radius AS SINGLE 'radius of circle for XY points
IF Overlay = FALSE THEN
WITH QChart 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale
IF .Success = False THEN 'Log Scaling failed
.ImagePaint
EXIT SUB
END IF
.DrawAxes
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
SELECT CASE QChart.ChartStyle
CASE csPointsOnly
Radius = 2.5
WITH QChart
FOR i = 2 to .Data.ColCount STEP 2
FOR j = 1 to .Data.RowCount
IF .XAxis.LogScale = False THEN
x1 = [VAL(.Data.Cell(i-1,j))-.XAxis.Min] * .XAxis.ScaleFactor - Radius
ELSE
x1 = ABS(.Log10(VAL(.Data.Cell(i-1,j)))-.XAxis.Min) * .XAxis.ScaleFactor - Radius
END IF
IF .YAxis.LogScale = False THEN
y1 = [VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor - Radius
ELSE
y1 = ABS(.Log10(VAL(.Data.Cell(i,j)))-.YAxis.Min) * .YAxis.ScaleFactor - Radius
END IF
x1 = .XAxis.Ori + x1
y1 = .YAxis.Ori - y1
x2 = x1 + Radius * 2
y2 = y1 - Radius * 2
GrpColor = .Colors((i \ 2 - 1) MOD UBOUND(QChart.Colors))'Cycle through available colors
.Buffer.Circle (x1 , y1 , x2 , y2 , QChart.Colors(0), GrpColor)
NEXT j
NEXT i
END WITH
CASE csLinesOnly 'add logic to deal with missing data here?
WITH QChart
FOR i = 2 to .Data.ColCount STEP 2
FOR j = 1 to .Data.RowCount - 1
IF .XAxis.LogScale = False THEN
x1 = [VAL(.Data.Cell(i-1,j))-.XAxis.Min] * .XAxis.ScaleFactor
x2 = [VAL(.Data.Cell(i-1,j+1))-.XAxis.Min] * .XAxis.ScaleFactor
ELSE
x1 = [.Log10(VAL(.Data.Cell(i-1,j)))-.XAxis.Min] * .XAxis.ScaleFactor
x2 = [.Log10(VAL(.Data.Cell(i-1,j+1)))-.XAxis.Min] * .XAxis.ScaleFactor
END IF
IF .YAxis.LogScale = False THEN
y1 = [VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor
y2 = [VAL(.Data.Cell(i,j+1))-.YAxis.Min] * .YAxis.ScaleFactor
ELSE
y1 = [.Log10(VAL(.Data.Cell(i,j)))-.YAxis.Min] *.YAxis.ScaleFactor
y2 = [.Log10(VAL(.Data.Cell(i,j+1)))-.YAxis.Min] *.YAxis.ScaleFactor
END IF
x1 = .XAxis.Ori + x1'[VAL(.Data.Cell(i-1,j))-.XAxis.Min] * .XAxis.ScaleFactor
y1 = .YAxis.Ori - y1'[VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor
x2 = .XAxis.Ori + x2'[VAL(.Data.Cell(i-1,j+1))-.XAxis.Min] * .XAxis.ScaleFactor
y2 = .YAxis.Ori - y2'[VAL(.Data.Cell(i,j+1))-.YAxis.Min] * .YAxis.ScaleFactor
GrpColor = .Colors((i \ 2 - 1) MOD UBOUND(QChart.Colors))'Cycle through available colors
.Buffer.Line (x1 , y1 , x2 , y2 , GrpColor)
NEXT j
NEXT i
END WITH
CASE csBoth
WITH QChart
.ChartStyle = csPointsOnly 'Points
.DrawXY (False) 'Draw Points (erase current)
.ChartStyle = csLinesOnly 'AND Lines
.DrawXY (True) 'Overlay Lines (do NOT erase)
.ChartStyle = csBoth 'Reset ChartStyle for repaints
END WITH
END SELECT
QChart.ChartExists = True
QChart.Image.RePaint
END SUB
'---------------------------------------------------------------------------------------
SUB DrawLine (Overlay AS INTEGER)
'X Points are (OriX + VAL * XScaleFactor - XMin) (ScaleFactor = Axis.Len / Axis.Max)
'Y Points are (OriY - VAL * YScaleFactor - YMin) (i.e. ^^ = Pixels per Unit)
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM GrpColor AS INTEGER 'Color to use when drawing
DIM Radius AS SINGLE 'radius of circle for XY points
IF Overlay = FALSE THEN
WITH QChart 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale
.XAxis.DrawZero = False 'No Values on the X
.XAxis.Div = .Data.RowCount - 1 'Forces a grid line for each X Label
.DrawAxes 'in DrawAxes Sub
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
SELECT CASE QChart.ChartStyle
CASE csLinesOnly
WITH QChart
.XAxis.TicIntvl = .XAxis.Len / (.Data.RowCount -1)
FOR i = 1 to .Data.ColCount
FOR j = 1 to .Data.RowCount - 1
x1 = .XAxis.Ori + (j - 1) * .Xaxis.TicIntvl
y1 = .YAxis.Ori - [VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor
x2 = .XAxis.Ori + (j) * .Xaxis.TicIntvl
y2 = .YAxis.Ori - [VAL(.Data.Cell(i,j + 1))-.YAxis.Min] * .YAxis.ScaleFactor
GrpColor = .Colors((i - 1) MOD UBOUND(QChart.Colors))'Cycle through available colors
.Buffer.Line (x1 , y1 , x2 , y2 , GrpColor)
NEXT j
NEXT i
END WITH
CASE csBoth
Radius = 2
WITH QChart
FOR i = 1 to .Data.ColCount
FOR j = 1 to .Data.RowCount
x1 = .XAxis.Ori + (j - 1) * .Xaxis.TicIntvl - Radius
y1 = .YAxis.Ori - [VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor - Radius
x2 = .XAxis.Ori + (j - 1) * .Xaxis.TicIntvl + Radius * 2
y2 = .YAxis.Ori - [VAL(.Data.Cell(i,j))-.YAxis.Min] * .YAxis.ScaleFactor + Radius * 2
GrpColor = .Colors((i - 1) MOD UBOUND(QChart.Colors))'Cycle available colors
.Buffer.Circle (x1 , y1 , x2 , y2 , QChart.Colors(0), GrpColor)
NEXT j
NEXT i
.ChartStyle = csLinesOnly
.DrawLine (True)
.ChartStyle = csBoth 'Reset Flag for redraws
END WITH
END SELECT
QChart.ChartExists = True
QChart.Image.RePaint
END SUB
'---------------------------------------------------------------------------------------
SUB DrawBox (Overlay AS INTEGER)
'X Points are (OriX + VAL * XScaleFactor - XMin) (ScaleFactor = Axis.Len / Axis.Max)
'Y Points are (OriY - VAL * YScaleFactor - YMin) (i.e. ^^ = Pixels per Unit)
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM x1 AS SINGLE 'for readability
DIM y1 AS SINGLE
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM GrpColor AS INTEGER
DIM XIntvl AS SINGLE 'Distance between plots
DIM LinWidth AS SINGLE 'Width od Mid Line
DIM LinColor AS INTEGER 'Change for Hi-Lo
DIM BoxWidth AS SINGLE 'Width of bars
IF Overlay = FALSE THEN
WITH QChart 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale
.Xaxis.Div = .Data.ColCount
.XAxis.DrawZero = False 'No Values on the X
.DrawAxes
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
WITH QChart
XIntvl = .XAxis.Len / (.Data.ColCount)
LinWidth = XIntvl * .75
BoxWidth = LinWidth * .75
FOR i = 1 to .Data.ColCount
GrpColor = .Colors((i-1) MOD UBOUND(QChart.Colors)) 'Cycle available colors
'--- Draw Min - Max Line (Whiskers)
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2
y1 = .YAxis.Ori - [VAL(.Data.Cell(i,5))-.YAxis.Min] * .YAxis.ScaleFactor'Min
x2 = x1
y2 = .YAxis.Ori - [VAL(.Data.Cell(i,1))-.YAxis.Min] * .YAxis.ScaleFactor'Max
.Buffer.Line (x1 , y1 , x2 , y2 , .fgColor)
.Buffer.Line (x1 - LinWidth / 4 , y1 , x2 + LinWidth / 4 , y1 , .fgColor)
.Buffer.Line (x1 - LinWidth / 4 , y2 , x2 + LinWidth / 4 , y2 , .fgColor)
'--- Draw Quartile Box
x1 = x1 - BoxWidth / 2
y1 = .YAxis.Ori - [VAL(.Data.Cell(i,4))-.YAxis.Min] * .YAxis.ScaleFactor'Q3
x2 = x1 + BoxWidth
y2 = .YAxis.Ori - [VAL(.Data.Cell(i,2))-.YAxis.Min] * .YAxis.ScaleFactor'Q4
.Buffer.Rectangle(x1, y1, x2, y2, .fgColor)
.Buffer.FillRect(x1+1, y1-1, x2-1, y2+1, GrpColor)
'--- Draw Median Line
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2 - LinWidth / 2
y1 = .YAxis.Ori - [VAL(.Data.Cell(i,3))-.YAxis.Min] * .YAxis.ScaleFactor'Q2
x2 = x1 + LinWidth
y2 = y1
IF .ChartStyle = csHiLo THEN LinColor = GrpColor ELSE LinColor = .Colors(12)
.Buffer.Line (x1 , y1 , x2 , y2 , LinColor)
IF .ChartStyle = csHiLo THEN LinColor = GrpColor ELSE LinColor = .fgColor
.Buffer.Rectangle(x1-1, y1-1, x2+1, y2+2, LinColor)
NEXT i
END WITH
QChart.ChartExists = True
QChart.Image.RePaint
END SUB
'---------------------------------------------------------------------------------------
SUB SaveChart (FileNam AS STRING)
ReShowSave:
WITH QChart
.dlgSave.Caption = "Save File"
.dlgSave.Filter = "Bitmap Files|*.bmp|All Files|*.*"
.dlgSave.FilterIndex = 1
IF INSTR(UCASE$(FileNam), ".BMP") = 0 THEN FileNam = FileNam + ".bmp"
.dlgSave.FileName = FileNam
IF .dlgSave.Execute AND LEN(.dlgSave.FileName) THEN
IF FileExists(.dlgSave.FileName) THEN 'check if file exists
DIM Response AS INTEGER 'ask user for decision
Response = MessageDlg("File Already Exists. Overwrite " + .dlgSave.FileName + "?",_
mtWarning, mbYes OR mbNo OR mbCancel, 0)
SELECT CASE Response
CASE mrNo 'don't overwrite, ask again
GOTO ReShowSave '<--- Use of a local GOTO loop!
CASE mrCancel 'don't overwrite, don't ask again
EXIT SUB
END SELECT
END IF
DIM File AS QFileStream
File.Open(.dlgSave.FileName, fmCreate)
.Buffer.SaveToStream (File) 'save the data
File.Close
END IF
END WITH
END SUB
'-------------------------------------------------------------------------------------------
SUB PrintChart (Prn AS INTEGER, Orient AS INTEGER, Margin AS INTEGER)
'Prints graph to a full page with a user specified margin
'As stated in the RapidQ documentation, StretchDraw will not work with all printers
'It does work on my HP 845C Inkjet but not my Xerox Docuprint P12 Laser :(
Printer.PrinterIndex = Prn
Printer.Orientation = Orient
DIM Page AS QRect
WITH Page
.Top = Margin
.Left = Margin
.Right = .Left + Printer.PageWidth - (Margin * 2)
.Bottom = .Top + Printer.PageHeight - (Margin * 2)
END WITH
Printer.BeginDoc
Printer.StretchDraw (Page, QChart.Buffer.BMP)
Printer.EndDoc
END SUB
'-------------------------------------------------------------------------------------------
'----- Form EVENT SUBs
SUB chtResize '<--- Call this SUB from your FORM.OnResize EVENT SUB
IF QChart.AppStart = True THEN 'Prevents initial resize events
QChart.AppStart = False 'from being executed b/f visible
EXIT SUB
END IF
WITH QChart.Image 'recalc dimensions
.Width = QChart.ClientWidth
.Height = QChart.ClientHeight
.Align = alClient
.Visible = True
END WITH
WITH QChart.Buffer 'recalc dimensions
.Width = QChart.Image.Width
.Height = QChart.Image.Height
END WITH
WITH QChart
IF .ChartExists THEN 'only redraw if QChart.ChartExists
SELECT CASE .ChartType
CASE ctBar
.DrawBar (False)
CASE ctXY
.DrawXY (False)
CASE ctLine
.DrawLine (False)
CASE ctBox
.DrawBox (False)
END SELECT
END IF
END WITH
END SUB
'-------------------------------------------------------------------------------------------
END TYPE'QChart
'----- End Object Definition ***********************************************************
'----- DEBUG SUBs
SUB watch (watch$)
MESSAGEDLG(watch$, 2, 4, 0)
END SUB