You've already forked lazarus-ccr
0875c16886
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7881 8e941d3f-bd1b-0410-a28a-d453659cc2b4
281 lines
8.6 KiB
ObjectPascal
281 lines
8.6 KiB
ObjectPascal
unit CCHARTUNIT;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, ExtCtrls, MainUnit, Globals, DataProcs, Math, OutPutUnit, Buttons,
|
|
FunctionsLib, BlankFrmUnit, contexthelpunit;
|
|
|
|
type
|
|
|
|
{ TcChartFrm }
|
|
|
|
TcChartFrm = class(TForm)
|
|
HelpBtn: TButton;
|
|
ResetBtn: TButton;
|
|
CancelBtn: TButton;
|
|
ComputeBtn: TButton;
|
|
ReturnBtn: TButton;
|
|
XSigmaEdit: TEdit;
|
|
MeasEdit: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
VarList: TListBox;
|
|
SigmaOpts: TRadioGroup;
|
|
procedure ComputeBtnClick(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure HelpBtnClick(Sender: TObject);
|
|
procedure VarListClick(Sender: TObject);
|
|
procedure ResetBtnClick(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
procedure PlotMeans(VAR means : DblDyneVec;
|
|
NoGrps : integer;
|
|
UCL, LCL, GrandMean : double;
|
|
Sender: TObject);
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
cChartFrm: TcChartFrm;
|
|
|
|
implementation
|
|
|
|
{ TcChartFrm }
|
|
|
|
procedure TcChartFrm.ResetBtnClick(Sender: TObject);
|
|
VAR i : integer;
|
|
begin
|
|
VarList.Clear;
|
|
MeasEdit.Text := '';
|
|
XSigmaEdit.Text := '';
|
|
SigmaOpts.ItemIndex := 0;
|
|
for i := 1 to NoVariables do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
end;
|
|
|
|
procedure TcChartFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ResetBtnClick(self);
|
|
end;
|
|
|
|
procedure TcChartFrm.HelpBtnClick(Sender: TObject);
|
|
begin
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
|
end;
|
|
|
|
procedure TcChartFrm.ComputeBtnClick(Sender: TObject);
|
|
var
|
|
i, MeasVar : integer;
|
|
X, size, UCL, LCL, Sigma : double;
|
|
GrandMean, meanc, stddevc : double;
|
|
means : DblDyneVec;
|
|
cellstring, outline : string;
|
|
ColNoSelected : IntDyneVec;
|
|
NoSelected : integer;
|
|
begin
|
|
SetLength(ColNoSelected,1);
|
|
MeasVar := 1;
|
|
Sigma := 3.0;
|
|
for i := 1 to NoVariables do
|
|
begin
|
|
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
|
|
if cellstring = MeasEdit.Text then MeasVar := i;
|
|
end;
|
|
NoSelected := 1;
|
|
ColNoSelected[0] := MeasVar;
|
|
|
|
if SigmaOpts.ItemIndex = 3 then
|
|
Sigma := StrToFloat(XSigmaEdit.Text);
|
|
if SigmaOpts.ItemIndex = 0 then Sigma := 3.0;
|
|
if SigmaOpts.ItemIndex = 1 then Sigma := 2.0;
|
|
if SigmaOpts.ItemIndex = 2 then Sigma := 1.0;
|
|
|
|
SetLength(means,NoCases + 1);
|
|
GrandMean := 0.0;
|
|
size := 0;
|
|
|
|
for i := 1 to NoCases do
|
|
begin
|
|
if Not GoodRecord(i,NoSelected,ColNoSelected) then continue;
|
|
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i]));
|
|
means[i] := X;
|
|
GrandMean := GrandMean + X;
|
|
size := size + 1;
|
|
end;
|
|
|
|
meanc := GrandMean / size;
|
|
stddevc := sqrt(meanc);
|
|
UCL := meanc + (Sigma * stddevc);
|
|
LCL := meanc - (Sigma * stddevc);
|
|
|
|
// printed results
|
|
OutPutFrm.RichEdit.Lines.Add('Defects c Control Chart Results');
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Sample Number of ');
|
|
OutPutFrm.RichEdit.Lines.Add(' Noncomformities');
|
|
OutPutFrm.RichEdit.Lines.Add('______ _______________');
|
|
for i := 1 to NoCases do
|
|
begin
|
|
outline := format(' %3d %8.2f',[i,means[i]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
outline := format('Total Nonconformities = %8.2f',[GrandMean]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
outline := format('No. of samples = %d',[NoCases]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
outline := format('Poisson mean and variance = %8.3f',[meanc]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
outline := format('Lower Control Limit = %8.3f, Upper Control Limit = %8.3f',
|
|
[LCL, UCL]);
|
|
OutPutfrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.ShowModal;
|
|
|
|
// show graph
|
|
PlotMeans(means,NoCases,UCL,LCL,meanc,self);
|
|
|
|
means := nil;
|
|
ColNoSelected := nil;
|
|
end;
|
|
|
|
procedure TcChartFrm.VarListClick(Sender: TObject);
|
|
VAR index : integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
MeasEdit.Text := VarList.Items.Strings[index];
|
|
end;
|
|
|
|
procedure TcChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL,
|
|
LCL, GrandMean: double; Sender: TObject);
|
|
var
|
|
i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
|
|
vhi, hwide, offset, strhi : integer;
|
|
imagehi, maxval, minval, valincr, Yvalue : double;
|
|
Title : string;
|
|
begin
|
|
maxval := -10000.0;
|
|
minval := 10000.0;
|
|
for i := 1 to NoGrps do
|
|
begin
|
|
if means[i] > maxval then maxval := means[i];
|
|
if means[i] < minval then minval := means[i];
|
|
end;
|
|
if UCL > maxval then maxval := UCL;
|
|
if LCL < minval then minval := LCL;
|
|
BlankFrm.Image1.Canvas.Clear;
|
|
BlankFrm.Show;
|
|
Title := 'DEFECT CONTROL (c) CHART FOR : ' + OS3MainFrm.FileNameEdit.Text;
|
|
BlankFrm.Caption := Title;
|
|
imagewide := BlankFrm.Image1.Width;
|
|
imagehi := BlankFrm.Image1.Height;
|
|
vtop := 20;
|
|
vbottom := round(imagehi) - 80;
|
|
vhi := vbottom - vtop;
|
|
hleft := 100;
|
|
hright := imagewide - 80;
|
|
hwide := hright - hleft;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
|
|
|
|
// Draw chart border
|
|
BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10);
|
|
|
|
// draw Grand Mean
|
|
ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval)));
|
|
ypos := ypos + vtop;
|
|
xpos := hleft;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clRed;
|
|
BlankFrm.Image1.Canvas.Brush.Color := clLtGray;
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
|
xpos := hright;
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
|
Title := 'MEAN';
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
ypos := ypos - strhi div 2;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
|
|
// draw horizontal axis
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20);
|
|
BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20);
|
|
for i := 1 to NoGrps do
|
|
begin
|
|
ypos := vbottom + 10;
|
|
xpos := round((hwide / NoGrps)* 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;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
xpos := 10;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:');
|
|
end;
|
|
|
|
// Draw vertical axis
|
|
valincr := (maxval - minval) / 10.0;
|
|
for i := 1 to 11 do
|
|
begin
|
|
Title := format('%8.2f',[maxval - ((i-1)*valincr)]);
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
xpos := 10;
|
|
Yvalue := maxval - (valincr * (i-1));
|
|
ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval)));
|
|
ypos := ypos + vtop - strhi div 2;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
end;
|
|
|
|
// draw lines for means of the groups
|
|
ypos := round(vhi * ( (maxval - means[1]) / (maxval - minval)));
|
|
ypos := ypos + vtop;
|
|
xpos := round((hwide / NoGrps) + hleft);
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
|
BlankFrm.Image1.Canvas.Pen.Color := clBlack;
|
|
for i := 2 to NoGrps do
|
|
begin
|
|
ypos := round(vhi * ( (maxval - means[i]) / (maxval - minval)));
|
|
ypos := ypos + vtop;
|
|
xpos := round((hwide / NoGrps)* i + hleft);
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
|
end;
|
|
|
|
// Draw upper and lower confidence intervals
|
|
ypos := round(vhi * ( (maxval - UCL) / (maxval - minval)));
|
|
ypos := ypos + vtop;
|
|
xpos := hleft;
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
|
xpos := hright;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clRed;
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
|
Title := 'UCL';
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
ypos := ypos - strhi div 2;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
|
|
ypos := round(vhi * ( (maxval - LCL) / (maxval - minval)));
|
|
ypos := ypos + vtop;
|
|
xpos := hleft;
|
|
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
|
|
xpos := hright;
|
|
BlankFrm.Image1.Canvas.Pen.Color := clRed;
|
|
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
|
|
Title := 'LCL';
|
|
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
|
|
ypos := ypos - strhi div 2;
|
|
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
|
|
end;
|
|
|
|
initialization
|
|
{$I cchartunit.lrs}
|
|
|
|
end.
|
|
|