LazStats: Use TAChart in XBarUnit.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7648 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-06 23:24:17 +00:00
parent 8c869228e7
commit c06edbd9f7
8 changed files with 620 additions and 416 deletions

View File

@ -405,7 +405,7 @@ begin
clr := DATA_COLORS[grp mod Length(DATA_COLORS)];
sym := DATA_SYMBOLS[grp mod Length(DATA_SYMBOLS)];
grpName := Format('%s = %d', [GroupEdit.Text, grp + MinGrp]);
ChartForm.PlotXY(pt, XValues[grp], YValues[grp], grpName, clr, sym);
ChartForm.PlotXY(pt, XValues[grp], YValues[grp], nil, nil, grpName, clr, sym);
end;
ChartForm.Show;

View File

@ -367,14 +367,14 @@ begin
// Draw upper confidence band
if ConfChk.Checked then
ChartForm.PlotXY(ptLines, XPoints, UpConf, 'Upper confidence band', clRed);
ChartForm.PlotXY(ptLines, XPoints, UpConf, nil, nil, 'Upper confidence band', clRed);
// Plot data points
ChartForm.PlotXY(ptSymbols, XPoints, YPoints, 'Data values', clNavy);
ChartForm.PlotXY(ptSymbols, XPoints, YPoints, nil, nil, 'Data values', clNavy);
// Draw lower confidence band
if ConfChk.Checked then
ChartForm.PlotXY(ptLines, XPoints, LowConf, 'Lower confidence band', clRed);
ChartForm.PlotXY(ptLines, XPoints, LowConf, nil, nil, 'Lower confidence band', clRed);
ChartForm.Chart.Prepare;
ChartForm.GetXRange(xmin, xmax, false);
@ -394,7 +394,7 @@ begin
SetLengtH(tmpY, 2);
tmpX[0] := xmin; tmpY[0] := tmpX[0] * slope + intercept;
tmpX[1] := xmax; tmpY[1] := tmpX[1] * slope + intercept;
ChartForm.PlotXY(ptLines, tmpX, tmpY, 'Predicted', clBlack);
ChartForm.PlotXY(ptLines, tmpX, tmpY, nil, nil, 'Predicted', clBlack);
end;
// Show chart

View File

@ -364,7 +364,7 @@ begin
// Plot a series for each y value
for j := 0 to Ny - 1 do
ChartForm.PlotXY(pt, XValues, YValues[j], Trim(YBox.Items[j]), DATA_COLORS[j mod Nc]);
ChartForm.PlotXY(pt, XValues, YValues[j], nil, nil, Trim(YBox.Items[j]), DATA_COLORS[j mod Nc]);
// Show chart
ChartForm.ShowModal;

View File

