LazStats: Integrate report and chart into form of BoxPlotUnit. Some minor refactoring.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7682 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-21 21:39:40 +00:00
parent 24083f5582
commit 57b8701628
13 changed files with 699 additions and 569 deletions

View File

@ -1,224 +1,292 @@
object BoxPlotFrm: TBoxPlotFrm object BoxPlotFrm: TBoxPlotFrm
Left = 440 Left = 1155
Height = 365 Height = 387
Top = 119 Top = 194
Width = 361 Width = 817
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/BoxPlots.htm' HelpKeyword = 'html/BoxPlots.htm'
AutoSize = True
Caption = 'Box Plot' Caption = 'Box Plot'
ClientHeight = 365 ClientHeight = 387
ClientWidth = 361 ClientWidth = 817
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
Position = poMainFormCenter Position = poMainFormCenter
LCLVersion = '2.1.0.0' LCLVersion = '2.1.0.0'
object CloseBtn: TButton object ParamsPanel: TPanel
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 294
Height = 25
Top = 332
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
OnClick = CloseBtnClick
TabOrder = 7
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 210
Height = 25
Top = 332
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 6
end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 148
Height = 25
Top = 332
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 5
end
object HelpBtn: TButton
Tag = 108
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 89
Height = 25
Top = 332
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 4
end
object Bevel2: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 316
Width = 361
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 8 Left = 8
Height = 15 Height = 371
Top = 8 Top = 8
Width = 97 Width = 333
BorderSpacing.Left = 8 Align = alLeft
BorderSpacing.Top = 8 BorderSpacing.Around = 8
Caption = 'Available Variables' BevelOuter = bvNone
ParentColor = False ClientHeight = 371
end ClientWidth = 333
object VarList: TListBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = HorCenterBevel
AnchorSideBottom.Control = Bevel2
Left = 8
Height = 291
Top = 25
Width = 168
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
Constraints.MinHeight = 200
ItemHeight = 0
OnClick = VarListClick
TabOrder = 0 TabOrder = 0
end object CloseBtn: TButton
object HorCenterBevel: TBevel AnchorSideRight.Control = ParamsPanel
AnchorSideLeft.Control = Owner AnchorSideRight.Side = asrBottom
AnchorSideLeft.Side = asrCenter AnchorSideBottom.Control = ParamsPanel
Left = 176 AnchorSideBottom.Side = asrBottom
Height = 78 Left = 278
Top = 55 Height = 25
Width = 8 Top = 346
Shape = bsSpacer Width = 55
end Anchors = [akRight, akBottom]
object Label2: TLabel AutoSize = True
AnchorSideLeft.Control = HorCenterBevel BorderSpacing.Top = 8
AnchorSideLeft.Side = asrBottom Caption = 'Close'
AnchorSideTop.Control = Owner ModalResult = 11
Left = 184 OnClick = CloseBtnClick
Height = 15 TabOrder = 10
Top = 8 end
Width = 77 object ComputeBtn: TButton
BorderSpacing.Top = 8 AnchorSideRight.Control = CloseBtn
Caption = 'Group Variable' AnchorSideBottom.Control = ParamsPanel
ParentColor = False AnchorSideBottom.Side = asrBottom
end Left = 194
object GroupEdit: TEdit Height = 25
AnchorSideLeft.Control = HorCenterBevel Top = 346
AnchorSideLeft.Side = asrBottom Width = 76
AnchorSideTop.Control = Label2 Anchors = [akRight, akBottom]
AnchorSideTop.Side = asrBottom AutoSize = True
AnchorSideRight.Control = Owner BorderSpacing.Left = 8
AnchorSideRight.Side = asrBottom BorderSpacing.Top = 8
Left = 184 BorderSpacing.Right = 8
Height = 23 Caption = 'Compute'
Top = 25 OnClick = ComputeBtnClick
Width = 169 TabOrder = 9
Anchors = [akTop, akLeft, akRight] end
BorderSpacing.Top = 2 object ResetBtn: TButton
BorderSpacing.Right = 8 AnchorSideRight.Control = ComputeBtn
TabOrder = 1 AnchorSideBottom.Control = ParamsPanel
Text = 'GroupEdit' AnchorSideBottom.Side = asrBottom
end Left = 132
object Label3: TLabel Height = 25
AnchorSideLeft.Control = MeasEdit Top = 346
AnchorSideBottom.Control = MeasEdit Width = 54
Left = 184 Anchors = [akRight, akBottom]
Height = 15 AutoSize = True
Top = 142 BorderSpacing.Left = 8
Width = 112 BorderSpacing.Top = 8
Anchors = [akLeft, akBottom] BorderSpacing.Right = 8
BorderSpacing.Bottom = 2 Caption = 'Reset'
Caption = 'Meaurement Variable' OnClick = ResetBtnClick
ParentColor = False TabOrder = 8
end end
object MeasEdit: TEdit object HelpBtn: TButton
AnchorSideLeft.Control = HorCenterBevel Tag = 108
AnchorSideLeft.Side = asrBottom AnchorSideRight.Control = ResetBtn
AnchorSideTop.Control = VarList AnchorSideBottom.Control = ParamsPanel
AnchorSideTop.Side = asrCenter AnchorSideBottom.Side = asrBottom
AnchorSideRight.Control = Owner Left = 73
AnchorSideRight.Side = asrBottom Height = 25
Left = 184 Top = 346
Height = 23 Width = 51
Top = 159 Anchors = [akRight, akBottom]
Width = 169 AutoSize = True
Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
TabOrder = 2 Caption = 'Help'
Text = 'MeasEdit' OnClick = HelpBtnClick
end TabOrder = 7
object GroupBox1: TGroupBox end
AnchorSideLeft.Control = HorCenterBevel object Bevel2: TBevel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Control = ParamsPanel
AnchorSideBottom.Control = VarList AnchorSideRight.Control = ParamsPanel
AnchorSideBottom.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 184 AnchorSideBottom.Control = CloseBtn
Height = 51 Left = 0
Top = 265 Height = 8
Width = 143 Top = 330
Anchors = [akLeft, akBottom] Width = 333
AutoSize = True Anchors = [akLeft, akRight, akBottom]
Caption = 'Options' Shape = bsBottomLine
ChildSizing.LeftRightSpacing = 12 end
ChildSizing.TopBottomSpacing = 6 object Label1: TLabel
ChildSizing.VerticalSpacing = 2 AnchorSideLeft.Control = ParamsPanel
ClientHeight = 31 AnchorSideTop.Control = ParamsPanel
ClientWidth = 139 Left = 0
TabOrder = 3 Height = 15
object ShowChk: TCheckBox Top = 0
Left = 12 Width = 97
Height = 19 Caption = 'Available Variables'
Top = 6 ParentColor = False
Width = 115 end
Caption = 'Show Frequencies' object VarList: TListBox
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = MeasInBtn
AnchorSideBottom.Control = Bevel2
Left = 0
Height = 313
Top = 17
Width = 145
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Right = 8
Constraints.MinHeight = 200
ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object Label2: TLabel
AnchorSideLeft.Control = GrpInBtn
AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = GroupEdit
Left = 187
Height = 15
Top = 101
Width = 77
Anchors = [akLeft, akBottom]
Caption = 'Group Variable'
ParentColor = False
end
object GroupEdit: TEdit
AnchorSideLeft.Control = GrpInBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CloseBtn
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GrpOutBtn
AnchorSideBottom.Side = asrBottom
Left = 187
Height = 23
Top = 118
Width = 146
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Bottom = 12
TabOrder = 6
Text = 'GroupEdit'
end
object Label3: TLabel
AnchorSideLeft.Control = MeasEdit
AnchorSideBottom.Control = MeasEdit
Left = 187
Height = 15
Top = 21
Width = 112
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Meaurement Variable'
ParentColor = False
end
object MeasEdit: TEdit
AnchorSideLeft.Control = MeasOutBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = VarList
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = MeasOutBtn
AnchorSideBottom.Side = asrBottom
Left = 187
Height = 23
Top = 38
Width = 146
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Bottom = 12
TabOrder = 3
Text = 'MeasEdit'
end
object GrpInBtn: TBitBtn
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = MeasOutBtn
AnchorSideTop.Side = asrBottom
Left = 153
Height = 26
Top = 97
Width = 26
BorderSpacing.Left = 8
BorderSpacing.Top = 24
BorderSpacing.Right = 8
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = GrpInBtnClick
Spacing = 0
TabOrder = 4
end
object GrpOutBtn: TBitBtn
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GrpInBtn
AnchorSideTop.Side = asrBottom
Left = 153
Height = 26
Top = 127
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = GrpOutBtnClick
Spacing = 0
TabOrder = 5
end
object MeasInBtn: TBitBtn
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
AnchorSideBottom.Control = MeasOutBtn
Left = 153
Height = 26
Top = 17
Width = 26
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = MeasInBtnClick
Spacing = 0
TabOrder = 1
end
object MeasOutBtn: TBitBtn
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = MeasInBtn
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = VarList
AnchorSideBottom.Side = asrBottom
Left = 153
Height = 26
Top = 47
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = MeasOutBtnClick
Spacing = 0
TabOrder = 2
end
end
object ParamsSplitter: TSplitter
Left = 349
Height = 387
Top = 0
Width = 5
ResizeStyle = rsPattern
end
object PageControl1: TPageControl
Left = 362
Height = 371
Top = 8
Width = 447
ActivePage = ReportPage
Align = alClient
BorderSpacing.Around = 8
TabIndex = 0
TabOrder = 2
object ReportPage: TTabSheet
Caption = 'Report'
end
object ChartPage: TTabSheet
Caption = 'Chart'
end
end end
end end

