LazStats: Add right axis for spec level labelling in XBarUnit.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7649 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-07 09:21:26 +00:00
parent c06edbd9f7
commit b40e213839
2 changed files with 62 additions and 48 deletions

View File

@ -17,7 +17,8 @@ uses
StdCtrls, ExtCtrls, Buttons, ComCtrls,
MainUnit, Globals, ContextHelpUnit, DataProcs, GraphLib,
{$IFDEF USE_TACHART}
TAChartUtils, TACustomSeries, ChartFrameUnit;
TAChartUtils, TASources, TACustomSeries, TASeries, TALegend, TAChartAxisUtils,
ChartFrameUnit;
{$ELSE}
OutputUnit, BlankFrmUnit;
{$ENDIF}
@ -318,6 +319,14 @@ begin
FChartFrame.Align := alClient;
FChartFrame.BorderSpacing.Around := Scale96ToFont(8);
FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30);
FChartFrame.Chart.Legend.Alignment := laBottomCenter;
FChartFrame.Chart.Legend.ColumnCount := 3;
with FChartFrame.Chart.AxisList.Add do
begin
Alignment := calRight;
Marks.Source := TListChartSource.Create(self);
Marks.Style := smsLabel;
end;
{$ELSE}
if BlankFrm = nil then
Application.CreateForm(TBlankFrm, BlankFrm);
@ -340,6 +349,9 @@ const
var
{$IFDEF USE_TACHART}
ser: TChartSeries;
rightLabels: TListChartSource;
constLine: TConstantLine;
s: String;
{$ELSE}
i: Integer;
xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer;
@ -350,6 +362,8 @@ var
{$ENDIF}
begin
{$IFDEF USE_TACHART}
rightLabels := FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource;
FChartFrame.Clear;
FChartFrame.SetTitle('XBAR chart for ' + OS3MainFrm.FileNameEdit.Text, taLeftJustify);
FChartFrame.SetXTitle(GroupEdit.Text);
@ -360,37 +374,39 @@ begin
FChartFrame.Chart.BottomAxis.Marks.style := smsLabel;
FChartFrame.HorLine(GrandMean, clRed, psSolid, 'Grand mean');
rightLabels.Add(GrandMean, GrandMean, 'Grand mean');
FChartFrame.HorLine(UCL, CL_COLOR, CL_STYLE, 'UCL/LCL');
rightLabels.Add(UCL, UCL, 'UCL');
FChartFrame.HorLine(LCL, CL_COLOR, CL_STYLE, '');
rightLabels.Add(UCL, LCL, 'LCL');
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 LowSpecChk.Checked then
s := 'Upper/Lower Spec'
else
s := 'Upper Spec';
FChartFrame.HorLine(UpperSpec, SPEC_COLOR, SPEC_STYLE, s);
rightLabels.Add(UpperSpec, UpperSpec, 'Upper Spec');
end;
if TargetChk.Checked then
if TargetChk.Checked then begin
FChartFrame.HorLine(TargetSpec, TARGET_COLOR, psSolid, 'Target');
rightLabels.Add(TargetSpec, TargetSpec, 'Target');
end;
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');
if UpSpecChk.Checked then
s := 'Upper/Lower Spec'
else
s := 'Lower Spec';
constLine := FChartFrame.HorLine(LowerSpec, SPEC_COLOR, SPEC_STYLE, s);
constLine.Legend.Visible := not UpSpecChk.Checked;
rightLabels.Add(LowerSpec, LowerSpec, 'Lower Spec');
end;
{$ELSE}
NoGrps := Length(groups);
maxval := -Infinity;

View File

@ -24,15 +24,15 @@ type
ZoomDragTool: TZoomDragTool;
protected
procedure Constline(xy: Double; ADirection: TLineStyle; AColor: TColor;
ALineStyle: TPenStyle; ALegendTitle: String);
function Constline(xy: Double; ADirection: TLineStyle; AColor: TColor;
ALineStyle: TPenStyle; ALegendTitle: String): TConstantLine;
public
procedure Clear;
procedure GetXRange(out XMin, XMax: Double; Logical: Boolean = true);
procedure GetYRange(out YMin, YMax: Double; Logical: Boolean = true);
procedure HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
function HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String): TConstantLine;
function PlotXY(AType: TPlotType; x, y: DblDyneVec; xLabels: StrDyneVec;
yErrorBars: DblDyneVec; LegendTitle: string; AColor: TColor;
ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
@ -42,8 +42,8 @@ type
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;
ALegendTitle: String);
function VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String): TConstantLine;
end;
implementation
@ -65,19 +65,17 @@ begin
end;
procedure TChartFrame.Constline(xy: Double; ADirection: TLineStyle;
AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
var
ser: TConstantLine;
function TChartFrame.Constline(xy: Double; ADirection: TLineStyle;
AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String): TConstantLine;
begin
ser := TConstantLine.Create(self);
ser.Position := xy;
ser.LineStyle := ADirection;
ser.Pen.Color := AColor;
ser.Pen.Style := ALineStyle;
ser.Title := ALegendTitle;
ser.Legend.Visible := ALegendTitle <> '';
Chart.AddSeries(ser);
Result := TConstantLine.Create(self);
Result.Position := xy;
Result.LineStyle := ADirection;
Result.Pen.Color := AColor;
Result.Pen.Style := ALineStyle;
Result.Title := ALegendTitle;
Result.Legend.Visible := ALegendTitle <> '';
Chart.AddSeries(Result);
end;
@ -107,17 +105,17 @@ begin
end;
procedure TChartFrame.HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
function TChartFrame.HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String): TConstantLine;
begin
ConstLine(y, lsHorizontal, AColor, ALineStyle, ALegendTitle);
Result := ConstLine(y, lsHorizontal, AColor, ALineStyle, ALegendTitle);
end;
procedure TChartFrame.VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
function TChartFrame.VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String): TConstantLine;
begin
ConstLine(x, lsVertical, AColor, ALineStyle, ALegendTitle);
Result := ConstLine(x, lsVertical, AColor, ALineStyle, ALegendTitle);
end;