@ -1,355 +1,415 @@
object XBarFrm: TXBarFrm
Left = 591
Height = 397
Height = 426
Top = 279
Width = 499
Width = 1000
HelpType = htKeyword
HelpKeyword = 'html/XBarChart.htm'
AutoSize = True
Caption = 'X Bar Charting Specifications'
ClientHeight = 397
ClientWidth = 499
Caption = 'X Bar Chart'
ClientHeight = 426
ClientWidth = 1000
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '2.1.0.0'
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 8
Height = 15
Top = 8
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Selection Variables'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SigmaOpts
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 323
Top = 25
Width = 227
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0
OnClick = VarListClick
object SpecsPanel: TPanel
Left = 0
Height = 426
Top = 0
Width = 433
Align = alLeft
BorderSpacing.Right = 2
BevelOuter = bvNone
ClientHeight = 426
ClientWidth = 433
TabOrder = 0
end
object SigmaOpts: TRadioGroup
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 243
Height = 128
Top = 108
Width = 248
Anchors = [akTop, akLeft, akRight]
AutoFill = True
BorderSpacing.Top = 12
BorderSpacing.Right = 8
Caption = 'No. of Sigma Units for UCL and LCL:'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 108
ClientWidth = 244
ItemIndex = 0
Items.Strings = (
'3 Sigma (default)'
'2 Sigma'
'1 Sigma'
'X Sigmas where X = '
)
TabOrder = 2
object XSigmaEdit: TEdit
AnchorSideRight.Control = SigmaOpts
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 152
Height = 23
Top = 80
Width = 80
Alignment = taRightJustify
Anchors = [akRight, akBottom]
TabOrder = 2
Text = 'XSigmaEdit'
object VarListLabel: TLabel
AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = SpecsPanel
Left = 8
Height = 15
Top = 8
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Selection Variables'
ParentColor = False
end
end
object GroupBox1: TGroupBox
AnchorSideTop.Control = SigmaOpts
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 243
Height = 101
Top = 248
Width = 248
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Top = 12
BorderSpacing.Right = 8
Caption = 'Options'
ClientHeight = 81
ClientWidth = 244
TabOrder = 3
object UpSpecChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = UpSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 2
Width = 148
BorderSpacing.Left = 12
Caption = 'Show Upper Spec. Level:'
object VarList: TListBox
AnchorSideLeft.Control = SpecsPanel
AnchorSideTop.Control = VarListLabel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SigmaOpts
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 352
Top = 25
Width = 198
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0
OnClick = VarListClick
TabOrder = 0
end
object LowSpecChk: TCheckBox
object SigmaOpts: TRadioGroup
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = LowSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 29
Width = 145
BorderSpacing.Left = 12
Caption = 'Show Lower Spec. Level'
TabOrder = 2
end
object TargetChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = TargetSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 56
Width = 146
BorderSpacing.Left = 12
BorderSpacing.Bottom = 6
Caption = 'Use Target Specification'
TabOrder = 4
end
object UpSpecEdit: TEdit
AnchorSideLeft.Control = UpSpecChk
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 172
Height = 23
Top = 0
Width = 64
Alignment = taRightJustify
BorderSpacing.Left = 12
BorderSpacing.Right = 8
TabOrder = 1
Text = 'UpSpecEdit'
end
object LowSpecEdit: TEdit
AnchorSideLeft.Control = UpSpecEdit
AnchorSideTop.Control = UpSpecEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = UpSpecEdit
AnchorSideRight.Side = asrBottom
Left = 172
Height = 23
Top = 27
Width = 64
Alignment = taRightJustify
Left = 214
Height = 128
Top = 108
Width = 219
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
AutoFill = True
BorderSpacing.Top = 12
Caption = 'No. of Sigma Units for UCL and LCL:'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 108
ClientWidth = 215
ItemIndex = 0
Items.Strings = (
'3 Sigma (default)'
'2 Sigma'
'1 Sigma'
'x Sigmas with x = '
)
TabOrder = 1
object XSigmaEdit: TEdit
AnchorSideRight.Control = SigmaOpts
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 144
Height = 23
Top = 80
Width = 59
Alignment = taRightJustify
Anchors = [akLeft, akRight, akBottom]
TabOrder = 0
Text = 'XSigmaEdit'
end
end
object GroupBox1: TGroupBox
AnchorSideTop.Control = SigmaOpts
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
Left = 214
Height = 126
Top = 248
Width = 219
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Top = 12
Caption = 'Show...'
ClientHeight = 106
ClientWidth = 215
TabOrder = 2
object UpSpecChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = UpSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 2
Width = 116
BorderSpacing.Left = 12
Caption = 'Upper Spec. Level:'
TabOrder = 0
end
object LowSpecChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = LowSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 29
Width = 113
BorderSpacing.Left = 12
Caption = 'Lower Spec. Level'
TabOrder = 2
end
object TargetChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = TargetSpecEdit
AnchorSideTop.Side = asrCenter
Left = 12
Height = 19
Top = 56
Width = 124
BorderSpacing.Left = 12
BorderSpacing.Bottom = 6
Caption = 'Target Specification'
TabOrder = 4
end
object UpSpecEdit: TEdit
AnchorSideLeft.Control = TargetSpecEdit
AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = TargetSpecEdit
AnchorSideRight.Side = asrBottom
Left = 144
Height = 23
Top = 0
Width = 63
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
TabOrder = 1
Text = 'UpSpecEdit'
end
object LowSpecEdit: TEdit
AnchorSideLeft.Control = TargetSpecEdit
AnchorSideTop.Control = UpSpecEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TargetSpecEdit
AnchorSideRight.Side = asrBottom
Left = 144
Height = 23
Top = 27
Width = 63
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
TabOrder = 3
Text = 'Edit1'
end
object TargetSpecEdit: TEdit
AnchorSideLeft.Control = TargetChk
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LowSpecEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 144
Height = 23
Top = 54
Width = 63
Alignment = taRightJustify
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 8
TabOrder = 5
Text = 'Edit1'
end
object ErrorBarsChk: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = TargetSpecEdit
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 81
Width = 70
BorderSpacing.Left = 12
BorderSpacing.Top = 4
BorderSpacing.Bottom = 6
Caption = 'Error Bars'
TabOrder = 6
end
end
object Panel1: TPanel
AnchorSideLeft.Control = GroupBox1
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 214
Height = 88
Top = 8
Width = 219
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
BevelOuter = bvNone
ClientHeight = 88
ClientWidth = 219
TabOrder = 3
Text = 'Edit1'
object Label2: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 0
Height = 15
Top = 0
Width = 105
BorderSpacing.Bottom = 2
Caption = 'Group (Lot) Variable'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom
Left = 0
Height = 15
Top = 48
Width = 117
BorderSpacing.Bottom = 2
Caption = 'Measurement Variable'
ParentColor = False
end
object GroupEdit: TEdit
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 0
Height = 23
Top = 17
Width = 219
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
BorderSpacing.Bottom = 8
ReadOnly = True
TabOrder = 0
Text = 'GroupEdit'
end
object MeasEdit: TEdit
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 0
Height = 23
Top = 65
Width = 219
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
ReadOnly = True
TabOrder = 1
Text = 'MeasEdit'
end
end
object TargetSpecEdit: TEdit
AnchorSideLeft.Control = UpSpecEdit
AnchorSideTop.Control = LowSpecEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = UpSpecEdit
object Bevel1: TBevel
AnchorSideLeft.Control = SpecsPanel
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
Left = 172
Height = 23
Top = 54
Width = 64
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
TabOrder = 5
Text = 'Edit1'
end
end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 290
Height = 25
Top = 364
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 5
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 352
Height = 25
Top = 364
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 6
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 436
Height = 25
Top = 364
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 7
end
object HelpBtn: TButton
Tag = 159
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 231
Height = 25
Top = 364
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 4
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 348
Width = 499
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Panel1: TPanel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Owner
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 243
Height = 88
Top = 8
Width = 248
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
BevelOuter = bvNone
ClientHeight = 88
ClientWidth = 248
TabOrder = 1
object Label2: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 15
Top = 0
Width = 105
BorderSpacing.Bottom = 2
Caption = 'Group (Lot) Variable'
ParentColor = False
Height = 8
Top = 377
Width = 433
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Label3: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = GroupEdit
AnchorSideTop.Side = asrBottom
Left = 0
Height = 15
Top = 48
Width = 117
BorderSpacing.Bottom = 2
Caption = 'Measurement Variable'
ParentColor = False
end
object GroupEdit: TEdit
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 0
Height = 23
Top = 17
Width = 248
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
object ResetBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Side = asrBottom
Left = 232
Height = 25
Top = 393
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
ReadOnly = True
TabOrder = 0
Text = 'GroupEdit'
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 4
end
object MeasEdit: TEdit
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
object ComputeBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Side = asrBottom
Left = 294
Height = 25
Top = 393
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 5
end
object CloseBtn: TButton
AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom
Left = 0
Height = 23
Top = 65
Width = 248
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
ReadOnly = True
TabOrder = 1
Text = 'MeasEdit'
AnchorSideBottom.Side = asrBottom
Left = 378
Height = 25
Top = 393
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 6
end
object HelpBtn: TButton
Tag = 159
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Side = asrBottom
Left = 173
Height = 25
Top = 393
Width = 51
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 7
end
end
object Splitter1: TSplitter
Left = 435
Height = 426
Top = 0
Width = 5
ResizeStyle = rsPattern
end
object PageControl: TPageControl
Left = 442
Height = 414
Top = 6
Width = 552
ActivePage = ChartPage
Align = alClient
BorderSpacing.Left = 2
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
TabIndex = 1
TabOrder = 2
object ReportPage: TTabSheet
Caption = 'Report'
ClientHeight = 386
ClientWidth = 544
object ReportMemo: TMemo
Left = 6
Height = 374
Top = 6
Width = 532
Align = alClient
BorderSpacing.Around = 6
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Courier New'
Font.Pitch = fpFixed
Font.Quality = fqDraft
ParentFont = False
TabOrder = 0
end
end
object ChartPage: TTabSheet
Caption = 'Chart'
end
end
end