View File

@ -3,14 +3,13 @@
unit BoxPlotUnit; unit BoxPlotUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$I ../../../LazStats.inc}
interface interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Printers, StdCtrls, ExtCtrls, Printers, ComCtrls, Buttons,
MainUnit, Globals, DataProcs, OutputUnit, ContextHelpUnit; MainUnit, Globals, DataProcs, ContextHelpUnit, ReportFrameUnit, ChartFrameUnit;
type type
@ -18,38 +17,48 @@ type
{ TBoxPlotFrm } { TBoxPlotFrm }
TBoxPlotFrm = class(TForm) TBoxPlotFrm = class(TForm)
HorCenterBevel: TBevel;
Bevel2: TBevel; Bevel2: TBevel;
HelpBtn: TButton; HelpBtn: TButton;
PageControl1: TPageControl;
ParamsPanel: TPanel;
ResetBtn: TButton; ResetBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
CloseBtn: TButton; CloseBtn: TButton;
ShowChk: TCheckBox;
GroupBox1: TGroupBox;
MeasEdit: TEdit; MeasEdit: TEdit;
GroupEdit: TEdit; GroupEdit: TEdit;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
ParamsSplitter: TSplitter;
ReportPage: TTabSheet;
ChartPage: TTabSheet;
VarList: TListBox; VarList: TListBox;
GrpInBtn: TBitBtn;
GrpOutBtn: TBitBtn;
MeasInBtn: TBitBtn;
MeasOutBtn: TBitBtn;
procedure CloseBtnClick(Sender: TObject); procedure CloseBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject); procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure GrpOutBtnClick(Sender: TObject);
procedure GrpInBtnClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject); procedure HelpBtnClick(Sender: TObject);
procedure MeasInBtnClick(Sender: TObject);
procedure MeasOutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure VarListClick(Sender: TObject); procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
function Percentile(nScoreGrps: integer; APercentile: Double; FReportFrame: TReportFrame;
const Freq, CumFreq, Scores: DblDyneVec) : double; FChartFrame: TChartFrame;
{$IFDEF USE_TACHART}
procedure BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec); procedure BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec);
{$ELSE} function Percentile(nScoreGrps: integer; APercentile: Double;
procedure BoxPlot(NBars: integer; AMax, AMin: double; const Freq, CumFreq, Scores: DblDyneVec): double;
const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Means, Median: DblDyneVec); procedure UpdateBtnStates;
{$ENDIF}
public public
{ public declarations } { public declarations }
@ -64,12 +73,7 @@ implementation
{$R *.lfm} {$R *.lfm}
uses uses
{$IFDEF USE_TACHART} TAChartUtils, TALegend, TAMultiSeries,
TAChartUtils, TAMultiSeries,
ChartUnit,
{$ELSE}
BlankFrmUnit,
{$ENDIF}
Math, Utils; Math, Utils;
const const
@ -78,43 +82,46 @@ const
{ TBoxPlotFrm } { TBoxPlotFrm }
procedure TBoxPlotFrm.Reset; procedure TBoxPlotFrm.BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec);
var var
i: integer; i: Integer;
ser: TBoxAndWhiskerSeries;
clr: TColor;
nBars: Integer;
begin begin
VarList.Clear; nBars := Length(LowQrtl);
GroupEdit.Text := ''; if (nBars <> Length(HiQrtl)) or (nBars <> Length(TenPcnt)) or
MeasEdit.Text := ''; (nBars <> Length(NinetyPcnt)) or (nBars <> Length(Medians)) then
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TBoxPlotFrm.ResetBtnClick(Sender: TObject);
begin
Reset;
end;
procedure TBoxPlotFrm.VarListClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin begin
if (GroupEdit.Text = '') then ErrorMsg('Box-Plot: all data arrays must have the same lengths.');
GroupEdit.Text := VarList.Items[index] exit;
else
MeasEdit.Text := VarList.Items[index];
end; end;
FChartFrame.Clear;
// Titles
FChartFrame.SetTitle('Box-and-Whisker Plot for ' + OS3MainFrm.FileNameEdit.Text);
FChartFrame.SetFooter('BLACK: median, BOX: 25th to 75th percentile, WHISKERS: 10th and 90th percentile');
FChartFrame.SetXTitle(GroupEdit.Text);
FChartFrame.SetYTitle(MeasEdit.Text);
ser := TBoxAndWhiskerSeries.create(FChartFrame);
for i := 0 to nBars-1 do
begin
clr := BOX_COLORS[i mod Length(BOX_COLORS)];
ser.AddXY(i+1, TenPcnt[i], LowQrtl[i], Medians[i], HiQrtl[i], NinetyPcnt[i], '', clr);
end;
FChartFrame.Chart.BottomAxis.Marks.Source := ser.ListSource;
FChartFrame.Chart.BottomAxis.Marks.Style := smsXValue;
FChartFrame.Chart.AddSeries(ser);
FChartFrame.UpdateBtnStates;
end; end;
procedure TBoxPlotFrm.HelpBtnClick(Sender: TObject); procedure TBoxPlotFrm.CloseBtnClick(Sender: TObject);
begin begin
if ContextHelpForm = nil then Close;
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end; end;
@ -122,13 +129,11 @@ procedure TBoxPlotFrm.ComputeBtnClick(Sender: TObject);
var var
lReport: TStrings; lReport: TStrings;
i, j, k, GrpVar, MeasVar, mingrp, maxgrp, G, NoGrps, cnt: integer; i, j, k, GrpVar, MeasVar, mingrp, maxgrp, G, NoGrps, cnt: integer;
nScoreGrps: integer; nScoreGrps, numValues: integer;
X, tmp: Double; X: Double;
// X, tenpcnt, ninepcnt, qrtile1, qrtile2, qrtile3: double;
MinScore, MaxScore, IntervalSize, lastX: double; MinScore, MaxScore, IntervalSize, lastX: double;
cellstring: string; cellstring: string;
done: boolean; done: boolean;
NoSelected: integer;
Freq: DblDyneVec = nil; Freq: DblDyneVec = nil;
Scores: DblDyneVec = nil; Scores: DblDyneVec = nil;
CumFreq: DblDyneVec = nil; CumFreq: DblDyneVec = nil;
@ -140,7 +145,7 @@ var
TenPcntile: DblDyneVec = nil; TenPcntile: DblDyneVec = nil;
NinetyPcntile: DblDyneVec = nil; NinetyPcntile: DblDyneVec = nil;
Median: DblDyneVec = nil; Median: DblDyneVec = nil;
ColNoSelected: IntDyneVec = nil; ColNoSelected: IntDyneVec;
begin begin
lReport := TStringList.Create; lReport := TStringList.Create;
try try
@ -166,8 +171,7 @@ begin
exit; exit;
end; end;
NoSelected := 2; SetLength(ColNoSelected, 2);
SetLength(ColNoSelected, NoSelected);
ColNoSelected[0] := GrpVar; ColNoSelected[0] := GrpVar;
ColNoSelected[1] := MeasVar; ColNoSelected[1] := MeasVar;
@ -176,7 +180,7 @@ begin
maxGrp := -MaxInt; maxGrp := -MaxInt;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if not GoodRecord(i, NoSelected, ColNoSelected) then continue; if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i])); G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
minGrp := Min(G, minGrp); minGrp := Min(G, minGrp);
maxGrp := Max(G, maxGrp); maxGrp := Max(G, maxGrp);
@ -194,9 +198,11 @@ begin
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, 1]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, 1]);
MinScore := X; MinScore := X;
MaxScore := X; MaxScore := X;
numValues := 0;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if not GoodRecord(i, NoSelected ,ColNoSelected) then continue; if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
inc(numValues);
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, i]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, i]);
MaxScore := Max(MaxScore, X); MaxScore := Max(MaxScore, X);
MinScore := Min(MinScore, X); MinScore := Min(MinScore, X);
@ -209,12 +215,12 @@ begin
lastX := X; lastX := X;
end; end;
SetLength(Scores, 2*NoCases + 1); // over-dimensioned, will be trimmed later. SetLength(Scores, 2*numValues + 1); // over-dimensioned, will be trimmed later.
// check for excess no. of intervals and reset if needed // check for excess no. of intervals and reset if needed
nScoreGrps := round((MaxScore - MinScore) / IntervalSize); nScoreGrps := round((MaxScore - MinScore) / IntervalSize);
if nScoreGrps > 2 * NoCases then if nScoreGrps > 2 * numValues then
Intervalsize := (MaxScore - MinScore) / NoCases; Intervalsize := (MaxScore - MinScore) / numValues;
// setup score groups // setup score groups
done := false; done := false;
@ -260,7 +266,7 @@ begin
cnt := 0; cnt := 0;
for i := 1 to NoCases do for i := 1 to NoCases do
begin // get scores for this group j begin // get scores for this group j
if not GoodRecord(i,NoSelected, ColNoSelected) then continue; if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i])); G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
G := G - minGrp + 1; G := G - minGrp + 1;
if G = j+1 then // subject in this group if G = j+1 then // subject in this group
@ -274,8 +280,16 @@ begin
Freq[k] := Freq[k] + 1.0; Freq[k] := Freq[k] + 1.0;
end; end;
end; end;
GrpSize[j] := cnt; GrpSize[j] := cnt;
if GrpSize[j] > 0 then Means[j] := Means[j] / GrpSize[j]; if GrpSize[j] = 0 then
begin
Means[j] := NaN;
Median[j] := NaN;
Continue;
end;
Means[j] := Means[j] / GrpSize[j];
// accumulate frequencies // accumulate frequencies
CumFreq[0] := Freq[0]; CumFreq[0] := Freq[0];
@ -295,40 +309,31 @@ begin
Median[j] := Percentile(nScoreGrps, 0.50 * GrpSize[j], Freq, CumFreq, Scores); Median[j] := Percentile(nScoreGrps, 0.50 * GrpSize[j], Freq, CumFreq, Scores);
HiQrtl[j] := Percentile(nScoreGrps, 0.75 * GrpSize[j], Freq, CumFreq, Scores); HiQrtl[j] := Percentile(nScoreGrps, 0.75 * GrpSize[j], Freq, CumFreq, Scores);
if ShowChk.Checked then if j > 0 then lReport.Add('');
begin lReport.Add('RESULTS FOR GROUP %d, MEAN %.3f', [j+1, Means[j]]);
if j > 0 then lReport.Add(''); lReport.Add('');
lReport.Add('RESULTS FOR GROUP %d, MEAN = %.3f', [j+1, Means[j]]); lReport.Add('Centile Value');
lReport.Add(''); lReport.Add('------------ -------');
lReport.Add('Centile Value'); lReport.Add('Ten %6.3f', [TenPcntile[j]]);
lReport.Add('------------ ------'); lReport.Add('Twenty five %6.3f', [LowQrtl[j]]);
lReport.Add('Ten %6.3f', [TenPcntile[j]]); lReport.Add('Median %6.3f', [Median[j]]);
lReport.Add('Twenty five %6.3f', [LowQrtl[j]]); lReport.Add('Seventy five %6.3f', [HiQrtl[j]]);
lReport.Add('Median %6.3f', [Median[j]]); lReport.Add('Ninety %6.3f', [NinetyPcntile[j]]);
lReport.Add('Seventy five %6.3f', [HiQrtl[j]]); lReport.Add('');
lReport.Add('Ninety %6.3f', [NinetyPcntile[j]]); lReport.Add('Score Range Frequency Cum.Freq. Percentile Rank');
lReport.Add(''); lReport.Add('--------------- --------- --------- ---------------');
lReport.Add('Score Range Frequency Cum.Freq. Percentile Rank'); for i := 0 to nScoreGrps-1 do
lReport.Add('--------------- --------- --------- ---------------'); lReport.Add('%6.2f - %6.2f %6.2f %6.2f %6.2f', [
for i := 0 to nScoreGrps-1 do Scores[i], Scores[i+1], Freq[i], CumFreq[i], pRank[i]
lReport.Add('%6.2f - %6.2f %6.2f %6.2f %6.2f', [ ]);
Scores[i], Scores[i+1], Freq[i], CumFreq[i], pRank[i] lReport.Add('');
]);
lReport.Add('');
end;
end; // get values for next group end; // get values for next group
// Show the report with the frequencies // Show the report with the frequencies
if ShowChk.Checked then FReportFrame.DisplayReport(lReport);
DisplayReport(lReport);
// Plot the boxes // Plot the boxes
{$IFDEF USE_TACHART}
BoxPlot(LowQrtl, HiQrtl, TenPcntile, NinetyPcntile, Median); BoxPlot(LowQrtl, HiQrtl, TenPcntile, NinetyPcntile, Median);
{$ELSE}
BoxPlot(NoGrps, MaxScore, MinScore, LowQrtl, HiQrtl, TenPcntile, NinetyPcntile, Means, Median);
{$ENDIF}
finally finally
lReport.Free; lReport.Free;
@ -348,12 +353,6 @@ begin
end; end;
procedure TBoxPlotFrm.CloseBtnClick(Sender: TObject);
begin
Close;
end;
procedure TBoxPlotFrm.FormActivate(Sender: TObject); procedure TBoxPlotFrm.FormActivate(Sender: TObject);
var var
w: Integer; w: Integer;
@ -367,8 +366,17 @@ begin
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width; ParamsPanel.Constraints.MinWidth := Max(
Constraints.MinHeight := Height; 4*w + 3*HelpBtn.BorderSpacing.Right,
Max(Label1.Width, Label3.Width) * 2 + MeasInBtn.Width + 2 * MeasInBtn.BorderSpacing.Left
);
ParamsPanel.Constraints.MinHeight := VarList.Top + VarList.Constraints.MinHeight +
Bevel2.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top;
Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + ParamsPanel.BorderSpacing.Around*2;
Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 200;
if Height < Constraints.MinHeight then Height := 1; // Enforce autosizing
if Width < Constraints.MinWidth then Width := 1;
Position := poDesigned; Position := poDesigned;
FAutoSized := true; FAutoSized := true;
@ -378,12 +386,84 @@ end;
procedure TBoxPlotFrm.FormCreate(Sender: TObject); procedure TBoxPlotFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
FReportFrame := TReportFrame.Create(self);
FReportFrame.Parent := ReportPage;
FReportFrame.Align := alClient;
FChartFrame := TChartFrame.Create(self);
FChartFrame.Parent := ChartPage;
FChartFrame.Align := alClient;
FChartFrame.Chart.Legend.Alignment := laBottomCenter;
FChartFrame.Chart.Legend.ColumnCount := 3;
FChartFrame.Chart.Legend.TextFormat := tfHTML;
FChartFrame.Chart.BottomAxis.Intervals.MaxLength := 80;
FChartFrame.Chart.BottomAxis.Intervals.MinLength := 30;
InitToolbar(FChartFrame.ChartToolbar, tpTop);
Reset; Reset;
end; end;
procedure TBoxPlotFrm.GrpInBtnClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (GroupEdit.Text = '') then
begin
GroupEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TBoxPlotFrm.GrpOutBtnClick(Sender: TObject);
begin
if GroupEdit.Text <> '' then
begin
VarList.Items.Add(GroupEdit.Text);
GroupEdit.Text := '';
UpdateBtnStates;
end;
end;
procedure TBoxPlotFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TBoxPlotFrm.MeasInBtnClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (MeasEdit.Text = '') then
begin
MeasEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TBoxPlotFrm.MeasOutBtnClick(Sender: TObject);
begin
if MeasEdit.Text <> '' then
begin
VarList.Items.Add(MeasEdit.Text);
MeasEdit.Text := '';
UpdateBtnStates;
end;
end;
function TBoxPlotFrm.Percentile(nScoreGrps: integer; function TBoxPlotFrm.Percentile(nScoreGrps: integer;
APercentile: double; const Freq, CumFreq, Scores: DblDyneVec) : double; APercentile: double; const Freq, CumFreq, Scores: DblDyneVec): double;
var var
i, interval: integer; i, interval: integer;
LLimit, ULimit, cumLower, intervalFreq: double; LLimit, ULimit, cumLower, intervalFreq: double;
@ -404,8 +484,7 @@ begin
ULimit := Scores[interval+1]; ULimit := Scores[interval+1];
cumLower := CumFreq[interval-1]; cumLower := CumFreq[interval-1];
intervalFreq := Freq[interval]; intervalFreq := Freq[interval];
end end else
else
begin // Percentile in first interval begin // Percentile in first interval
LLimit := Scores[0]; LLimit := Scores[0];
ULimit := Scores[1]; ULimit := Scores[1];
@ -420,180 +499,59 @@ begin
end; end;
{$IFDEF USE_TACHART} procedure TBoxPlotFrm.Reset;
procedure TBoxPlotFrm.BoxPlot(const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Medians: DblDyneVec);
var var
i: Integer; i: integer;
ser: TBoxAndWhiskerSeries;
clr: TColor;
nBars: Integer;
begin begin
nBars := Length(LowQrtl); VarList.Clear;
if (nBars <> Length(HiQrtl)) or (nBars <> Length(TenPcnt)) or GroupEdit.Text := '';
(nBars <> Length(NinetyPcnt)) or (nBars <> Length(Medians)) then MeasEdit.Text := '';
begin for i := 1 to NoVariables do
ErrorMsg('Box-Plot: all data arrays must have the same lengths.'); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
exit; UpdateBtnStates;
end;
if ChartForm = nil then
ChartForm := TChartForm.Create(Application)
else
ChartForm.Clear;
// Titles
ChartForm.SetTitle('Box-and-Whisker Plot for ' + OS3MainFrm.FileNameEdit.Text);
ChartForm.SetFooter('BLACK: median, BOX: 25th to 75th percentile, WHISKERS: 10th and 90th percentile');
ChartForm.SetXTitle(GroupEdit.Text);
ChartForm.SetYTitle(MeasEdit.Text);
ser := TBoxAndWhiskerSeries.create(ChartForm);
for i := 0 to nBars-1 do
begin
clr := BOX_COLORS[i mod Length(BOX_COLORS)];
ser.AddXY(i+1, TenPcnt[i], LowQrtl[i], Medians[i], HiQrtl[i], NinetyPcnt[i], '', clr);
end;
ChartForm.ChartFrame.Chart.BottomAxis.Marks.Source := ser.ListSource;
ChartForm.ChartFrame.Chart.BottomAxis.Marks.Style := smsXValue;
ChartForm.ChartFrame.Chart.AddSeries(ser);
ChartForm.Show;
end; end;
{$ELSE}
procedure TBoxPlotFrm.BoxPlot(NBars: integer; AMax, AMin: double;
const LowQrtl, HiQrtl, TenPcnt, NinetyPcnt, Means, Median: DblDyneVec); procedure TBoxPlotFrm.ResetBtnClick(Sender: TObject);
begin
Reset;
end;
procedure TBoxPlotFrm.UpdateBtnStates;
begin
MeasinBtn.Enabled := (VarList.ItemIndex > -1) and (MeasEdit.Text = '');
MeasoutBtn.Enabled := (MeasEdit.Text <> '');
GrpinBtn.Enabled := (VarList.ItemIndex > -1) and (GroupEdit.Text = '');
grpoutBtn.Enabled := (GroupEdit.Text <> '');
FReportFrame.UpdateBtnStates;
FChartFrame.UpdateBtnStates;
end;
procedure TBoxPlotFrm.VarListDblClick(Sender: TObject);
var var
i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset: integer; index: integer;
vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi: integer;
XOffset, YOffset: integer;
X, Y: integer;
X1, X2, X3, X9, X10: integer; // X coordinates for box and lines
Y1, Y2, Y3, Y4, Y9: integer; // Y coordinates for box and lines
Title: string;
valincr, Yvalue: double;
begin begin
if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); index := VarList.ItemIndex;
BlankFrm.Show; if index > -1 then
imagewide := BlankFrm.Image1.width;
imagehi := BlankFrm.Image1.Height;
XOffset := imagewide div 10;
YOffset := imagehi div 10;
vtop := YOffset;
vbottom := imagehi - YOffset;
vhi := vbottom - vtop;
hleft := XOffset;
hright := imagewide - hleft - XOffset;
hwide := hright - hleft;
HTickSpace := hwide div nbars;
barwidth := HTickSpace div 2;
// Show title
Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text;
BlankFrm.Caption := Title;
(*
// show legend
Y := BlankFrm.Image1.Canvas.TextHeight(Title) * 2;
Y := Y + vtop;
Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile';
X := imagewide div 2 - BlankFrm.Canvas.TextWidth(Title) div 2;
BlankFrm.Image1.Canvas.TextOut(X,Y,Title);
*)
// Draw chart background and border
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi);
// show legend
Y := 2;
Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile';
X := imagewide div 2 - BlankFrm.Canvas.TextWidth(Title) div 2;
BlankFrm.Image1.Canvas.TextOut(X,Y,Title);
// Draw vertical axis
valincr := (AMax - AMin) / 20.0;
for i := 1 to 21 do
begin begin
Title := format('%8.2f',[AMax - ((i-1)*valincr)]); if MeasEdit.Text = '' then
strhi := BlankFrm.Image1.Canvas.TextHeight(Title); MeasEdit.Text := VarList.Items[index]
xpos := XOffset; else
Yvalue := AMax - (valincr * (i-1)); GroupEdit.Text := VarList.Items[index];
ypos := round(vhi * ( (AMax - Yvalue) / (AMax - AMin)));
ypos := ypos + vtop - strhi div 2;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
end;
BlankFrm.Image1.Canvas.MoveTo(hleft,vtop);
BlankFrm.Image1.Canvas.LineTo(hleft,vbottom);
// draw horizontal axis
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 10 );
BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 10);
for i := 1 to nbars do
begin
ypos := vbottom + 10;
xpos := round((hwide / nbars)* i + hleft);
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
Title := format('%d',[i]);
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := xpos - offset;
ypos := ypos + strhi - 2;
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
xpos := 20;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:');
end;
for i := 0 to NBars - 1 do
begin
BlankFrm.Image1.Canvas.Brush.Color := BOX_COLORS[i mod Length(BOX_COLORS)];
// plot the box front face
X9 := round(hleft + ((i+1) * HTickSpace) - (barwidth / 2));
X10 := X9 + barwidth;
X1 := X9;
X2 := X10;
Y1 := round((((AMax - HiQrtl[i]) / (AMax - AMin)) * vhi) + vtop);
Y2 := round((((AMax - LowQrtl[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.Rectangle(X1,Y1,X2,Y2);
// draw upper 90th percentile line and end
X3 := round(X1 + barwidth / 2);
BlankFrm.Image1.Canvas.MoveTo(X3,Y1);
Y3 := round((((AMax - NinetyPcnt[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.LineTo(X3,Y3);
BlankFrm.Image1.Canvas.MoveTo(X1,Y3);
BlankFrm.Image1.Canvas.LineTo(X2,Y3);
// draw lower 10th percentile line and end
BlankFrm.Image1.Canvas.MoveTo(X3,Y2);
Y4 := round((((AMax - TenPcnt[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.LineTo(X3,Y4);
BlankFrm.Image1.Canvas.MoveTo(X1,Y4);
BlankFrm.Image1.Canvas.LineTo(X2,Y4);
//plot the means line
BlankFrm.Image1.Canvas.Pen.Color := clRed;
BlankFrm.Image1.Canvas.Pen.Style := psDot;
Y9 := round((((AMax - Means[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.MoveTo(X9,Y9);
BlankFrm.Image1.Canvas.LineTo(X10,Y9);
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
BlankFrm.Image1.Canvas.Pen.Style := psSolid;
//plot the median line
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
Y9 := round((((AMax - Median[i]) / (AMax - AMin)) * vhi) + vtop);
BlankFrm.Image1.Canvas.MoveTo(X9,Y9);
BlankFrm.Image1.Canvas.LineTo(X10,Y9);
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
end; end;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
procedure TBoxPlotFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end; end;
{$ENDIF}
end. end.

View File

@ -59,6 +59,7 @@ object DescriptiveFrm: TDescriptiveFrm
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
@ -89,6 +90,7 @@ object DescriptiveFrm: TDescriptiveFrm
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
ItemHeight = 0 ItemHeight = 0
OnDblClick = SelListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 4 TabOrder = 4
end end

View File

@ -46,6 +46,8 @@ type
procedure InBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure SelListDblClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean); procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
@ -469,11 +471,41 @@ begin
FReportFrame.Clear; FReportFrame.Clear;
end; end;
procedure TDescriptiveFrm.ResetBtnClick(Sender: TObject); procedure TDescriptiveFrm.ResetBtnClick(Sender: TObject);
begin begin
Reset; Reset;
end; end;
procedure TDescriptiveFrm.SelListDblClick(Sender: TObject);
var
index: integer;
begin
index := SelList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(SelList.Items[index]);
SelList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TDescriptiveFrm.VarListDblClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
SelList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TDescriptiveFrm.UpdateBtnStates; procedure TDescriptiveFrm.UpdateBtnStates;
var var
lSelected: Boolean; lSelected: Boolean;

View File

@ -104,11 +104,12 @@ object PlotXYFrm: TPlotXYFrm
Left = 0 Left = 0
Height = 274 Height = 274
Top = 17 Top = 17
Width = 166 Width = 167
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
@ -116,9 +117,9 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideLeft.Control = XEdit AnchorSideLeft.Control = XEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = XEdit AnchorSideBottom.Control = XEdit
Left = 210 Left = 209
Height = 15 Height = 15
Top = 23 Top = 19
Width = 76 Width = 76
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -128,9 +129,9 @@ object PlotXYFrm: TPlotXYFrm
object Label3: TLabel object Label3: TLabel
AnchorSideLeft.Control = YEdit AnchorSideLeft.Control = YEdit
AnchorSideBottom.Control = YEdit AnchorSideBottom.Control = YEdit
Left = 210 Left = 209
Height = 15 Height = 15
Top = 109 Top = 101
Width = 76 Width = 76
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -141,10 +142,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 174 Left = 175
Height = 28 Height = 26
Top = 17 Top = 17
Width = 28 Width = 26
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
@ -158,10 +159,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = XinBtn AnchorSideTop.Control = XinBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 174 Left = 175
Height = 28 Height = 26
Top = 49 Top = 47
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
@ -175,10 +176,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideTop.Control = XOutBtn AnchorSideTop.Control = XOutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = YOutBtn AnchorSideBottom.Control = YOutBtn
Left = 174 Left = 175
Height = 28 Height = 26
Top = 101 Top = 97
Width = 28 Width = 26
BorderSpacing.Top = 24 BorderSpacing.Top = 24
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
@ -194,10 +195,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = VarList AnchorSideBottom.Control = VarList
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 174 Left = 175
Height = 28 Height = 26
Top = 133 Top = 127
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
@ -212,10 +213,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = XOutBtn AnchorSideBottom.Control = XOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 210 Left = 209
Height = 23 Height = 23
Top = 42 Top = 38
Width = 158 Width = 159
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -231,10 +232,10 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = YOutBtn AnchorSideBottom.Control = YOutBtn
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 210 Left = 209
Height = 23 Height = 23
Top = 126 Top = 118
Width = 166 Width = 167
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
@ -246,9 +247,9 @@ object PlotXYFrm: TPlotXYFrm
AnchorSideTop.Control = YEdit AnchorSideTop.Control = YEdit
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 174 Left = 175
Height = 120 Height = 120
Top = 173 Top = 165
Width = 191 Width = 191
AutoSize = True AutoSize = True
BorderSpacing.Top = 24 BorderSpacing.Top = 24

View File

@ -46,6 +46,7 @@ type
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure XinBtnClick(Sender: TObject); procedure XinBtnClick(Sender: TObject);
procedure XOutBtnClick(Sender: TObject); procedure XOutBtnClick(Sender: TObject);
@ -105,6 +106,23 @@ begin
end; end;
procedure TPlotXYFrm.VarListDblClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
if XEdit.Text = '' then
XEdit.Text := VarList.Items[index]
else
YEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TPlotXYFrm.XinBtnClick(Sender: TObject); procedure TPlotXYFrm.XinBtnClick(Sender: TObject);
var var
index: integer; index: integer;
@ -385,8 +403,7 @@ begin
Marks.Style := smsLabel; Marks.Style := smsLabel;
Grid.Visible := false; Grid.Visible := false;
end; end;
FChartFrame.ChartToolbar.Transparent := false; InitToolbar(FChartFrame.ChartToolbar, tpTop);
FChartFrame.ChartToolbar.Color := clForm;
Reset; Reset;
end; end;
@ -462,8 +479,12 @@ procedure TPlotXYFrm.UpdateBtnStates;
begin begin
XinBtn.Enabled := (VarList.ItemIndex > -1) and (XEdit.Text = ''); XinBtn.Enabled := (VarList.ItemIndex > -1) and (XEdit.Text = '');
XoutBtn.Enabled := (XEdit.Text <> ''); XoutBtn.Enabled := (XEdit.Text <> '');
YinBtn.Enabled := (VarList.ItemIndex > -1) and (YEdit.Text = ''); YinBtn.Enabled := (VarList.ItemIndex > -1) and (YEdit.Text = '');
YoutBtn.Enabled := (YEdit.Text <> ''); YoutBtn.Enabled := (YEdit.Text <> '');
FReportFrame.UpdateBtnStates;
FChartFrame.UpdateBtnStates;
end; end;

View File

@ -129,21 +129,22 @@ object BasicSPCForm: TBasicSPCForm
Left = 0 Left = 0
Height = 363 Height = 363
Top = 25 Top = 25
Width = 158 Width = 157
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
OnClick = VarListClick OnClick = VarListClick
OnDblClick = VarListDblClick
TabOrder = 0 TabOrder = 0
end end
object GroupLabel: TLabel object GroupLabel: TLabel
AnchorSideLeft.Control = GroupEdit AnchorSideLeft.Control = GroupEdit
AnchorSideTop.Control = GroupInBtn AnchorSideTop.Control = GroupInBtn
Left = 198 Left = 199
Height = 15 Height = 15
Top = 93 Top = 99
Width = 105 Width = 105
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
@ -157,10 +158,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SpecsPanel AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 199
Height = 23 Height = 23
Top = 110 Top = 116
Width = 159 Width = 158
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -172,7 +173,7 @@ object BasicSPCForm: TBasicSPCForm
object MeasLabel: TLabel object MeasLabel: TLabel
AnchorSideLeft.Control = MeasEdit AnchorSideLeft.Control = MeasEdit
AnchorSideTop.Control = MeasInBtn AnchorSideTop.Control = MeasInBtn
Left = 198 Left = 199
Height = 15 Height = 15
Top = 27 Top = 27
Width = 117 Width = 117
@ -188,10 +189,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SpecsPanel AnchorSideRight.Control = SpecsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 199
Height = 23 Height = 23
Top = 44 Top = 44
Width = 159 Width = 158
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -213,10 +214,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideLeft.Control = SpecsPanel AnchorSideLeft.Control = SpecsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 166 Left = 165
Height = 24 Height = 26
Top = 25 Top = 25
Width = 24 Width = 26
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = MeasInBtnClick OnClick = MeasInBtnClick
@ -226,10 +227,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = MeasInBtn AnchorSideTop.Control = MeasInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 167 Left = 165
Height = 22 Height = 26
Top = 53 Top = 55
Width = 23 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
@ -240,10 +241,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = MeasOutBtn AnchorSideTop.Control = MeasOutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 166 Left = 165
Height = 24 Height = 26
Top = 91 Top = 97
Width = 24 Width = 26
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
@ -254,10 +255,10 @@ object BasicSPCForm: TBasicSPCForm
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GroupInBtn AnchorSideTop.Control = GroupInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 167 Left = 165
Height = 22 Height = 26
Top = 119 Top = 127
Width = 23 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0

View File

@ -47,6 +47,7 @@ type
procedure MeasOutBtnClick(Sender: TObject); procedure MeasOutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure VarListClick(Sender: TObject); procedure VarListClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
private private
FGroupsNeeded: Boolean; FGroupsNeeded: Boolean;
@ -187,6 +188,7 @@ begin
Marks.Source := TListChartSource.Create(self); Marks.Source := TListChartSource.Create(self);
Marks.Style := smsLabel; Marks.Style := smsLabel;
end; end;
InitToolbar(FChartFrame.ChartToolbar, tpTop);
Reset; Reset;
end; end;
@ -420,5 +422,21 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TBasicSPCForm.VarListDblClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
if MeasEdit.Text = '' then
MeasEdit.Text := VarList.Items[index]
else
GroupEdit.Text := VarList.Items[index];
end;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end. end.

View File

@ -1987,11 +1987,8 @@ end;
procedure TOS3MainFrm.mnuAnalysisDescr_BubblePlotClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisDescr_BubblePlotClick(Sender: TObject);
begin begin
if BubbleForm = nil then if BubbleForm = nil then
begin
Application.CreateForm(TBubbleForm, BubbleForm); Application.CreateForm(TBubbleForm, BubbleForm);
BubbleForm.Position := poMainFormCenter; BubbleForm.Show;
end;
BubbleForm.ShowModal;
end; end;
// Menu "Analysis" > "Descriptive" > "Compare mnuAnalysisDescr_DistribStats" // Menu "Analysis" > "Descriptive" > "Compare mnuAnalysisDescr_DistribStats"
@ -2022,10 +2019,7 @@ end;
procedure TOS3MainFrm.mnuAnalysisDescr_DistribStatsClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisDescr_DistribStatsClick(Sender: TObject);
begin begin
if DescriptiveFrm = nil then if DescriptiveFrm = nil then
begin
Application.CreateForm(TDescriptiveFrm, DescriptiveFrm); Application.CreateForm(TDescriptiveFrm, DescriptiveFrm);
DescriptiveFrm.Position := poMainFormCenter;
end;
DescriptiveFrm.Show; DescriptiveFrm.Show;
end; end;
@ -2095,11 +2089,8 @@ end;
procedure TOS3MainFrm.mnuAnalysisDescr_PlotXvsYClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisDescr_PlotXvsYClick(Sender: TObject);
begin begin
if PlotXYFrm = nil then if PlotXYFrm = nil then
begin
Application.CreateForm(TPlotXYFrm, PlotXYFrm); Application.CreateForm(TPlotXYFrm, PlotXYFrm);
PlotXYFrm.Position := poMainFormCenter; PlotXYFrm.Show;
end;
PlotXYFrm.ShowModal;
end; end;
procedure TOS3MainFrm.mnuAnalysisDescr_ResistanceLineClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisDescr_ResistanceLineClick(Sender: TObject);

View File

@ -9,10 +9,10 @@ object ChartFrame: TChartFrame
DesignLeft = 518 DesignLeft = 518
DesignTop = 150 DesignTop = 150
object Chart: TChart object Chart: TChart
Left = 6 Left = 0
Height = 367 Height = 379
Top = 30 Top = 24
Width = 608 Width = 620
AxisList = < AxisList = <
item item
Grid.Color = clSilver Grid.Color = clSilver
@ -36,6 +36,8 @@ object ChartFrame: TChartFrame
Foot.Brush.Color = clBtnFace Foot.Brush.Color = clBtnFace
Foot.Brush.Style = bsClear Foot.Brush.Style = bsClear
Foot.Font.Color = clBlue Foot.Font.Color = clBlue
MarginsExternal.Top = 8
MarginsExternal.Right = 8
Title.Brush.Color = clBtnFace Title.Brush.Color = clBtnFace
Title.Brush.Style = bsClear Title.Brush.Style = bsClear
Title.Font.Color = clBlue Title.Font.Color = clBlue
@ -45,9 +47,6 @@ object ChartFrame: TChartFrame
) )
Toolset = ChartToolset Toolset = ChartToolset
Align = alClient Align = alClient
BorderSpacing.Left = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
Color = clWhite Color = clWhite
end end
object ChartToolBar: TToolBar object ChartToolBar: TToolBar
@ -56,7 +55,6 @@ object ChartFrame: TChartFrame
Top = 0 Top = 0
Width = 620 Width = 620
AutoSize = True AutoSize = True
BorderSpacing.Bottom = 6
ButtonHeight = 22 ButtonHeight = 22
ButtonWidth = 25 ButtonWidth = 25
Caption = 'ChartToolBar' Caption = 'ChartToolBar'

View File

@ -49,25 +49,30 @@ object ReportFrame: TReportFrame
end end
end end
object ReportPanel: TPanel object ReportPanel: TPanel
Left = 6 Left = 4
Height = 204 Height = 206
Top = 30 Top = 30
Width = 298 Width = 302
Align = alClient Align = alClient
BorderSpacing.Around = 6 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
BorderStyle = bsSingle BorderStyle = bsSingle
ClientHeight = 200 ClientHeight = 202
ClientWidth = 294 ClientWidth = 298
Color = clWhite
ParentColor = False
TabOrder = 1 TabOrder = 1
object ReportMemo: TMemo object ReportMemo: TMemo
Left = 4 Left = 4
Height = 192 Height = 194
Top = 4 Top = 4
Width = 286 Width = 294
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
BorderStyle = bsNone BorderStyle = bsNone
Color = clWhite
Font.Height = -11 Font.Height = -11
Font.Name = 'Courier New' Font.Name = 'Courier New'
ParentFont = False ParentFont = False

View File

@ -26,7 +26,6 @@ type
procedure tbSaveReportClick(Sender: TObject); procedure tbSaveReportClick(Sender: TObject);
private private
FPrintY: Integer; FPrintY: Integer;
FMaxLen: Integer;
function LongestLine(AReport: TStrings): Integer; function LongestLine(AReport: TStrings): Integer;
protected protected
@ -76,15 +75,20 @@ var
maxLen: Integer; maxLen: Integer;
s: String; s: String;
begin begin
if not Add then ReportMemo.Lines.BeginUpdate;
ReportMemo.Clear; try
if not Add then
ReportMemo.Clear;
maxLen := Longestline(AReport); maxLen := Longestline(AReport);
for s in AReport do for s in AReport do
if s = DIVIDER_AUTO then if s = DIVIDER_AUTO then
ReportMemo.Lines.Add(AddChar('-', '', maxLen)) ReportMemo.Lines.Add(AddChar('-', '', maxLen))
else else
ReportMemo.Lines.Add(s); ReportMemo.Lines.Add(s);
finally
Reportmemo.Lines.EndUpdate;
end;
UpdateBtnStates; UpdateBtnStates;
end; end;

View File

@ -5,10 +5,14 @@ unit Utils;
interface interface
uses uses
Classes, SysUtils, StdCtrls, ComCtrls, Dialogs, Classes, SysUtils, Graphics, Controls, StdCtrls, ComCtrls, Dialogs,
Globals; Globals;
type
TToolbarPosition = (tpTop, tpLeft, tpRight);
procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar); procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar);
procedure InitToolbar(AToolbar: TToolbar; APosition: TToolbarPosition);
function AnySelected(AListbox: TListBox): Boolean; function AnySelected(AListbox: TListBox): Boolean;
@ -27,6 +31,9 @@ function IndexOfString(L: StrDyneVec; s: String): Integer;
implementation implementation
uses
ToolWin;
// https://stackoverflow.com/questions/4093595/create-ttoolbutton-runtime // https://stackoverflow.com/questions/4093595/create-ttoolbutton-runtime
procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar); procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar);
var var
@ -41,6 +48,30 @@ begin
end; end;
procedure InitToolbar(AToolbar: TToolbar; APosition: TToolbarPosition);
begin
// AToolbar.Transparent := false;
// AToolbar.Color := clForm;
case APosition of
tpTop:
begin
AToolbar.Align := alTop;
AToolbar.EdgeBorders := [ebBottom];
end;
tpLeft:
begin
AToolbar.Align := alLeft;
AToolbar.EdgeBorders := [ebRight];
end;
tpRight:
begin
AToolbar.Align := alRight;
AToolbar.EdgeBorders := [ebLeft];
end;
end;
end;
function AnySelected(AListBox: TListBox): Boolean; function AnySelected(AListBox: TListBox): Boolean;
var var
i: Integer; i: Integer;