qchart.inc
'==============================================================================================
' QChart: A Charting Class for Rapid-Q
' Copyright (c) 2003-2004 Michael J. Zito
' Released under the LPGL License
' Build 3.6.04
'==============================================================================================
'
'QChart provides a rich set of 2-D charting routines for Rapid-Q programmers.
'It generates histograms, bar charts, XY-scatter plots, line graphs, pie charts
'and box plots. Each charting routine will calculate an appropriate scale and plot
'the data contained in the .Data or .XYData property of the object. The user may optionally
'specify the scaling as well as fonts, grids or other properties (see code and HTML
'documentation). Once the data is formatted graphs can be called with a few lines
'of simple code. (See QChartEx.rqb for examples of setting up and calling each chart type.)
'
' ----> To create an instance and call QChart:
'
' $INCLUDE "QChart.inc"
' CREATE YourInstanceName AS QChart
' Parent = QForm, QTabControl or QPanel
' Set any other desired properties of a QCanvas
' END CREATE
' WITH YourInstanceName
' .Initialize
' .ChartType = ctXXXX
' .ChartStyle = csXXXX
' ---->Change Any Desired Properties (See code or HTML Documentation)
' ---->REDIM .Data array property (See below)
' ---->Load Data Into .LabelList, .LegendList and .Data Array
' .DrawChart (Overlay T or F)
' END WITH
'
' NOTE: There is little error checking in this class. It is up to the user
' to insure that the data is formatted properly before calling each routine.
'
' LegendList and LabelList are implemented as QStringLists.
' *Use the .AddItems Method of each property to add text to the lists.
' *LegendList contains legend text and usually refers to the Cols (i.e. Series)
' *LabelList contains text used to label the X Axis and usually refers to Rows
' (i.e. Categories). LabelList items are NOT USED by XY Charts
'
' The .Data property is a 2 dimensional array of DOUBLE which must be REDIMd by the user
' prior to filling the grid with data. The first dim is Cols and the second is Rows.
' Each Col represents a series to be plotted. The Rows represent the data values
' within each series. Use the .Data property for all charts EXCEPT XY Charts.
'
' XY Charts have their own data array.
' The .XYData property is a 3 dimensional array of DOUBLE. The first dim is Cols and the
' second is Rows. The third dim is ALWAYS 2. Each Col represents a series to be plotted.
' The Rows represent the number of XY data pairs within each series. The third dimension
' refers to the X and Y data values for each point to be plotted: 1 = X and 2 = Y values
'
' ----> To REDIM the .Data or .XYData array property:
'
' You MUST set the .Cols and .Rows properties before calling QChart. These values are used
' throughout the QChart class as loop counters. Set .Cols to number of series to be plotted
' and set .Rows to number of values in each series. REDIM the array using .Cols and .Rows.
'
' NOTE: To REDIM you MUST EXPLICITLY REFERENCE your QChart instance by name (even inside a
' WITH block) or RapidQ will not find and REDIM the array. (A RapidQuirk?!?)
'
' WITH YourInstanceName
' .Cols = 2 <-- Num series
' .Rows = 2 <-- Num values in each series
' REDIM YourInstanceName.Data(.Cols, .Rows) <-- for all EXCEPT XY Charts
' REDIM YourInstanceName.XYData(.Cols, .Rows, 2) <-- for XY Charts
' END WITH
'
' ----> Sample Data Formats (given the DIMs above):
'
' XY Charts All Other Charts
' ===================== ================
' Series NumPts Values Series Values
' (Col) (Row) (dim 3) (Col) (Row)
' 1 1 1 <-- X 1 val 11
' 1 1 2 <-- Y 1 val 12
' 1 2 1 2 val 21
' 1 2 2 2 val 22
' 2 1 1
' 2 1 2
' 2 2 1
' 2 2 2
'
' Box Plots HiLo Plots Pie Charts BarLine Plots
' (5 rows only) (3 rows only) (1 Col only) (2 Cols only)
'================== ==================== ================ ==================
' Row 1 = Max Row 1 = Hi Col Row Col 1 Col 2
' 2 = Q3 2 = Close ======= ======= ======= =======
' 3 = Median 3 = Lo 1 1 Bar Line
' 4 = Q1 1 2 Data Data
' 5 = Min 1 n
'==============================================================================================
'----- Compiler Directives
$IFNDEF TRUE
$DEFINE TRUE 1
$ENDIF
$IFNDEF FALSE
$DEFINE FALSE 0
$ENDIF
'----- Win API Functions
DECLARE FUNCTION qcCreatePen LIB "gdi32" ALIAS "CreatePen" (nPenStyle AS LONG, nWidth AS LONG, crColor AS LONG)_
AS LONG
DECLARE FUNCTION qcCreateSolidBrush LIB "gdi32" ALIAS "CreateSolidBrush" (BYVAL crColor AS LONG) AS LONG
DECLARE FUNCTION qcCreateHatchBrush LIB "gdi32" ALIAS "CreateHatchBrush" (nIndex AS LONG, crColor AS LONG)_
AS LONG
DECLARE FUNCTION qcSelectObject LIB "gdi32" ALIAS "SelectObject" (hdc AS LONG,hObject AS LONG) AS LONG
DECLARE FUNCTION qcDeleteObject LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG
DECLARE FUNCTION qcSetBkColor LIB "gdi32" ALIAS "SetBkColor" (hdc AS LONG, crColor AS LONG) AS LONG
DECLARE FUNCTION qcMoveToEx LIB "gdi32" ALIAS "MoveToEx" (hdc AS LONG,x AS LONG,y AS LONG, lpPoint AS LONG)_
AS LONG
DECLARE FUNCTION qcLineTo LIB "gdi32" ALIAS "LineTo" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
DECLARE FUNCTION qcRectangle LIB "gdi32" ALIAS "Rectangle" (hdc AS LONG, X1 AS LONG, Y1 AS LONG, _
X2 AS LONG, Y2 AS LONG) AS LONG
DECLARE FUNCTION qcPie LIB "gdi32" ALIAS "Pie" (BYVAL hdc AS LONG, BYVAL X1 AS LONG, BYVAL Y1 AS LONG,_
BYVAL X2 AS LONG, BYVAL Y2 AS LONG, BYVAL X3 AS LONG,_
BYVAL Y3 AS LONG, BYVAL X4 AS LONG, BYVAL Y4 AS LONG)_
AS LONG
DECLARE FUNCTION qcGetCurrentObjectBmp LIB "gdi32" ALIAS "GetCurrentObject" (hdc AS LONG,uObjectType AS LONG)_
AS LONG
'----- PRIVATE QChart FUNCTIONs
DECLARE FUNCTION qcLog10 (Value AS DOUBLE) AS DOUBLE
DECLARE FUNCTION RowTotal (Row AS INTEGER) AS DOUBLE
DECLARE FUNCTION ColTotal (Col AS INTEGER) AS DOUBLE
'----- PRIVATE QChart SUBs
DECLARE SUB ClearBuffer
DECLARE SUB SetSize
DECLARE SUB ScaleAxis (Mn AS DOUBLE, Mx AS DOUBLE, Axis AS INTEGER)
DECLARE SUB SetScale (Start AS INTEGER, Finish AS INTEGER)
DECLARE SUB SetSeries
DECLARE SUB DrawAxes
DECLARE SUB DrawTitles
DECLARE SUB DrawLabels
DECLARE SUB DrawMarker (x1 AS SINGLE,y1 AS SINGLE,MrkrStyle AS INTEGER,COLOR AS LONG,Lgd AS BYTE)
DECLARE SUB DrawLegend
DECLARE SUB DrawBar (Overlay AS INTEGER, ColNum AS INTEGER)
DECLARE SUB DrawXY (Overlay AS INTEGER)
DECLARE SUB DrawLine (Overlay AS INTEGER, ColNum AS INTEGER)
DECLARE SUB DrawBox (Overlay AS INTEGER)
DECLARE SUB DrawPie (Overlay AS INTEGER)
DECLARE SUB DrawHiLo (Overlay AS INTEGER)
DECLARE SUB DrawReal (Overlay AS INTEGER)
'----- PUBLIC QChart Methods
DECLARE SUB Initialize
DECLARE SUB PaintChart
DECLARE SUB ClearAll
DECLARE SUB DrawChart (Overlay AS INTEGER)
DECLARE SUB RedrawChart
DECLARE SUB CopyToClipboard (Wid AS INTEGER, Hgt AS INTEGER)
DECLARE SUB SaveChart (SaveAs AS BYTE)
DECLARE SUB PrintChart (Prn AS INTEGER, Orient AS INTEGER, Margin AS INTEGER,_
Copies AS INTEGER, Colr AS BYTE)
'----- UDTs
TYPE AxisType
LEN AS SINGLE 'Axis length in pixels
Ori AS SINGLE 'Logical Origin in pixels
Min AS DOUBLE 'Minimum scale value
Max AS DOUBLE 'Maximum scale value
Div AS INTEGER 'Number of divisions on axis
ScaleFactor AS DOUBLE 'Factor for scaling values on axis
AutoScale AS BYTE 'TRUE = QChart scales, FALSE = User supplies Min/Max
COLOR AS LONG 'Color of axis
Grid AS BYTE 'TRUE = Draw Grid, FALSE = No Grid
Labeled AS BYTE 'TRUE = Label the Axis, FALSE = No Axis Labels
Zero AS SINGLE 'Location of zero in Pixels
DrawZero AS BYTE 'TRUE = Draw Zero Line, FALSE = No Zero Line
ZeroColor AS LONG 'Color of Zero Line
Tics AS BYTE 'TRUE = Draw Tic Marks, FALSE = No Tic Marks
MnrTics AS BYTE 'TRUE = Draw Minor Tic Marks, FALSE = No Tic Marks
STEP AS DOUBLE 'Step increment value of each tic
TicIntvl AS DOUBLE 'Distance between tics in world coordinates
TicLen AS SINGLE 'Size of tic mark in Pixels
LogScale AS BYTE 'TRUE = Log Scalin, FALSE = Linear Scaling
END TYPE
TYPE TitleType
Top AS INTEGER
Left AS INTEGER
Text AS STRING * 75
END TYPE
TYPE SeriesType
AutoColor AS BYTE 'Cycle available colors (T/F)
COLOR AS LONG 'Color to use
AutoMark AS BYTE 'Cycle available markers (T/F)
Marker AS BYTE 'Marker style to use
HatchStyle AS LONG 'Hatch Pattern to Use for Bars and Boxes
LineStyle AS LONG 'Line Style to use
LineWidth AS LONG 'Line Width to use
END TYPE
'----- Win API Constants
CONST lsSolid=0 'line styles
CONST lsDash=1
CONST lsDot=2
CONST lsDashDot=3
CONST lsDashDotDot=4
'hatch styles
CONST hsHoriz = 0 ' -----
CONST hsVert = 1 ' |||||
CONST hsFDiag = 2 ' \\\\\
CONST hsBDiag = 3 ' /////
CONST hsCross = 4 ' +++++
CONST hsXDiag = 5 ' xxxxx
CONST hsSolid = -1
'----- QChart Constants
CONST ctBar = 0 'Chart Type Flags
CONST ctLine = 1
CONST ctBarLine = 2
CONST ctBox = 3
CONST ctPie = 4
CONST ctHiLo = 5
CONST ctXY = 6
CONST ctReal = 7
CONST csHisto = 0 'Bar Chart Style Flags
CONST csBar = 1
CONST csStacked = 2
CONST csPctStacked = 3
CONST csPoints = 4 'XY and Line Chart Style Flags
CONST csLines = 5
CONST csBoth =6
CONST csAntenna = 7 'Hi Lo Style flag
CONST csHiLoBox = 8
CONST csPiePct = 9 'Pie Chart Style Flags
CONST csPieVal = 10
CONST msFillCircle = 1 'Marker Style Flags
CONST msFillSquare = 2
CONST msFillTriangleUp = 3
CONST msFillTriangleDown = 4
CONST msCircle = 5
CONST msSquare = 6
CONST msTriangleUp = 7
CONST msTriangleDown = 8
CONST MaxSeries = 26 'Maximum Number of Series that can be plotted
'----- Begin Object Definition ***********************************************************
TYPE QCHART EXTENDS QCANVAS
'---- Properties
PRIVATE:
Success AS BYTE 'TRUE or FALSE; set in log routines
Printing AS BYTE 'TRUE or FALSE; Update w/o screen redraw
hPen AS LONG 'Handle to current pen
OldPen AS LONG 'Handle to last used pen
hBrush AS LONG 'Handle to current brush
OldBrush AS LONG 'Handle to last used brush
Buffer AS QBITMAP 'Offscreen drawing buffer
CurrFile AS STRING 'FileName of Current Chart
PUBLIC:
Data(1,1) AS DOUBLE 'Data array Dims: 1=grp(cols), 2=values(rows)
XYData(1,1,2) AS DOUBLE 'XYData array Dims:1=grp, 2=values,3: 1=x,2=y
Cols AS INTEGER 'Num series (used to set array dim 1)
Rows AS INTEGER 'Num values in each series (used to set array dim 2)
LegendList AS QSTRINGLIST 'Holds Legend text
LabelList AS QSTRINGLIST 'Holds X Axis Label text
XAxis AS AxisType 'X-axis options
YAxis AS AxisType 'Y-axis options
Series(MaxSeries) AS SeriesType 'Series style info
bgColor AS LONG 'background color
fgColor AS LONG 'foreground color
ChartType AS BYTE 'ctBar, ctXY, ctBox etc...
ChartStyle AS BYTE 'csHisto, csLines, csPoints, csBoth etc...
MainTitle AS TitleType 'MainTitle Text and Location
MainFont AS QFONT
SubTitle AS TitleType 'SubTitle Text and Location
SubFont AS QFONT
XTitle AS TitleType 'X Axis Title Text and Location
YTitle AS TitleType 'Y Axis Title Text and Location
AxisLbl AS TitleType 'Axis Label Text and Location
AxisFont AS QFONT
DoLegend AS BYTE 'TRUE = Draw Legend, FALSE = No Legend
Legend AS TitleType 'Legend Text and Location
LegendFont AS QFONT
ChartBorder AS BYTE 'TRUE = Draw Frame around entire chart, FALSE = No Frame
AxisBorder AS BYTE 'TRUE = Draw Frame around Plot Area, FALSE = No Frame
Colors(30) AS LONG 'Array of colors; QChart chooses colors from this array
PlotAreaColor AS LONG 'Color of plot area background
GridColor AS LONG 'Color of grid lines
dlgSaveQC AS QSAVEDIALOG
MarkerSize AS SINGLE 'Sets size of drawn markers
BW AS BYTE 'TRUE = Use BW only, FALSE = Cycles Colors() array
GreyScale AS BYTE 'TRUE = Use GreyScale, FALSE = Cycles Colors() array
ChartExists AS BYTE 'TRUE or FALSE
Viewport AS INTEGER 'Viewport width for Real Time graphs
Missing AS DOUBLE 'Value used to test for missing data
CONSTRUCTOR
Parent = QFORM
Missing = -9.999E-45 'A rare value
Viewport = 100
'--- Expand and/or Redefine any way you like
Colors(0) = RGB(0,0,0) '-- Black
Colors(1) = RGB(0,0,175) '-- Blue
Colors(2) = RGB(175,0,0) '-- Red
Colors(3) = RGB(0,175,0) '-- Green
Colors(4) = RGB(0,175,175) '-- Cyan
Colors(5) = RGB(175,0,175) '-- Magenta
Colors(6) = RGB(192,192,0) '-- Yellow
Colors(7) = RGB(75,75,225) '-- Soft Blue
Colors(8) = RGB(225,75,75) '-- Soft Red
Colors(9) = RGB(75,225,75) '-- Soft Green
Colors(10) = RGB(75,215,230) '-- Soft Cyan
Colors(11) = RGB(215,75,215) '-- Soft Magenta
Colors(12) = RGB(215,230,75) '-- Soft Yellow
Colors(13) = RGB(128,128,255) '-- Torquoise
Colors(14) = RGB(240,128,128) '-- Rose Red
Colors(15) = RGB(192,220,192) '-- Money Green
Colors(16) = RGB(166,202,240) '-- Sky Blue
Colors(17) = RGB(199,177,255) '-- Lavender
Colors(18) = RGB(255,226,177) '-- Peach
Colors(19) = RGB(0,0,255) '-- Bright Blue
Colors(20) = RGB(255,0,0) '-- Bright Red
Colors(21) = RGB(0,255,0) '-- Bright Green
Colors(22) = RGB(0,255,255) '-- Bright Cyan
Colors(23) = RGB(255,0,255) '-- Bright Magenta
Colors(24) = RGB(255,255,0) '-- Bright Yellow
Colors(25) = RGB(255,153,51) '-- Orange
Colors(26) = RGB(255,51,153) '-- Pink
Colors(27) = RGB(80,80,80) '-- Dark Grey
Colors(28) = RGB(128,128,128) '-- Med Grey
Colors(29) = RGB(208,208,208) '-- Light Grey
Colors(30) = RGB(255,255,255) '-- Bright White
END CONSTRUCTOR
'------------------------------------------------------------------------------------------
'------------------------- Private Functions ----------------------------------------------
'------------------------------------------------------------------------------------------
PRIVATE:
FUNCTION RowTotal (Row AS INTEGER) AS DOUBLE
DIM i AS INTEGER
DIM Sum AS SINGLE
WITH QCHART
Sum = 0
FOR i = 1 TO .Cols
IF .Data(i,Row) <> .Missing THEN
Sum = Sum + ABS(.Data(i,Row))
END IF
NEXT
END WITH
RowTotal = Sum
END FUNCTION
'------------------------------------------------------------------------------------------
PRIVATE:
FUNCTION ColTotal (Col AS INTEGER) AS DOUBLE
DIM i AS INTEGER
DIM Sum AS SINGLE
WITH QCHART
Sum = 0
FOR i = 1 TO .Rows
IF .Data(Col,i) <> .Missing THEN
Sum = Sum + ABS(.Data(Col,i))
END IF
NEXT
END WITH
ColTotal = Sum
END FUNCTION
'------------------------------------------------------------------------------------------
PRIVATE:
FUNCTION qcLog10 (Value AS DOUBLE) AS DOUBLE
IF Value > 0 THEN
qcLog10 = LOG(Value) / LOG(10)
ELSE
MESSAGEDLG("qcLog10: Log of Value <= 0 Undefined", 1, 4, 0)
QCHART.Success = FALSE
EXIT FUNCTION
END IF
END FUNCTION
'------------------------------------------------------------------------------------------
PRIVATE:
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
'------------------------------------------------------------------------------------------
'------------------------- Public Methods -------------------------------------------------
'------------------------------------------------------------------------------------------
PUBLIC:
SUB Initialize 'Sets default values, make global changes here
DIM i AS INTEGER 'Loop Counters
DIM j AS INTEGER
WITH QCHART
.Buffer.Width = .ClientWidth
.Buffer.Height = .ClientHeight
.bgColor = .Colors(30) 'Bright White
.fgColor = .Colors(0) 'Black
.PlotAreaColor = .Colors(29) 'Light Grey
.GridColor = .Colors(27) 'Dark Grey
.ChartExists = FALSE
.Success = TRUE
.ChartBorder = TRUE
.AxisBorder = TRUE
.MarkerSize = 3
.BW = FALSE
.GreyScale = FALSE
.DoLegend = TRUE
.Printing = FALSE
.XAxis.Div = 10
.XAxis.AutoScale = TRUE
.XAxis.Labeled = TRUE
.XAxis.Tics = TRUE
.XAxis.MnrTics = TRUE
.XAxis.Grid = TRUE
.XAxis.DrawZero = TRUE
.XAxis.LogScale = FALSE
.XAxis.COLOR = 0
.XAxis.ZeroColor = QCHART.Colors(20)'Red
.YAxis.Div = 10
.YAxis.AutoScale = TRUE
.YAxis.Labeled = TRUE
.YAxis.Tics = TRUE
.YAxis.MnrTics = TRUE
.YAxis.Grid = TRUE
.YAxis.DrawZero = TRUE
.YAxis.LogScale = FALSE
.YAxis.COLOR = 0
.YAxis.ZeroColor = QCHART.Colors(20)'Red
.MainFont.Name = "Times New Roman"
.MainFont.Size = 18
.MainFont.COLOR = QCHART.Colors(0)
.MainFont.AddStyles(0) 'Bold
.SubFont.Name = "Times New Roman"
.SubFont.Size = 12
.SubFont.COLOR = QCHART.Colors(0)
.SubFont.AddStyles(0) 'Bold
.AxisFont.Name = "Times New Roman"
.AxisFont.Size = 10
.AxisFont.COLOR = QCHART.Colors(0)
.LegendFont.Name = "Times New Roman"
.LegendFont.Size = 9
.LegendFont.COLOR = QCHART.Colors(0)
FOR i = 1 TO MaxSeries 'Set Series Defaults
.Series(i).AutoColor = TRUE
.Series(i).COLOR = .fgColor
.Series(i).AutoMark = TRUE
.Series(i).Marker = msFillCircle
.Series(i).HatchStyle = hsSolid
.Series(i).LineStyle = lsSolid
.Series(i).LineWidth = 1
NEXT
.MainTitle.Text = "" 'Clear preexisting data
.SubTitle.Text = ""
.XTitle.Text = ""
.YTitle.Text = ""
.LegendList.Clear
.LabelList.Clear
SELECT CASE .ChartType 'Only clear 1st data point for speed
CASE ctXY 'assumes caller will overwrite the rest
.XYData(1,1,1) = .Missing
.XYData(1,1,2) = .Missing
CASE ELSE
.Data(1,1) = .Missing
END SELECT
.Cols = 1 'Set to minimum size
.Rows = 1
.ChartType = ctXY 'Set default chart type and style
.ChartStyle = csPoints
.CurrFile = "NewChart.bmp"
END WITH
END SUB
'------------------------------------------------------------------------------------------
PUBLIC:
SUB PaintChart 'Assign this to the QChart.OnPaint Event
'Draws Buffer.BMP to Canvas
WITH QCHART
.Draw(0, 0, .Buffer.BMP)
END WITH
END SUB
'------------------------------------------------------------------------------------------
PUBLIC:
SUB ClearAll
WITH QCHART
.Initialize
.ClearBuffer
.PaintChart
END WITH
END SUB
'------------------------------------------------------------------------------------------
'------------------------- Private Methods ------------------------------------------------
'------------------------------------------------------------------------------------------
PRIVATE:
SUB SetSize
DIM i AS INTEGER
DIM LegendLen AS INTEGER
WITH QCHART 'Set Origin and Axis Lengths
'relative to window and font sizes
.Buffer.Font = .AxisFont
.XAxis.Ori = .Buffer.TextWidth("8") * 16
IF .ChartType = ctPie THEN 'Leave room for right wedge labels
.Xaxis.Ori = .XAxis.Ori / 2
END IF
IF RTRIM$(.YTitle.Text) = "" THEN 'Y Axis is not labeld
.Xaxis.Ori = .XAxis.Ori / 1.5 'X Axis can start farther left
END IF
IF .DoLegend = FALSE THEN 'Make X Axis larger
.XAxis.LEN = .Buffer.Width - .XAxis.Ori * 1.5
ELSE 'Leave room for Legend
.Buffer.Font = .LegendFont
LegendLen = 0
FOR i = 0 TO .LegendList.ItemCount-1 'Get the longest legend text
IF .Buffer.TextWidth(.LegendList.Item(i)) > LegendLen THEN
LegendLen = .Buffer.TextWidth(.LegendList.Item(i))
END IF
NEXT i
LegendLen = LegendLen + .Buffer.TextWidth("WWWWI")'Pad for marker space
.XAxis.LEN = .Buffer.Width - (.XAxis.Ori + LegendLen)
END IF
.Buffer.Font = .AxisFont
.YAxis.Ori = .Buffer.Height - .Buffer.TextHeight(.XTitle.Text) * 5
IF .ChartType = ctPie OR RTRIM$(.XTitle.Text) = "" THEN 'X Axis not labeled
.YAxis.Ori = .Buffer.Height - .Buffer.TextHeight(.XTitle.Text) * 3
END IF
.YAxis.LEN = .YAxis.Ori - 20 'Minimum border
IF RTRIM$(.MainTitle.Text) <> "" THEN 'Make room for Main Title
.Buffer.Font = .MainFont
.YAxis.LEN = .YAxis.LEN - .Buffer.TextHeight(.MainTitle.Text)
END IF
IF RTRIM$(.SubTitle.Text) <> "" THEN 'Make room for Sub Title
.Buffer.Font = .SubFont
.YAxis.LEN = .YAxis.LEN - .Buffer.TextHeight(.SubTitle.Text)
END IF
END WITH
END SUB
'------------------------------------------------------------------------------------------
PRIVATE:
SUB ScaleAxis (Mn AS DOUBLE, Mx AS DOUBLE, Axis AS INTEGER)
DIM prec AS DOUBLE
DIM Incr AS DOUBLE
DIM Div AS INTEGER
DIM Range AS DOUBLE
DIM i AS INTEGER
DIM j AS DOUBLE
DIM Test AS DOUBLE
DIM pwr AS INTEGER
DIM LMn1 AS DOUBLE
DIM LMn2 AS DOUBLE
DIM LMx1 AS DOUBLE
DIM LMx2 AS DOUBLE
DIM SclMn AS DOUBLE
DIM SclMx AS DOUBLE
WITH QCHART
IF Axis = 0 THEN Div = .XAxis.Div ELSE Div = .YAxis.Div 'Set values for desired axis
IF Mx <= Mn THEN Mx = Mn + 1
Range = Mx - Mn
IF Mn >= 0 THEN
Mn = 0
ELSE
Mn = Mn - Range * .01 'Prevent plotting points on chart border
END IF
IF Mx <= 0 THEN
Mx = 0
ELSE
Mx = Mx + Range * .01 'Prevent plotting points on chart border
END IF
prec = .00002
Range = (Mx - Mn) / Div
pwr = FIX(.qcLog10(Range))
IF Range < 1 THEN pwr = pwr - 1
Incr = Range / (10^pwr) 'Calculate an even increment
FOR j = 1 TO 5
IF Incr < j + prec THEN EXIT FOR
NEXT j
FOR i = j TO 20
Test = i * 10^pwr
LMn1 = Mn / Test
LMn2 = FIX(LMn1)
IF LMn1 < 0 THEN LMn2 = LMn2 - 1
IF ABS(LMn2 + 1 - LMn1) < prec THEN LMn2 = LMn2 + 1
SclMn = Lmn2 * Test
LMx1 = Mx / Test
LMx2 = FIX(LMx1 + 1)
IF LMx1 < -1 THEN LMx2 = LMx2 - 1
IF ABS(LMx1 + 1 - LMx2) < Prec THEN LMx2 = LMx2 - 1
SclMx = LMx2 * Test
Range = LMx2 - LMn2
IF Range <= Div THEN EXIT FOR
NEXT i
Range = (Div - Range) / 2 'Set Scale min and max
SclMn = SclMn - Range * Test
SclMx = SclMn + Div * Test
IF SclMn > Mn THEN SclMn = Mn 'Prevent errors
IF SclMx < Mx THEN SclMx = Mx
IF Mn >= 0 AND SclMn < 0 THEN 'Remove divisions where no data plotted
SclMx = SclMx - SclMn 'so data takes up most of chart
IF SclMx > Mx THEN
Range = SclMx / Div
WHILE SclMx > Mx + Range * 1.01
SclMx = SclMx - Range
Div = Div - 1
WEND
END IF
SclMn = 0
END IF
IF Mx <= 0 AND SclMx > 0 THEN
SclMn = SclMn - SclMx
IF SclMn < Mn THEN
Range = SclMn / Div
WHILE SclMn < Mn + Range * 1.01
SclMn = SclMn - Range
Div = Div - 1
WEND
END IF
SclMx = 0
END IF
IF sclMn * sclMx < 0 THEN
Range = (SclMx - SclMn) / Div
IF SclMn < Mn THEN
WHILE SclMn < Mn - Range * 1.01
SclMn = SclMn + Range
Div = Div - 1
WEND
END IF
IF SclMx > Mx THEN
WHILE SclMx > Mx + Range * 1.01
SclMx = SclMx - Range
Div = Div - 1
WEND
END IF
END IF
SELECT CASE Axis
CASE 0 'Assign values to the X Axis
.XAxis.Min = SclMn
.XAxis.Max = SclMx
.XAxis.Div = Div
.XAxis.STEP = (SclMx - SclMn) / Div
CASE ELSE 'Assign values to the Y Axis
.YAxis.Min = SclMn
.YAxis.Max = SclMx
.YAxis.Div = Div
.YAxis.STEP = (SclMx - SclMn) / Div
END SELECT
END WITH
END SUB
'------------------------------------------------------------------------------------------
PRIVATE:
SUB SetScale (Start AS INTEGER, Finish AS INTEGER)
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM XMax AS DOUBLE
DIM XMin AS DOUBLE
DIM YMax AS DOUBLE
DIM YMin AS DOUBLE
DIM Test AS DOUBLE
XMax = -1e40 'Start Small
XMin = 1e40 'Start Big
YMax = -1e40 'Ditto
YMin = 1e40
WITH QCHART
SELECT CASE .ChartType
CASE ctXY
IF .XAxis.AutoScale = TRUE THEN 'Find X Data Min and Max
FOR i = 1 TO .Cols
FOR j = Start TO Finish'1 TO .Rows
IF .XYData(i,j,1) <> .Missing THEN
Test = .XYData(i,j,1)
IF Test < XMin THEN XMin = Test
IF Test > XMax THEN XMax = Test
END IF
NEXT j
NEXT i
END IF
IF .YAxis.AutoScale = TRUE THEN 'Find Y Data Min and Max
FOR i = 1 TO .Cols
FOR j = Start TO Finish'1 TO .Rows
IF .XYData(i,j,2) <> .Missing THEN
Test = .XYData(i,j,2)
IF Test < YMin THEN YMin = Test
IF Test > YMax THEN YMax = Test
END IF
NEXT j
NEXT i
END IF
CASE ELSE 'ctBar, ctLine, ctBox, ctHiLo
IF .YAxis.AutoScale = TRUE THEN 'Find Data Min and Max
SELECT CASE .ChartStyle
CASE csPctStacked
.YAxis.Min = 0
.YAxis.Max = 100
.YAxis.STEP = 10
.YAxis.ScaleFactor = .YAxis.LEN / 100
EXIT SUB
CASE csStacked
FOR i = Start TO Finish'1 TO .Rows
Test = .RowTotal(i)
IF Test < YMin THEN YMin = Test
IF Test > YMax THEN YMax = Test
NEXT i
CASE ELSE
FOR i = 1 TO .Cols
FOR j = Start TO Finish'1 TO .Rows
IF .Data(i,j) <> .Missing THEN
Test = .Data(i,j)
IF Test < YMin THEN YMin = Test
IF Test > YMax THEN YMax = Test
END IF
NEXT j
NEXT i
END SELECT
END IF
END SELECT
SELECT CASE .YAxis.LogScale
CASE FALSE
IF .YAxis.AutoScale = TRUE THEN
.ScaleAxis (YMin, YMax, 1)
ELSE 'Set step with user supplied min and max
IF .YAxis.Div < 1 THEN .YAxis.Div = 1
.YAxis.STEP = (.YAxis.Max - .YAxis.Min) / .YAxis.Div
END IF
.YAxis.ScaleFactor = .YAxis.LEN / (.YAxis.Max - .YAxis.Min)
.YAxis.Zero = .YAxis.Ori + .YAxis.Min * .YAxis.ScaleFactor
CASE TRUE 'See below for explanantion
.YAxis.Min = FLOOR(.qcLog10(YMin))
.YAxis.Max = CEIL(.qcLog10(YMax))
.YAxis.Div = (.YAxis.Max - .YAxis.Min)
.YAxis.ScaleFactor = .YAxis.LEN / .YAxis.Div
.YAxis.TicIntvl = .YAxis.ScaleFactor
END SELECT
IF .ChartType <> ctXY THEN EXIT SUB 'If not XY no Values on X Axis so Bail!
SELECT CASE .XAxis.LogScale
CASE FALSE
IF .XAxis.AutoScale = TRUE THEN
.ScaleAxis (XMin, XMax, 0)
ELSE 'Set step with user supplied min and max
IF .XAxis.Div < 1 THEN .XAxis.Div = 1
.XAxis.STEP = (.XAxis.Max - .XAxis.Min) / .XAxis.Div
END IF
.XAxis.ScaleFactor = .XAxis.LEN / (.XAxis.Max - .XAxis.Min)
.XAxis.Zero = .XAxis.Ori - .XAxis.Min * .XAxis.ScaleFactor
CASE TRUE 'Log Scale
.XAxis.Min = FLOOR(.qcLog10(XMin)) 'Set Min to Lower power of ten
.XAxis.Max = CEIL(.qcLog10(XMax)) 'Set Max to Greater power of ten
.XAxis.Div = (.XAxis.Max - .XAxis.Min) 'Div = # of Log Cycles
.XAxis.ScaleFactor = .XAxis.LEN / .XAxis.Div
.XAxis.TicIntvl = .XAxis.ScaleFactor
END SELECT
END WITH
END SUB
'------------------------------------------------------------------------------------------
PRIVATE:
SUB SetSeries 'Set up series colors and marker types
DIM i AS INTEGER
DIM Grey AS INTEGER
DIM NumShades AS INTEGER
DIM White AS INTEGER
WITH QCHART
SELECT CASE .ChartType
CASE ctBar, ctBox, ctPie, ctHiLo
NumShades = 5
White = 1
CASE ELSE
NumShades = 4
White = -1
END SELECT
FOR i = 1 TO .Cols
IF .Series(i).AutoMark=TRUE THEN .Series(i).Marker = (i-1) MOD 8 + 1
IF .Series(i).AutoColor=TRUE THEN
.Series(i).COLOR = .Colors((i) MOD (UBOUND(QCHART.Colors) + White))
END IF
IF .GreyScale = TRUE THEN
Grey = ((i-1) MOD NumShades) * 63
.Series(i).COLOR = RGB(Grey,Grey,Grey)
END IF
IF .BW = TRUE THEN .Series(i).COLOR = i
IF .BW = TRUE OR .GreyScale = TRUE THEN
.YAxis.ZeroColor = .Colors(0)
.XAxis.ZeroColor = .Colors(0)
END IF
NEXT
END WITH
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
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
x1 = 2 'Draw a frame around entire chart
y1 = 2
x2 = .Buffer.Width - 2
y2 = .Buffer.Height - 2
IF .ChartBorder = TRUE THEN .Buffer.Rectangle (x1, y1, x2, y2, .fgColor)
IF .ChartType = ctPie THEN EXIT SUB 'No Axes for Pie Charts
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 + 1, y2, .GridColor)
.Buffer.FillRect (x1 + 1, y1 + 1, x2, y2 + 1, .PlotAreaColor)
END IF
IF .XAxis.Tics = TRUE THEN 'Set Tic Size
.XAxis.TicLen = .YAxis.LEN * .01
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 - .Xaxis.TicLen
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,.GridColor)
NEXT
IF .ChartType = ctXY AND .XAxis.MnrTics = TRUE THEN
y1 = .YAxis.Ori - .XAxis.TicLen / 2
y2 = .YAxis.Ori + .XAxis.TicLen / 2
FOR i = 0 TO .XAxis.Div - 1
FOR j = 1 TO 4
x1 = .XAxis.Ori + .XAxis.TicIntvl * i + .XAxis.TicIntvl/5 * j
x2 = x1
.Buffer.Line (x1,y1,x2,y2,.GridColor)
NEXT
NEXT
END IF
ELSE 'draw log grid lines
FOR i = .XAxis.Min TO .XAxis.Max - 1
FOR j = 1 TO 9
x1 = .XAxis.Ori + (.qcLog10(10 ^ i * j) - .XAxis.Min) * .XAxis.ScaleFactor
x2 = x1
.Buffer.Line (x1,y1,x2,y2,.GridColor)
NEXT j
NEXT i
.Buffer.Line (.XAxis.Ori+.XAxis.LEN,y1,.XAxis.Ori+.XAxis.LEN,y2,.GridColor)
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 + .YAxis.TicLen
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,.GridColor)
NEXT
IF .YAxis.MnrTics = TRUE THEN
x1 = .XAxis.Ori - .YAxis.TicLen / 2
x2 = .XAxis.Ori + .YAxis.TicLen / 2
FOR i = 0 TO .YAxis.Div - 1
FOR j = 1 TO 4
y1 = .YAxis.Ori - .YAxis.TicIntvl * i - .YAxis.TicIntvl/5 * j
y2 = y1
.Buffer.Line (x1,y1,x2,y2,.GridColor)
NEXT
NEXT
END IF
ELSE 'draw log grid lines
FOR i = .YAxis.Min TO .YAxis.Max - 1
FOR j = 1 TO 9
y1 = .YAxis.Ori - (.qcLog10(10 ^ i * j) - .YAxis.Min) * .YAxis.ScaleFactor
y2 = y1
.Buffer.Line (x1,y1,x2,y2,.GridColor)
NEXT j
NEXT i
.Buffer.Line (x1,.YAxis.Ori-.YAxis.LEN,x2,.YAxis.Ori-.YAxis.LEN,.GridColor)
END IF
IF .XAxis.DrawZero = TRUE AND .XAxis.LogScale = FALSE THEN 'Draw the X 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 AND .YAxis.LogScale = FALSE 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
x1 = .XAxis.Ori 'Overwrite XAxis in its color
y1 = .YAxis.Ori
x2 = .XAxis.Ori + .XAxis.LEN
y2 = .YAxis.Ori
.Buffer.Line (x1, y1, x2, y2, .XAxis.COLOR)
x2 = .XAxis.Ori
y2 = .YAxis.Ori - .YAxis.LEN 'Overwrite YAxis in its color
.Buffer.Line (x1, y1, x2, y2, .YAxis.COLOR)
END WITH
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
SUB DrawTitles
DIM i AS INTEGER 'Loop counters...
DIM j AS INTEGER
DIM Spacer AS INTEGER
WITH QCHART
'--- Main Title
.Buffer.Font = .MainFont
.MainTitle.Left = .XAxis.Ori + (.XAxis.LEN - .Buffer.TextWidth(RTRIM$(.MainTitle.Text))) / 2
.MainTitle.Top = 10
.Buffer.TextOut (.MainTitle.Left, .MainTitle.Top, RTRIM$(.MainTitle.Text),_
.MainFont.COLOR, .bgColor)
'--- Sub Title
Spacer = .Buffer.TextHeight(.MainTitle.Text) 'Calc this before Font is Changed
.Buffer.Font = .SubFont
.SubTitle.Left = .XAxis.Ori + (.XAxis.LEN - .Buffer.TextWidth(RTRIM$(.SubTitle.Text))) / 2
IF RTRIM$(.MainTitle.Text) = "" THEN 'No Main Title
.SubTitle.Top = .MainTitle.Top 'Put Subtitle in Main title spot
ELSE
.SubTitle.Top = .MainTitle.Top + Spacer
END IF
.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) * 2.75
.Buffer.TextOut (.XTitle.Left, .XTitle.Top, RTRIM$(.XTitle.Text),_
.AxisFont.COLOR, .bgColor)
'--- Y Axis Title
j = LEN(RTRIM$ (.YTitle.Text))
.YTitle.Left = .XAxis.Ori / 3.5
.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
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
SUB DrawLabels
DIM i AS INTEGER
DIM TicVal AS DOUBLE 'Value of tic label
DIM LabelLen AS SINGLE 'Total length of Labels
WITH QCHART
IF .XAxis.Labeled = FALSE AND .YAxis.Labeled = FALSE THEN EXIT SUB
.Buffer.Font = .AxisFont 'Assign Axis 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 = TRUE THEN
LabelLen = 0 'Get the total length of all labels
FOR i = 0 TO .XAxis.Div
TicVal = .XAxis.Min + .XAxis.STEP * i
LabelLen = LabelLen + .Buffer.TextWidth(FORMAT$("%-4.4g", TicVal))
NEXT
FOR i = 0 TO .XAxis.Div
IF .XAxis.LogScale = FALSE THEN
TicVal = .XAxis.Min + .XAxis.STEP * i 'below avoids precision artifact at 0
IF ABS((.XAxis.Ori + .XAxis.TicIntvl * i) - .XAxis.Zero) < 1 THEN TicVal = 0
ELSE 'Log Scale
TicVal = 10^(i + .XAxis.Min)
END IF
.AxisLbl.Text = FORMAT$("%-4.4g", TicVal)
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) / 2
.AxisLbl.Left = .XAxis.Ori + .XAxis.TicIntvl * i -_
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
IF LabelLen * 1.1 <= .XAxis.LEN THEN 'Label all tics
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top, RTRIM$(.AxisLbl.Text),_
.Buffer.Font.COLOR, .bgColor)
ELSE 'Label every other tic
IF i MOD 2 = 0 THEN .Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,_
RTRIM$(.AxisLbl.Text), .Buffer.Font.COLOR, .bgColor)
END IF
NEXT
END IF
CASE ELSE
IF .XAxis.Labeled = TRUE THEN
SELECT CASE .ChartType
CASE ctBox, ctHiLo
.XAxis.TicIntvl = .XAxis.LEN / .Cols
CASE ELSE
.XAxis.TicIntvl = .XAxis.LEN / .Rows
END SELECT
LabelLen = 0 'Get the total length of all labels
FOR i = 0 TO .LabelList.ItemCount-1
LabelLen = LabelLen + .Buffer.TextWidth(.LabelList.Item(i))
NEXT i
FOR i = 0 TO .LabelList.ItemCount-1
.AxisLbl.Text = .LabelList.Item(i)
IF .ChartStyle = csHisto THEN 'start at Y Axis
.AxisLbl.Left = .XAxis.Ori + (i) * .Xaxis.TicIntvl - _
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
ELSE ' Center between tics
.AxisLbl.Left = .XAxis.Ori + (i) * .Xaxis.TicIntvl + (.Xaxis.TicIntvl -_
.Buffer.TextWidth(RTRIM$(.AxisLbl.Text))) / 2
END IF
IF LabelLen * 1.1 <= .XAxis.LEN 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
IF .YAxis.Labeled = TRUE THEN 'ALL Charts have values on the Y Axis
FOR i = 0 TO .YAxis.Div
IF .YAXIS.LogScale = FALSE THEN
TicVal = .YAxis.Min + .YAxis.STEP * i 'below avoids precision artifact at 0
IF ABS((.YAxis.Ori - .YAxis.TicIntvl * i) - .YAxis.Zero) < 1 THEN TicVal = 0
ELSE 'Log Scaling
TicVal = 10^(i + .YAxis.Min)
END IF
.AxisLbl.Text = FORMAT$("%-4.4g",TicVal)
.AxisLbl.Top = .YAxis.Ori - .YAxis.TicIntvl * i_
- .Buffer.TextHeight(.AxisLbl.Text) / 2
.AxisLbl.Left = .XAxis.Ori - .Buffer.TextWidth(RTRIM$(.AxisLbl.Text))-_
.Buffer.TextWidth("8")
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,RTRIM$(.AxisLbl.Text),_
.Buffer.Font.COLOR, .bgColor)
NEXT
END IF
END WITH
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
SUB DrawMarker (x1 AS SINGLE, y1 AS SINGLE, MrkrStyle AS INTEGER, COLOR AS LONG, Lgd AS BYTE)
DIM x2 AS SINGLE
DIM y2 AS SINGLE
DIM FillColor AS LONG
WITH QCHART
IF Lgd = FALSE THEN
FillColor = .PlotAreaColor
ELSE
FillColor = .bgColor
END IF
x1 = x1 - .MarkerSize 'MarkerSize is set in .Intitalize or
y1 = y1 - .MarkerSize 'changed by user
x2 = x1 + .MarkerSize * 2
y2 = y1 + .MarkerSize * 2
SELECT CASE MrkrStyle 'Sent by calling routine
CASE msFillCircle
.Buffer.Circle (x1 , y1 , x2 , y2 , COLOR, COLOR)
CASE msFillSquare
.Buffer.FillRect (x1 , y1 , x2 , y2 , COLOR)
CASE msFillTriangleUp
.Buffer.Line (x1, y2, x2, y2, COLOR)
.Buffer.Line (x1, y2 , x1 + .MarkerSize, y1, COLOR)
.Buffer.Line (x2, y2 , x1 + .MarkerSize, y1, COLOR)
.Buffer.Paint (x1 + .MarkerSize, y1 + .MarkerSize, COLOR, COLOR)
CASE msFillTriangleDown
y2 = y2 - .MarkerSize * 2
.Buffer.Line (x1, y2, x2, y2, COLOR)
.Buffer.Line (x1, y2 , x1 + .MarkerSize, y1 + .MarkerSize * 2, COLOR)
.Buffer.Line (x2, y2 , x1 + .MarkerSize, y1 + .MarkerSize * 2, COLOR)
.Buffer.Paint (x1 + .MarkerSize, y1 + .MarkerSize, COLOR, COLOR)
CASE msCircle
.Buffer.Circle (x1 , y1 , x2 , y2 , COLOR, FillColor)
CASE msSquare
.Buffer.Rectangle (x1 , y1 , x2 , y2 , COLOR)
.Buffer.Paint (x1 + .MarkerSize, y1 + .MarkerSize, FillColor, COLOR)
CASE msTriangleUp
.Buffer.Line (x1, y2, x2, y2, COLOR)
.Buffer.Line (x1, y2 , x1 + .MarkerSize, y1, COLOR)
.Buffer.Line (x2, y2 , x1 + .MarkerSize, y1, COLOR)
.Buffer.Paint (x1 + .MarkerSize, y1 + .MarkerSize, FillColor, COLOR)
CASE msTriangleDown
y2 = y2 - .MarkerSize * 2
.Buffer.Line (x1, y2, x2, y2, COLOR)
.Buffer.Line (x1, y2 , x1 + .MarkerSize, y1 + .MarkerSize * 2, COLOR)
.Buffer.Line (x2, y2 , x1 + .MarkerSize, y1 + .MarkerSize * 2, COLOR)
.Buffer.Paint (x1 + .MarkerSize, y1 + .MarkerSize, FillColor, COLOR)
END SELECT
END WITH
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
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 BorderHgt AS INTEGER
DIM LineLen AS INTEGER
DIM LMark AS INTEGER
WITH QCHART
IF .DoLegend = FALSE THEN EXIT SUB 'Don't perform task
.Buffer.Font = .LegendFont
x1 = (.XAxis.Ori + .XAxis.LEN) + .Buffer.TextWidth("W") 'Draw a box for the legend
x2 = .Buffer.Width - .Buffer.TextWidth("W")
LineLen = x2 - x1 - .Buffer.TextWidth("W") * 2.5
IF .ChartType = ctPie THEN
BorderHgt = .Buffer.TextHeight("W") * (.Rows) + 5
ELSE
BorderHgt = .Buffer.TextHeight("W") * (.Cols) + 5
END IF
IF .ChartStyle = csLines THEN BorderHgt = BorderHgt * 1.5 'Leave room for line styles
y1 = .YAxis.Ori - (.YAxis.LEN + BorderHgt) / 2
y2 = y1 + BorderHgt
.Buffer.Rectangle (x1,y1,x2,y2,.fgColor)
qcSetBkColor (.Buffer.Handle, .bgColor)
.Buffer.Line (0,0,0,0,0) 'Reset Buffer's pen to Black
FOR i = 0 TO .LegendList.ItemCount - 1 'For each item in the legend
.Legend.Text = .LegendList.Item(i)
.Legend.Top = y1 + .Buffer.TextHeight(.Legend.Text) * i + 2
.Legend.Left = x1 + .Buffer.TextWidth("I")
x2 = .Legend.Left + .Buffer.TextHeight(.Legend.Text)
y2 = .Legend.Top + .Buffer.TextHeight(.Legend.Text)
IF .ChartType = ctLine OR .ChartType = ctXY OR .ChartType = ctReal THEN
IF .ChartStyle <> csLines THEN
LMark = .MarkerSize
.MarkerSize = .Buffer.TextHeight(.Legend.Text) / 3
.DrawMarker (.Legend.Left + .Buffer.TextHeight(.Legend.Text) / 3,_
.Legend.Top + .Buffer.TextHeight(.Legend.Text) / 2,_
.Series(i+1).Marker, .Series(i+1).COLOR,1)
.Buffer.TextOut (x2 + 2, .Legend.Top, RTRIM$(.Legend.Text),_
.LegendFont.COLOR, .bgColor)
.MarkerSize = LMark
ELSE
.Legend.Top = .Legend.Top + .Buffer.TextHeight(.Legend.Text)/2 * i
.hPen = qcCreatePen(.Series(i+1).LineStyle, .Series(i+1).LineWidth, .Series(i+1).COLOR)
.OldPen = qcSelectObject(.Buffer.Handle, .hPen)
qcMoveToEx(.Buffer.Handle,.Legend.Left + 2, y2 + .Series(i+1).LineWidth +_
.Buffer.TextHeight(.Legend.Text)/2 * i , 0)
qcLineTo(.Buffer.Handle,x2 + LineLen, y2 + .Series(i+1).LineWidth +_
.Buffer.TextHeight(.Legend.Text)/2 * i)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldPen))
.Buffer.TextOut (x2 - .Buffer.TextWidth("T") , .Legend.Top, RTRIM$(.Legend.Text),_
.LegendFont.COLOR, .bgColor)
END IF
ELSE
IF .Series(i+1).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(i+1).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i+1).HatchStyle, .Series(i+1).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcRectangle (.Buffer.Handle, .Legend.Left, .Legend.Top + 2, x2, y2)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
.Buffer.TextOut (x2 + 2, .Legend.Top, RTRIM$(.Legend.Text),_
.LegendFont.COLOR, .bgColor)
END IF
NEXT
END WITH
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
SUB DrawBar (Overlay AS INTEGER, ColNum 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 GrpWidth AS SINGLE
DIM BoxWidth AS SINGLE 'Width of bars in bar and box plots
DIM Incr AS SINGLE 'Space between bars
DIM Total AS SINGLE 'Row Total for % Stacked calcs
DIM Start AS INTEGER
DIM Finish AS INTEGER
IF ColNum = 0 THEN 'Normal, plot all cols
Start = 1
Finish = QCHART.Cols
ELSE 'BarLine chart, plot specified
Start = ColNum 'ColNum only
Finish = ColNum
END IF
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows)
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.XAxis.Div = .Rows '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 + .01) / .Rows 'Leave some space at axis
FOR i = Start TO Finish 'Col 1 if BarLine else all .Cols
IF .Series(i).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(i).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i).HatchStyle, .Series(i).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
Incr = BoxWidth * (i-1) / (.Cols + 1)
GrpWidth = BoxWidth - Incr
FOR j = 1 TO .Rows
IF .Data(i,j) = .Missing THEN GOTO NoPlotHisto
x1 = .XAxis.Ori + BoxWidth * (j-1) + Incr/2
x2 = x1 + GrpWidth + 1
IF .YAxis.LogScale = TRUE THEN
y1 = .YAxis.Ori
y2 = .YAxis.Ori - (.qcLog10(.Data(i,j)) - .YAxis.Min) * .YAxis.ScaleFactor
ELSEIF .YAxis.Min >= 0 AND .YAxis.Max >= 0 THEN 'No Negative data
y1 = .YAxis.Ori
y2 = .YAxis.Ori - (.Data(i,j) - .YAxis.Min) * .YAxis.ScaleFactor
ELSE 'Have Negative values
y1 = .YAxis.Zero
y2 = .YAxis.Zero - (.Data(i,j) * .YAxis.ScaleFactor)
END IF
qcRectangle (.Buffer.Handle,x1,y1,x2,y2)
NoPlotHisto:
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
CASE csBar 'Grouped Bar Chart (spaces between bars)
WITH QCHART
GrpWidth = (.XAxis.LEN + .01) / .Rows
IF ColNum = 0 THEN 'Normal, use all cols
BoxWidth = GrpWidth / (.Cols + .5)
ELSE 'BarLine chart, only 1 series
BoxWidth = GrpWidth / 1.5
END IF
FOR i = Start TO Finish 'Col 1 if BarLine else all .Cols
IF .Series(i).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(i).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i).HatchStyle, .Series(i).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
FOR j = 1 TO .Rows
IF .Data(i,j) = .Missing THEN GOTO NoPlotBar
x1 = (.XAxis.Ori + BoxWidth / 4) + GrpWidth * (j - 1) + BoxWidth * (i - 1)
x2 = x1 + BoxWidth + 1
IF .YAxis.LogScale = TRUE THEN
y1 = .YAxis.Ori
y2 = .YAxis.Ori - (.qcLog10(.Data(i,j))-.YAxis.Min) * .YAxis.ScaleFactor
ELSEIF .YAxis.Min >= 0 AND .YAxis.Max >= 0 THEN 'No Negative data
y1 = .YAxis.Ori
y2 = .YAxis.Ori - (.Data(i,j) -.YAxis.Min) * .YAxis.ScaleFactor
ELSE 'Have Negative values
y1 = .YAxis.Zero
y2 = .YAxis.Zero - (.Data(i,j) * .YAxis.ScaleFactor)
END IF
qcRectangle (.Buffer.Handle,x1,y1,x2,y2)
NoPlotBar:
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
CASE csStacked
WITH QCHART
BoxWidth = (.XAxis.LEN + .01) / (.Rows + 1)
Incr = BoxWidth / .Rows
FOR i = 1 TO .Rows
FOR j = 1 TO .Cols
IF .Series(j).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(j).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(j).HatchStyle, .Series(j).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
x1 = (.XAxis.Ori + Incr/2) + (BoxWidth + Incr) * (i-1)
x2 = x1 + BoxWidth
IF j = 1 THEN y1 = .YAxis.Ori ELSE y1 = y2
y2 = y1 - (ABS(.Data(j,i))- .YAxis.Min) * .YAxis.ScaleFactor
qcRectangle (.Buffer.Handle,x1,y1+1,x2+1,y2)
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
CASE csPctStacked
WITH QCHART
BoxWidth = (.XAxis.LEN + .01) / (.Rows +1)
Incr = BoxWidth / .Rows
FOR i = 1 TO .Rows
Total = .RowTotal(i)
IF Total = 0 THEN
MESSAGEDLG("Division by Zero!", 1, 4, 0)
.ClearAll
EXIT SUB
END IF
FOR j = 1 TO .Cols
IF .Series(j).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(j).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(j).HatchStyle, .Series(j).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
x1 = (.XAxis.Ori + Incr/2) + (BoxWidth + Incr) * (i-1)
x2 = x1 + BoxWidth
IF j = 1 THEN y1 = .YAxis.Ori ELSE y1 = y2
y2 = y1 - (100 * (ABS(.Data(j,i))/Total) * .YAxis.ScaleFactor)
qcRectangle (.Buffer.Handle,x1,y1+1,x2+1,y2)
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
END SELECT
QCHART.ChartExists = TRUE
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
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
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows)
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.DrawAxes
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
SELECT CASE QCHART.ChartStyle
CASE csPoints
WITH QCHART
FOR i = 1 TO .Cols
FOR j = 1 TO .Rows
IF .XYData(i,j,1)=.Missing THEN GOTO NoPlotXYPt 'If data missing
IF .XYData(i,j,2)=.Missing THEN GOTO NoPlotXYPt
IF .XAxis.LogScale = FALSE THEN
x1 = .XAxis.Ori + (.XYData(i,j,1)-.XAxis.Min) * .XAxis.ScaleFactor
ELSE
x1 = .XAxis.Ori + (.qcLog10(.XYData(i,j,1))-.XAxis.Min) * .XAxis.ScaleFactor
END IF
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.XYData(i,j,2)-.YAxis.Min) * .YAxis.ScaleFactor
ELSE
y1 = .YAxis.Ori - (.qcLog10(.XYData(i,j,2))-.YAxis.Min) * .YAxis.ScaleFactor
END IF
.DrawMarker (x1, y1, .Series(i).Marker, .Series(i).COLOR,0)
NoPlotXYPt:
NEXT j
NEXT i
END WITH
CASE csLines
WITH QCHART
qcSetBkColor (.Buffer.Handle, .PlotAreaColor)
FOR i = 1 TO .Cols
.hPen = qcCreatePen(.Series(i).LineStyle, .Series(i).LineWidth, .Series(i).COLOR)
.OldPen = qcSelectObject(.Buffer.Handle, .hPen)
FOR j = 1 TO .Rows - 1
IF .XYData(i,j,1)=.Missing OR .XYData(i,j+1,1)=.Missing THEN GOTO NoPlotXYLn
IF .XYData(i,j,2)=.Missing OR .XYData(i,j+1,2)=.Missing THEN GOTO NoPlotXYLn
IF .XAxis.LogScale = FALSE THEN
x1 = (.XYData(i,j,1)-.XAxis.Min) * .XAxis.ScaleFactor
x2 = (.XYData(i,j+1,1)-.XAxis.Min) * .XAxis.ScaleFactor
ELSE
x1 = (.qcLog10(.XYData(i,j,1))-.XAxis.Min) * .XAxis.ScaleFactor
x2 = (.qcLog10(.XYData(i,j+1,1))-.XAxis.Min) * .XAxis.ScaleFactor
END IF
IF .YAxis.LogScale = FALSE THEN
y1 = (.XYData(i,j,2)-.YAxis.Min) * .YAxis.ScaleFactor
y2 = (.XYData(i,j+1,2)-.YAxis.Min) * .YAxis.ScaleFactor
ELSE
y1 = (.qcLog10(.XYData(i,j,2))-.YAxis.Min) *.YAxis.ScaleFactor
y2 = (.qcLog10(.XYData(i,j+1,2))-.YAxis.Min) *.YAxis.ScaleFactor
END IF
x1 = .XAxis.Ori + x1
y1 = .YAxis.Ori - y1
x2 = .XAxis.Ori + x2
y2 = .YAxis.Ori - y2
'--- Use API to draw lines
qcMoveToEx(.Buffer.handle,x1,y1,0)
qcLineTo(.Buffer.handle,x2,y2)
NoPlotXYLn:
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldPen))
NEXT i
END WITH
CASE csBoth
WITH QCHART
.ChartStyle = csPoints 'Draw Points
.DrawXY (Overlay) 'Draw Points (May erase current)
.ChartStyle = csLines 'AND Lines
.DrawXY (TRUE) 'Overlay Lines (do NOT erase)
.ChartStyle = csBoth 'Reset ChartStyle for repaints
END WITH
END SELECT
QCHART.ChartExists = TRUE
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
SUB DrawLine (Overlay AS INTEGER, ColNum 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 Start AS INTEGER
DIM Finish AS INTEGER
IF ColNum = 0 THEN 'Normal, plot all cols
Start = 1
Finish = QCHART.Cols
ELSE 'BarLine chart, plot specified
Start = ColNum 'ColNum only
Finish = ColNum
END IF
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows)
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.XAxis.Div = .Rows '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 csPoints
WITH QCHART
FOR i = Start TO Finish 'Col 2 if BarLine else all .Cols
FOR j = 1 TO .Rows
IF .Data(i,j)=.Missing THEN GOTO NoPlotLinePt 'If data missing
IF j = 1 THEN
x1 = .XAxis.Ori + .Xaxis.TicIntvl * .5
ELSE
x1 = x1 + .Xaxis.TicIntvl
END IF
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,j)-.YAxis.Min) * .YAxis.ScaleFactor
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,j))-.YAxis.Min) *.YAxis.ScaleFactor
END IF
.DrawMarker (x1, y1, .Series(i).Marker, .Series(i).COLOR,0)
NoPlotLinePt:
NEXT j
NEXT i
END WITH
CASE csLines
WITH QCHART
qcSetBkColor (.Buffer.Handle, .PlotAreaColor)
FOR i = Start TO Finish 'Col 2 if BarLine else all .Cols
.hPen = qcCreatePen(.Series(i).LineStyle, .Series(i).LineWidth, .Series(i).COLOR)
.OldPen = qcSelectObject(.Buffer.Handle, .hPen)
FOR j = 1 TO .Rows - 1
IF .Data(i,j)=.Missing OR .Data(i,j+1)=.Missing THEN GOTO NoPlotLineLn
IF j = 1 THEN
x1 = .XAxis.Ori + .Xaxis.TicIntvl * .5
ELSE
x1 = x2
END IF
x2 = x1 + .Xaxis.TicIntvl
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,j)-.YAxis.Min) * .YAxis.ScaleFactor
y2 = .YAxis.Ori - (.Data(i,j+1)-.YAxis.Min) * .YAxis.ScaleFactor
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,j))-.YAxis.Min) *.YAxis.ScaleFactor
y2 = .YAxis.Ori - (.qcLog10(.Data(i,j+1))-.YAxis.Min) *.YAxis.ScaleFactor
END IF
'--- Use API to draw lines
qcMoveToEx(.Buffer.handle,x1,y1,0)
qcLineTo(.Buffer.handle,x2,y2)
NoPlotLineLn:
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldPen))
NEXT i
END WITH
CASE csBoth
WITH QCHART
.ChartStyle = csPoints 'Draw Points
.DrawLine (Overlay,ColNum) 'Draw Points (May erase current)
.ChartStyle = csLines 'AND Lines
.DrawLine (TRUE,ColNum) 'Overlay Lines (do NOT erase)
.ChartStyle = csBoth 'Reset ChartStyle for repaints
END WITH
END SELECT
QCHART.ChartExists = TRUE
END SUB
'---------------------------------------------------------------------------------------
PRIVATE:
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 XIntvl AS SINGLE 'Distance between plots
DIM LinWidth AS LONG 'Width od Mid Line
DIM LinColor AS LONG 'Change for Hi-Lo
DIM BoxWidth AS LONG 'Width of bars
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows)
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.Xaxis.Div = .Cols
.XAxis.DrawZero = FALSE 'No Values on the X
.DrawAxes
.DrawTitles
.DrawLabels
.DrawLegend
END WITH
END IF
WITH QCHART
XIntvl = .XAxis.LEN / .Cols
LinWidth = XIntvl * .75
BoxWidth = LinWidth * .75
FOR i = 1 TO .Cols
'--- Draw Min - Max Line (Whiskers)
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2
x2 = x1
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,5)-.YAxis.Min) * .YAxis.ScaleFactor 'Min
y2 = .YAxis.Ori - (.Data(i,1)-.YAxis.Min) * .YAxis.ScaleFactor 'Max
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,5))-.YAxis.Min) * .YAxis.ScaleFactor 'Min
y2 = .YAxis.Ori - (.qcLog10(.Data(i,1))-.YAxis.Min) * .YAxis.ScaleFactor 'Max
END IF
.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
x2 = x1 + BoxWidth + 1
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,4)-.YAxis.Min) * .YAxis.ScaleFactor + 1 'Q1
y2 = .YAxis.Ori - (.Data(i,2)-.YAxis.Min) * .YAxis.ScaleFactor 'Q3
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,4))-.YAxis.Min) * .YAxis.ScaleFactor + 1 'Q1
y2 = .YAxis.Ori - (.qcLog10(.Data(i,2))-.YAxis.Min) * .YAxis.ScaleFactor 'Q3
END IF
IF .Series(i).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(i).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i).HatchStyle, .Series(i).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcRectangle (.Buffer.Handle,x1,y1,x2+1,y2)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
'--- Draw Median Line
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2 - LinWidth / 2
x2 = x1 + LinWidth + 1
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,3)-.YAxis.Min) * .YAxis.ScaleFactor 'Q2
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,3))-.YAxis.Min) * .YAxis.ScaleFactor 'Q2
END IF
y2 = y1
LinColor = .Colors(24)
IF .GreyScale = TRUE THEN LinColor = .Colors(27)
.hBrush = qcCreateSolidBrush(LinColor)
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcRectangle (.Buffer.Handle,x1,y1+1,x2+1,y2-2)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
QCHART.ChartExists = TRUE
END SUB
'------------------------------------------------------------------------------------------
PRIVATE:
SUB DrawHiLo (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 XIntvl AS SINGLE 'Distance between plots
DIM LinWidth AS LONG 'Width od Mid Line
DIM LinColor AS LONG 'Change for Hi-Lo
DIM BoxWidth AS LONG 'Width of bars
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows)
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.Xaxis.Div = .Cols
.XAxis.DrawZero = FALSE 'No Values on the X
.DrawAxes
.DrawTitles
.DrawLabels
IF .ChartStyle = csHiLoBox THEN .DrawLegend
END WITH
END IF
WITH QCHART
XIntvl = .XAxis.LEN / .Cols
LinWidth = XIntvl * .75
BoxWidth = LinWidth * .75
FOR i = 1 TO .Cols
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2
x2 = x1
IF .ChartStyle = csAntenna THEN
'--- Draw Min - Max Line (Whiskers)
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,3)-.YAxis.Min) * .YAxis.ScaleFactor 'Lo
y2 = .YAxis.Ori - (.Data(i,1)-.YAxis.Min) * .YAxis.ScaleFactor 'Hi
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,3))-.YAxis.Min) * .YAxis.ScaleFactor 'Lo
y2 = .YAxis.Ori - (.qcLog10(.Data(i,1))-.YAxis.Min) * .YAxis.ScaleFactor 'Hi
END IF
.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)
ELSE
'--- Draw Min - Max Box
x1 = x1 - BoxWidth / 2
x2 = x1 + BoxWidth + 1
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,3)-.YAxis.Min) * .YAxis.ScaleFactor + 1 'Lo
y2 = .YAxis.Ori - (.Data(i,1)-.YAxis.Min) * .YAxis.ScaleFactor 'Hi
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,3))-.YAxis.Min) * .YAxis.ScaleFactor + 1 'Lo
y2 = .YAxis.Ori - (.qcLog10(.Data(i,1))-.YAxis.Min) * .YAxis.ScaleFactor 'Hi
END IF
IF .Series(i).HatchStyle = hsSolid THEN
.hBrush = qcCreateSolidBrush(.Series(i).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i).HatchStyle, .Series(i).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcRectangle (.Buffer.Handle,x1,y1,x2+1,y2)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
END IF
'--- Draw Close Line
x1 = .XAxis.Ori + XIntvl * (i-1) + XIntvl / 2 - LinWidth / 2
x2 = x1 + LinWidth + 1
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,2)-.YAxis.Min) * .YAxis.ScaleFactor 'Close
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,2))-.YAxis.Min) * .YAxis.ScaleFactor 'Close
END IF
y2 = y1
SELECT CASE .ChartStyle
CASE csAntenna
LinColor = .Colors(0)
CASE csHiLoBox
LinColor = .Colors(24)
END SELECT
IF .GreyScale = TRUE THEN LinColor = .Colors(27)
.hBrush = qcCreateSolidBrush(LinColor)
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcRectangle (.Buffer.Handle,x1,y1+1,x2+1,y2-2)
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
NEXT i
END WITH
QCHART.ChartExists = TRUE
END SUB
'------------------------------------------------------------------------------------------
PRIVATE:
SUB DrawPie (Overlay AS INTEGER)
DIM i AS INTEGER 'Loop counters...
DIM x1 AS LONG 'for readability
DIM y1 AS LONG
DIM x2 AS LONG
DIM y2 AS LONG
DIM Total AS SINGLE
DIM pi2 AS DOUBLE
DIM pct AS SINGLE
DIM Radius AS DOUBLE
DIM Cum AS DOUBLE
DIM xSize AS SINGLE
DIM ySize AS SINGLE
DIM xLeft AS LONG
DIM xRight AS LONG
DIM yTop AS LONG
DIM yBottom AS LONG
DIM TxtFactor AS SINGLE
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ClearBuffer 'erase the current bitmap
.DoLegend = TRUE 'Force to calculate sizes based on Legend
.SetSize
.SetSeries
.DrawAxes 'Draws frame but no axes
.DrawTitles
.DrawLegend
END WITH
END IF
WITH QCHART
Total = .ColTotal(1)
IF Total = 0 THEN
MESSAGEDLG("Division by Zero!", 1, 4, 0)
.ClearAll
EXIT SUB
END IF
.Buffer.Font = .AxisFont
TxtFactor = .Buffer.TextHeight("I")
xSize = .XAxis.LEN - TxtFactor
ySize = .YAxis.LEN - TxtFactor
pi2 = 8*ATN(1)
Radius = ySize / 2.5
xLeft = (.XAxis.Ori + xSize / 2) - Radius
xRight =(.XAxis.Ori + xSize / 2) + Radius
yTop = (.YAxis.Ori - ySize / 2) - Radius
yBottom = (.YAxis.Ori - ySize / 2) + Radius
x1 = xRight 'Set Start point for 1st wedge
y1 = (yTop + yBottom) \ 2
Cum = 0
FOR i = 1 TO .Rows
IF .Data(1,i) <> .Missing THEN 'if data not missing
Cum = Cum + .Data(1,i) 'Calculate wedge endpoint
x2 = .XAXis.Ori + xSize / 2 + Radius * COS(pi2 * Cum / Total)
y2 = .YAxis.Ori - ySize / 2 - Radius * SIN(pi2 * Cum / Total)
IF .Series(i).HatchStyle = hsSolid THEN 'Set brush color for wedge
.hBrush = qcCreateSolidBrush(.Series(i).COLOR)
ELSE
.hBrush = qcCreateHatchBrush(.Series(i).HatchStyle, .Series(i).COLOR)
END IF
.OldBrush = qcSelectObject(.Buffer.Handle, .hBrush)
qcPie (.Buffer.Handle, xLeft, yTop, xRight, yBottom, x1, y1, x2, y2)'Draw the wedge
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldBrush))
SELECT CASE .ChartStyle 'Print labels at midpoint of wedge
CASE csPiePct
pct = .Data(1,i)/Total * 100
.AxisLbl.Text = FORMAT$("%-3.1f", pct) + " %"
CASE csPieVal
.AxisLbl.Text = FORMAT$("%-4.4g", .Data(1,i))
CASE ELSE
.AxisLbl.Text = ""
END SELECT
.AxisLbl.Left = .XAxis.Ori + xSize/2 + (Radius + TxtFactor)*_
COS(pi2 * (Cum -.Data(1,i)/2) / Total)
.AxisLbl.Top = .YAxis.Ori - ySize/2 - (Radius + TxtFactor)*_
SIN(pi2 * (Cum -.Data(1,i)/2) / Total)
IF COS(pi2 * (Cum - .Data(1,i)/2) / Total) < 0 THEN ' align left
.AxisLbl.Left = .AxisLbl.Left - .Buffer.TextWidth(RTRIM$(.AxisLbl.Text))
END IF
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top, RTRIM$(.AxisLbl.Text),_
.Buffer.Font.COLOR, .bgColor)
x1 = x2 'Update wedge start position
y1 = y2
END IF 'missing
NEXT i
END WITH
QCHART.ChartExists = TRUE
END SUB
'------------------------------------------------------------------------------------------
SUB DrawReal (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 Start AS INTEGER
IF Overlay = FALSE THEN
WITH QCHART 'Set up the chart window
.ChartStyle = csLines 'Force to Lines only
IF .Viewport < 0 OR .Rows <= .Viewport THEN 'Normal, plot all cols
Start = 1
ELSE 'Plot only those last X Points
Start = .Rows - .Viewport 'specified in .Viewport property
END IF
.ClearBuffer 'erase the current bitmap
.SetSize
.SetScale (1,.Rows) 'Scales to all data
' .SetScale (Start,.Rows) 'Scales to Viewport data
IF .Success = FALSE THEN 'Log Scaling failed
.ClearAll
EXIT SUB
END IF
.SetSeries
.XAxis.DrawZero = FALSE 'No Values on the X
.DrawAxes
.DrawTitles
.XAxis.Labeled = FALSE 'Label X Axis locally (see below)
.DrawLabels 'Label the Y Axis
.DrawLegend
END WITH
END IF
WITH QCHART
'---- Label start and end values of X Axis
.AxisLbl.Text = .LabelList.Item(0)
.AxisLbl.Left = .XAxis.Ori - .Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) / 2
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,RTRIM$(.AxisLbl.Text),_
.Buffer.Font.COLOR, .bgColor)
.AxisLbl.Text = .LabelList.Item(1)
.AxisLbl.Left = .XAxis.Ori + .XAxis.Len_
- .Buffer.TextWidth(RTRIM$(.AxisLbl.Text)) / 2
.AxisLbl.Top = .YAxis.Ori + .Buffer.TextHeight(.AxisLbl.Text) / 2
.Buffer.TextOut (.AxisLbl.Left, .AxisLbl.Top,RTRIM$(.AxisLbl.Text),_
.Buffer.Font.COLOR, .bgColor)
IF .Viewport > 0 THEN
.XAxis.TicIntvl = .XAxis.LEN / .Viewport
ELSE
.XAxis.TicIntvl = .XAxis.LEN / (.Rows - 1)
END IF
qcSetBkColor (.Buffer.Handle, .PlotAreaColor)
FOR i = 1 to .Cols
.hPen = qcCreatePen(.Series(i).LineStyle, .Series(i).LineWidth, .Series(i).COLOR)
.OldPen = qcSelectObject(.Buffer.Handle, .hPen)
FOR j = Start TO .Rows - 1
IF .Data(i,j)=.Missing OR .Data(i,j+1)=.Missing THEN GOTO NoPlotRealLn
IF j = Start THEN
x1 = .XAxis.Ori
ELSE
x1 = x2
END IF
x2 = x1 + .Xaxis.TicIntvl
IF .YAxis.LogScale = FALSE THEN
y1 = .YAxis.Ori - (.Data(i,j)-.YAxis.Min) * .YAxis.ScaleFactor
y2 = .YAxis.Ori - (.Data(i,j+1)-.YAxis.Min) * .YAxis.ScaleFactor
ELSE
y1 = .YAxis.Ori - (.qcLog10(.Data(i,j))-.YAxis.Min) *.YAxis.ScaleFactor
y2 = .YAxis.Ori - (.qcLog10(.Data(i,j+1))-.YAxis.Min) *.YAxis.ScaleFactor
END IF
'--- Use API to draw lines
qcMoveToEx(.Buffer.handle,x1,y1,0)
qcLineTo(.Buffer.handle,x2,y2)
NoPlotRealLn:
NEXT j
qcDeleteObject(qcSelectObject(.Buffer.Handle, .OldPen))
NEXT i
END WITH
QCHART.ChartExists = TRUE
END SUB
'------------------------------------------------------------------------------------------
'------------------------- Public Methods -------------------------------------------------
'------------------------------------------------------------------------------------------
PUBLIC:
SUB DrawChart(Overlay AS INTEGER)
WITH QCHART
SELECT CASE .ChartType
CASE ctBar
.DrawBar(Overlay, 0)
CASE ctXY
.DrawXY(Overlay)
CASE ctLine
.DrawLine(Overlay, 0)
CASE ctBox
.DrawBox(Overlay)
CASE ctPie
.DrawPie(Overlay)
CASE ctHiLo
.DrawHiLo(Overlay)
CASE ctReal
.DrawReal(Overlay)
CASE ctBarLine
.ChartType = ctBar
.ChartStyle = csBar
.DrawBar(Overlay, 1)
.ChartType = ctLine
.ChartStyle = csBoth
.DrawLine(TRUE, 2)
.ChartType = ctBarLine 'Reset type for redraws
END SELECT
IF .Printing = FALSE THEN .PaintChart
END WITH
END SUB
'-------------------------------------------------------------------------------------------
PUBLIC:
SUB RedrawChart '<--- Call this SUB from your FORM.OnResize EVENT SUB
WITH QCHART
.Buffer.Width = .ClientWidth 'recalc dimensions
.Buffer.Height = .ClientHeight
IF .ChartExists = TRUE THEN .DrawChart(FALSE) 'only redraw if ChartExists
END WITH
END SUB
'-------------------------------------------------------------------------------------------
PUBLIC:
SUB PrintChart (Prn AS INTEGER, Orient AS INTEGER, Margin AS INTEGER,_
Copies AS INTEGER, Colr AS BYTE)
'Prints copies of graph to a full page with a user specified margin and orientation
'Colr is Boolean: TRUE = Use color for printing, FALSE = Use B&W for printing
DIM Source AS QRect
DIM Page AS QRect
DIM OldBW AS BYTE
IF QCHART.ChartExists = FALSE THEN EXIT SUB 'Don't print nonexistent chart
WITH QCHART
PRINTER.PrinterIndex = Prn
PRINTER.Orientation = Orient
PRINTER.Copies = Copies
IF Orient = 0 THEN 'Portrait
.Buffer.Width = 1920 'Scale to page size
.Buffer.Height = 2400
ELSE 'Landscape
.Buffer.Width = 2560
.Buffer.Height = 1920
END IF
'Set page size
Page.Top = Margin
Page.Left = Margin
Page.Right = .Left + PRINTER.PageWidth - (Margin * 2)
Page.Bottom = .Top + PRINTER.PageHeight - (Margin * 2)
Source.Top = 0 'Set source size
Source.Left = 0
Source.Right = Source.Left + QCHART.Buffer.Width
Source.Bottom = Source.Top + QCHART.Buffer.Height
.MainFont.Size = .MainFont.Size * 3 'Increase font sizes
.SubFont.Size = .SubFont.Size * 3
.AxisFont.Size = .AxisFont.Size * 3
.LegendFont.Size = .LegendFont.Size * 3
.MarkerSize = .MarkerSize * 3
IF Colr = FALSE THEN
OldBW = .BW 'Remember BW setting
.BW = TRUE 'Change to BW for Printing
END IF
IF .XAxis.AutoScale = TRUE THEN 'Keep same Axis Scales
.XAxis.AutoScale = NOT .XAxis.AutoScale 'turn off Autoscale
END IF
IF .YAxis.AutoScale = TRUE THEN 'Keep same Axis Scales
.YAxis.AutoScale = NOT .YAxis.AutoScale 'turn off Autoscale
END IF
.Printing = TRUE 'Prevent screen redraw
.DrawChart(FALSE) 'Redraw at Page Size
PRINTER.BeginDoc 'Print it
PRINTER.CopyRect(Page, QCHART.Buffer, Source)
PRINTER.EndDoc
.MainFont.Size = .MainFont.Size / 3 'Restore to screen size
.SubFont.Size = .SubFont.Size / 3
.AxisFont.Size = .AxisFont.Size / 3
.LegendFont.Size = .LegendFont.Size / 3
.MarkerSize = .MarkerSize / 3
IF Colr = FALSE THEN .BW = OldBW 'Restore BW setting
IF .XAxis.AutoScale = -2 THEN 'AutoScale was changed
.XAxis.AutoScale = NOT .XAxis.AutoScale 'Change it back
END IF
IF .YAxis.AutoScale = -2 THEN 'AutoScale was changed
.YAxis.AutoScale = NOT .YAxis.AutoScale 'Change it back
END IF
.ReDrawChart 'Redraw at Screen size
.Printing = FALSE 'Reset Flag
END WITH
END SUB
'-------------------------------------------------------------------------------------------
PUBLIC:
SUB CopyToClipboard (Wid AS INTEGER, Hgt AS INTEGER)
DIM hBitmap AS INTEGER
DIM Bitmap AS QBITMAP
DIM Scale AS SINGLE
DIM OldMain AS INTEGER
DIM OldSub AS INTEGER
DIM OldAxis AS INTEGER
DIM OldLegend AS INTEGER
DIM OldMarker AS INTEGER
WITH QCHART
OldMain = .MainFont.Size 'Remember
OldSub = .SubFont.Size
OldAxis = .AxisFont.Size
OldLegend = .LegendFont.Size
OldMarker = .MarkerSize
Scale = (Hgt + Wid) / (.Buffer.Height + .Buffer.Width) 'Rescale
.MainFont.Size = .MainFont.Size * Scale
.SubFont.Size = .SubFont.Size * Scale
.AxisFont.Size = .AxisFont.Size * Scale
.LegendFont.Size = .LegendFont.Size * Scale
.MarkerSize = .MarkerSize * Scale
.Buffer.Height = Hgt 'Redraw off screen
.Buffer.Width = Wid
.Printing = TRUE
.DrawChart(FALSE)
Bitmap.BMP=.Buffer.BMP 'Make a copy of Buffer
Bitmap.PixelFormat=0
hBitmap=qcGetCurrentObjectBmp(bitmap.handle,7)
Clipboard.Open 'Copy to Clipboard
Clipboard.Clear
Clipboard.SetAsHandle(2,hBitmap)
Clipboard.Close
.MainFont.Size = OldMain 'Restore
.SubFont.Size = OldSub
.AxisFont.Size = OldAxis
.LegendFont.Size = OldLegend
.MarkerSize = OldMarker
.RedrawChart
.Printing = FALSE
END WITH
END SUB
'-------------------------------------------------------------------------------------------
PUBLIC:
SUB SaveChart (SaveAs AS BYTE)
DIM File AS QFILESTREAM
IF SaveAs = TRUE THEN GOTO qcShowSave
WITH QCHART
IF .CurrFile <> "NewChart.bmp" THEN 'The file has been saved before
File.Open(.dlgSaveQC.FileName, 65535) '65535 = fmCreate
.Buffer.SaveToStream (File) 'save the data
File.Close
EXIT SUB
END IF
qcShowSave:
IF SaveAs = TRUE THEN
.dlgSaveQC.Caption = "Save Graph As"
ELSE
.dlgSaveQC.Caption = "Save Graph"
END IF
.dlgSaveQC.FileName = .CurrFile
.dlgSaveQC.Filter = "Bitmap Files|*.bmp|All Files|*.*"
.dlgSaveQC.FilterIndex = 1
IF .dlgSaveQC.Execute AND LEN(.dlgSaveQC.FileName) <> 0 THEN
IF INSTR(UCASE$(.dlgSaveQC.FileName), ".BMP") = 0 THEN
.dlgSaveQC.FileName = .dlgSaveQC.FileName + ".bmp"
END IF
IF FILEEXISTS(.dlgSaveQC.FileName) THEN 'check if file exists
DIM Response AS INTEGER 'ask user for decision
Response = MESSAGEDLG("File Already Exists. Overwrite " + .dlgSaveQC.FileName + "?",_
0, 1 OR 2 OR 8, 0) ' Y OR N OR Cancel
SELECT CASE Response
CASE 7 ' NO; don't overwrite, ask again
GOTO qcShowSave '<--- Use of a local GOTO loop!
CASE 2 'CANCEL;don't overwrite, don't ask again
EXIT SUB
END SELECT
END IF
File.Open(.dlgSaveQC.FileName, 65535) '65535 = fmCreate
.Buffer.SaveToStream (File) 'save the data
File.Close
.CurrFile = .dlgSaveQC.FileName
END IF
END WITH
END SUB
'-------------------------------------------------------------------------------------------
END TYPE'QChart
'----- End Object Definition ***************************************************************
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2010-12-07 22:25:02