View File

@ -8,13 +8,19 @@
unit XBarUnit;
{$mode objfpc}{$H+}
{$include ../../../LazStats.inc}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons,
MainUnit, Globals, ContextHelpUnit, DataProcs, OutputUnit, GraphLib, BlankFrmUnit;
StdCtrls, ExtCtrls, Buttons, ComCtrls,
MainUnit, Globals, ContextHelpUnit, DataProcs, GraphLib,
{$IFDEF USE_TACHART}
TAChartUtils, TACustomSeries, ChartFrameUnit;
{$ELSE}
OutputUnit, BlankFrmUnit;
{$ENDIF}
type
@ -22,11 +28,18 @@ type
TXBarFrm = class(TForm)
Bevel1: TBevel;
ErrorBarsChk: TCheckBox;
HelpBtn: TButton;
ReportMemo: TMemo;
PageControl: TPageControl;
Panel1: TPanel;
SpecsPanel: TPanel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
Splitter1: TSplitter;
ReportPage: TTabSheet;
ChartPage: TTabSheet;
UpSpecEdit: TEdit;
LowSpecEdit: TEdit;
TargetSpecEdit: TEdit;
@ -37,7 +50,7 @@ type
XSigmaEdit: TEdit;
GroupEdit: TEdit;
MeasEdit: TEdit;
Label1: TLabel;
VarListLabel: TLabel;
Label2: TLabel;
Label3: TLabel;
SigmaOpts: TRadioGroup;
@ -51,8 +64,11 @@ type
procedure VarListClick(Sender: TObject);
private
{ private declarations }
FAutoSized: Boolean;
procedure PlotMeans(var Means: DblDyneVec; NoGrps: integer;
{$IFDEF USE_TACHART}
FChartFrame: TChartFrame;
{$ENDIF}
// FAutoSized: Boolean;
procedure PlotMeans(const Groups: StrDyneVec; const Means, StdDevs: DblDyneVec;
UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec: double);
function Validate(out AMsg: String; out AControl: TWinControl): Boolean;
public
@ -65,7 +81,8 @@ var
implementation
uses
Math;
Math,
Utils;
{ TXBarFrm }
@ -79,6 +96,7 @@ begin
UpSpecEdit.Text := '';
LowSpecEdit.Text := '';
TargetSpecEdit.Text := '';
XSigmaEdit.Text := '';
UpSpecChk.Checked := false;
LowSpecChk.Checked := false;
TargetChk.Checked := false;
@ -110,13 +128,17 @@ end;
procedure TXBarFrm.ComputeBtnClick(Sender: TObject);
var
i, GrpVar, MeasVar, mingrp, maxgrp, G, range: integer;
i, GrpVar, MeasVar, grpIndex: integer;
X, UCL, LCL, Sigma, UpperSpec, LowerSpec, TargetSpec: double;
GrandMean, GrandSD, semean: double;
means, stddev: DblDyneVec;
count: IntDyneVec;
grp: String;
numGrps: Integer;
groups: StrDyneVec = nil;
means: DblDyneVec = nil;
stddev: DblDyneVec = nil;
count: IntDyneVec = nil;
cellstring: string;
ColNoSelected: IntDyneVec;
ColNoSelected: IntDyneVec = nil;
NoSelected: integer;
msg: String;
C: TWinControl;
@ -157,54 +179,58 @@ begin
3: Sigma := StrToFloat(XSigmaEdit.Text);
end;
mingrp := 10000;
maxgrp := -10000;
numGrps := 0;
SetLength(groups, NoCases);
for i := 1 to NoCases do
begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i])));
if G < mingrp then mingrp := G;
if G > maxgrp then maxgrp := G;
if not GoodRecord(i, NoSelected, ColNoSelected) then continue;
grp := Trim(OS3MainFrm.DataGrid.Cells[GrpVar, i]);
if IndexOfString(groups, grp) = -1 then
begin
groups[numGrps] := grp;
inc(numGrps);
end;
end;
range := maxgrp - mingrp + 1;
SetLength(means, range);
SetLength(count, range);
SetLength(stddev, range);
for i := 0 to range-1 do
begin
count[i] := 0;
means[i] := 0.0;
stddev[i] := 0.0;
end;
SetLength(groups, numGrps);
SetLength(means, numGrps);
SetLength(count, numGrps);
SetLength(stddev, numGrps);
semean := 0.0;
GrandMean := 0.0;
// calculate group means, grand mean, group sd's, semeans
for i := 1 to NoCases do
begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i])));
G := G - mingrp + 1;
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i]));
means[G-1] := means[G-1] + X;
count[G-1] := count[G-1] + 1;
stddev[G-1] := stddev[G-1] + (X * X);
semean := semean + (X * X);
if not GoodRecord(i, NoSelected, ColNoSelected) then continue;
grp := Trim(OS3MainFrm.DataGrid.cells[GrpVar, i]);
grpIndex := IndexOfString(groups, grp);
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar, i]));
means[grpIndex] := means[grpIndex] + X;
count[grpIndex] := count[grpIndex] + 1;
stddev[grpIndex] := stddev[grpIndex] + sqr(X);
semean := semean + sqr(X);
GrandMean := GrandMean + X;
end;
for i := 0 to range-1 do
for i := 0 to numGrps-1 do
begin
stddev[i] := stddev[i] - sqr(means[i]) / count[i];
if count[i] > 1 then
if count[i] = 0 then
begin
stddev[i] := stddev[i] / (count[i] - 1);
stddev[i] := sqrt(stddev[i]);
end
else
stddev[i] := 0.0;
means[i] := means[i] / count[i];
means[i] := NaN;
stddev[i] := NaN;
end else
begin
if count[i] = 1 then
stddev[i] := NaN
else
begin
stddev[i] := stddev[i] - sqr(means[i]) / count[i];
stddev[i] := stddev[i] / (count[i] - 1);
stddev[i] := sqrt(stddev[i]);
end;
means[i] := means[i] / count[i];
end;
end;
semean := semean - sqr(GrandMean) / NoCases;
semean := sqrt(semean / (NoCases - 1));
@ -219,10 +245,10 @@ begin
try
lReport.Add('X BAR CHART RESULTS');
lReport.Add('');
lReport.Add('Group Size Mean Std.Dev.');
lReport.Add('Group Size Mean Std.Dev.');
lReport.Add('----- ---- --------- ----------');
for i := 0 to range-1 do
lReport.Add(' %3d %3d %8.2f %8.2f', [i+1, count[i], means[i], stddev[i]]);
for i := 0 to numGrps-1 do
lReport.Add('%5s %4d %9.2f %9.2f', [groups[i], count[i], means[i], stddev[i]]);
lReport.Add('');
lReport.Add('Grand Mean: %8.3f', [GrandMean]);
lReport.Add('Standard Deviation: %8.3f', [GrandSD]);
@ -231,20 +257,28 @@ begin
lReport.Add('Lower Control Limit: %8.3f', [LCL]);
lReport.Add('Upper Control Limit: %8.3f', [UCL]);
{$IFDEF USE_TACHART}
ReportMemo.Lines.Assign(lReport);
{$ELSE}
DisplayReport(lReport);
{$ENDIF}
finally
lReport.Free;
end;
// show graph
{$IFNDEF USE_TACHART}
BlankFrm.Image1.Canvas.Clear;
BlankFrm.Show;
PlotMeans(means, range, UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec);
{$ENDIF}
if not ErrorBarsChk.Checked then stddev := nil;
PlotMeans(groups, means, stddev, UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec);
// Clean up
stddev := nil;
count := nil;
means := nil;
groups := nil;
ColNoSelected := nil;
end;
@ -252,31 +286,42 @@ procedure TXBarFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
{
if FAutoSized then
exit;
}
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
VarList.Constraints.MinWidth := GroupBox1.Width;
VarList.Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height - VarList.Top;
VarList.Constraints.MinWidth := VarListLabel.Width;
SpecsPanel.Constraints.MinWidth := VarListLabel.Left + VarListLabel.Width + VarList.BorderSpacing.Right + GroupBox1.Width;
// VarList.Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height - VarList.Top;
// SpecsPanel.Constraints.MinWidth := SpecsPanel.Width;
// PageControl.Constraints.MinWidth := SpecsPanel.Width ;
AutoSize := false;
// ClientHeight := GroupBox1.Top + GroupBox1.Height + Panel1.BorderSpacing.Top + Panel1.Height + Bevel1.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top*2;
Constraints.MinHeight := Height;
Constraints.MinWidth := Width;
//AutoSize := false;
Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height + Bevel1.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top * 2; // Height;
//Constraints.MinWidth := Width;
FAutoSized := true;
// FAutoSized := true;
end;
procedure TXBarFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
{$IFDEF USE_TACHART}
FChartFrame := TChartFrame.Create(self);
FChartFrame.Parent := ChartPage;
FChartFrame.Align := alClient;
FChartFrame.BorderSpacing.Around := Scale96ToFont(8);
FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30);
{$ELSE}
if BlankFrm = nil then
Application.CreateForm(TBlankFrm, BlankFrm);
{$ENDIF}
end;
procedure TXBarFrm.FormShow(Sender: TObject);
@ -284,16 +329,72 @@ begin
ResetBtnClick(self);
end;
procedure TXBarFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer;
procedure TXBarFrm.PlotMeans(const Groups: StrDyneVec; const Means, StdDevs: DblDyneVec;
UCL, LCL, GrandMean: double; TargetSpec, LowerSpec, UpperSpec: double);
const
TARGET_COLOR = clBlue;
CL_COLOR = clRed;
SPEC_COLOR = clGreen;
CL_STYLE = psDash;
SPEC_STYLE = psSolid;
var
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer;
vhi, hwide, offset, strhi: integer;
imagehi, maxval, minval, valincr, Yvalue: double;
{$IFDEF USE_TACHART}
ser: TChartSeries;
{$ELSE}
i: Integer;
xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer;
maxVal, minVal: Double;
NoGrps, vhi, hwide, offset, strhi: integer;
imagehi, valincr, Yvalue: double;
title: String;
{$ENDIF}
begin
maxval := -10000.0;
minval := 10000.0;
{$IFDEF USE_TACHART}
FChartFrame.Clear;
FChartFrame.SetTitle('XBAR chart for ' + OS3MainFrm.FileNameEdit.Text, taLeftJustify);
FChartFrame.SetXTitle(GroupEdit.Text);
FChartFrame.SetYTitle(MeasEdit.Text);
ser := FChartFrame.PlotXY(ptSymbols, nil, Means, Groups, StdDevs, 'Group means', clBlack);
FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source;
FChartFrame.Chart.BottomAxis.Marks.style := smsLabel;
FChartFrame.HorLine(GrandMean, clRed, psSolid, 'Grand mean');
if UpSpecChk.Checked then
begin
if UCL > UpperSpec then
begin
FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL');
FChartFrame.HorLine(UpperSpec, SPEC_COLOR, SPEC_STYLE, 'Upper Spec');
end else
begin
FChartFrame.HorLine(UpperSpec, SPEC_COLOR, SPEC_STYLE, 'Upper Spec');
FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL');
end;
end else
FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL');
if TargetChk.Checked then
FChartFrame.HorLine(TargetSpec, TARGET_COLOR, psSolid, 'Target');
if LowSpecChk.Checked then
begin
if LowerSpec > LCL then
begin
FChartFrame.HorLine(LowerSpec, SPEC_COLOR, SPEC_STYLE, 'Lower Spec');
FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, 'LCL');
end else
begin
FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, 'LCL');
FChartFrame.HorLine(LowerSpec, SPEC_COLOR, SPEC_STYLE, 'Lower Spec');
end;
end else
FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, 'LCL');
{$ELSE}
NoGrps := Length(groups);
maxval := -Infinity;
minval := Infinity;
for i := 0 to NoGrps-1 do
begin
if means[i] > maxval then maxval := means[i];
@ -388,8 +489,8 @@ begin
xpos := hright + 10;
ypos := round(vhi * (maxval - UCL) / (maxval - minval));
ypos := ypos + vtop;
BlankFrm.Image1.Canvas.Pen.Style := psDash;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.Pen.Style := CL_STYLE;
BlankFrm.Image1.Canvas.Pen.Color := CL_COLOR;
BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos);
title := 'UCL';
strhi := BlankFrm.Image1.Canvas.TextHeight(title);
@ -398,7 +499,7 @@ begin
ypos := round(vhi * ( (maxval - LCL) / (maxval - minval)));
ypos := ypos + vtop;
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.Pen.Color := CL_COLOR;
BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos);
title := 'LCL';
strhi := BlankFrm.Image1.Canvas.TextHeight(title);
@ -406,12 +507,12 @@ begin
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title);
// Draw lines for specified values
BlankFrm.Image1.Canvas.Pen.Color := clGreen;
if UpSpecChk.Checked then
begin
ypos := round(vhi * (maxval - UpperSpec) / (maxval - minval));
ypos := ypos + vtop;
BlankFrm.Image1.Canvas.Pen.Style := psSolid;
BlankFrm.Image1.Canvas.Pen.Color := SPEC_COLOR;
BlankFrm.Image1.Canvas.Pen.Style := SPEC_STYLE;
BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos);
title := 'UPPER SPEC';
strhi := BlankFrm.Image1.Canvas.TextHeight(title);
@ -422,7 +523,7 @@ begin
begin
ypos := round(vhi * (maxval - LowerSpec) / (maxval - minval));
ypos := ypos + vtop;
BlankFrm.Image1.Canvas.Pen.Color := clGreen;
BlankFrm.Image1.Canvas.Pen.Color := SPEC_COLOR;
BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos);
title := 'LOWER SPEC';
strhi := BlankFrm.Image1.Canvas.TextHeight(title);
@ -433,13 +534,14 @@ begin
begin
ypos := round(vhi * (maxval - TargetSpec) / (maxval - minval));
ypos := ypos + vtop;
BlankFrm.Image1.Canvas.Pen.Color := clBlue;
BlankFrm.Image1.Canvas.Pen.Color := TARGET_COLOR;
BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos);
title := 'TARGET';
strhi := BlankFrm.Image1.Canvas.TextHeight(title);
ypos := ypos - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title);
end;
{$ENDIF}
end;
function TXBarFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;

View File

@ -38,8 +38,9 @@ type
procedure GetYRange(out YMin, YMax: Double; Logical: Boolean = true);
procedure HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
function PlotXY(AType: TPlotType; x, y: DblDyneVec; LegendTitle: string;
AColor: TColor; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
function PlotXY(AType: TPlotType; x, y: DblDyneVec; xLabels: StrDyneVec;
yErrorBars: DblDyneVec; LegendTitle: string; AColor: TColor;
ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
procedure Vertline(x: Double; AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
procedure SetFooter(const ATitle: String);
@ -134,10 +135,11 @@ begin
end;
function TChartForm.PlotXY(AType: TPlotType; x, y: DblDyneVec;
LegendTitle: string; AColor: TColor; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
function TChartForm.PlotXY(AType: TPlotType; x, y: DblDyneVec; xLabels: StrDyneVec;
yErrorBars: DblDyneVec; LegendTitle: string; AColor: TColor;
ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
begin
Result := ChartFrame.PlotXY(AType, x, y, LegendTitle, AColor, ASymbol);
Result := ChartFrame.PlotXY(AType, x, y, xLabels, yErrorBars, LegendTitle, AColor, ASymbol);
end;

View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, ExtDlgs, PrintersDlgs,
TAGraph, TATypes, TACustomSeries, TASeries, TATools,
TAGraph, TATypes, TACustomSource, TACustomSeries, TASeries, TATools,
Globals;
type
@ -33,12 +33,13 @@ type
procedure GetYRange(out YMin, YMax: Double; Logical: Boolean = true);
procedure HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
function PlotXY(AType: TPlotType; x, y: DblDyneVec; LegendTitle: string;
AColor: TColor; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
function PlotXY(AType: TPlotType; x, y: DblDyneVec; xLabels: StrDyneVec;
yErrorBars: DblDyneVec; LegendTitle: string; AColor: TColor;
ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
procedure Print;
procedure Save;
procedure SetFooter(const ATitle: String);
procedure SetTitle(const ATitle: String);
procedure SetTitle(const ATitle: String; Alignment: TAlignment = taCenter);
procedure SetXTitle(const ATitle: String);
procedure SetYTitle(const ATitle: String);
procedure VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
@ -120,10 +121,13 @@ begin
end;
function TChartFrame.PlotXY(AType: TPlotType; x, y: DblDyneVec;
LegendTitle: string; AColor: TColor; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
function TChartFrame.PlotXY(AType: TPlotType; x, y: DblDyneVec; xLabels: StrDyneVec;
yErrorBars: DblDyneVec; LegendTitle: string; AColor: TColor;
ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
var
i, n: Integer;
i, n, ns, ne: Integer;
s: String;
xval: Double;
begin
case AType of
ptLines, ptSymbols, ptLinesAndSymbols:
@ -137,6 +141,14 @@ begin
TLineSeries(Result).Pointer.Brush.Color := AColor;
TLineSeries(Result).Pointer.Style := ASymbol;
end;
if yErrorBars <> nil then
begin
TLineSeries(Result).YErrorBars.Visible := true;
TLineSeries(Result).ListSource.YCount := 2;
TLineSeries(Result).ListSource.YErrorBarData.Kind := ebkChartSource;
TLineSeries(Result).ListSource.YErrorBarData.IndexPlus := 1;
TLineSeries(Result).ListSource.YErrorBarData.IndexMinus := -1;
end;
end;
ptHorBars, ptVertBars:
Result := TBarSeries.Create(self);
@ -146,9 +158,20 @@ begin
raise Exception.Create('Unknown plot type.');
end;
n := Min(Length(x), Length(y));
for i := 0 to n-1 do
Result.AddXY(x[i], y[i]);
ns := Length(xLabels);
ne := Length(yErrorBars);
if x = nil then
n := Length(y)
else
n := Min(Length(x), Length(y));
for i := 0 to n-1 do begin
if x = nil then xval := i+1 else xval := x[i];
if i < ns then s := xLabels[i] else s := '';
if i < ne then
Result.AddXY(xval, y[i], [yErrorBars[i]], s)
else
Result.AddXY(xval, y[i], s);
end;
Result.Title := LegendTitle;
Chart.AddSeries(Result);
@ -209,10 +232,11 @@ begin
end;
procedure TChartFrame.SetTitle(const ATitle: String);
procedure TChartFrame.SetTitle(const ATitle: String; Alignment: TAlignment = taCenter);
begin
Chart.Title.Text.Text := ATitle;
Chart.Title.Visible := ATitle <> '';
Chart.Title.Alignment := Alignment;
end;

View File

@ -20,6 +20,9 @@ procedure Exchange(var a, b: String); overload;
procedure SortOnX(X, Y: DblDyneVec);
procedure SortOnX(X: DblDyneVec; Y: DblDyneMat);
function IndexOfString(L: StrDyneVec; s: String): Integer;
implementation
function AnySelected(AListBox: TListBox): Boolean;
@ -115,5 +118,18 @@ begin
end;
end;
function IndexOfString(L: StrDyneVec; s: String): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to High(L) do
if L[i] = s then
begin
Result := i;
exit;
end;
end;
end.