lazarus-ccr/applications/lazstats/source_orig/uchartunit.pas

unit UChartUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, MainUnit, Globals, Math, OutPutUnit,
  Buttons, DataProcs, FunctionsLib, BlankFrmUnit, contexthelpunit;

type

  { TUChartFrm }

  TUChartFrm = class(TForm)
    HelpBtn: TButton;
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    XSigmaEdit: TEdit;
    NoInspEdit: TEdit;
    Label3: TLabel;
    MeasEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    SigmaOpts: TRadioGroup;
    VarList: TListBox;
    procedure ComputeBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure VarListClick(Sender: TObject);
  private
    { private declarations }
    procedure PlotMeans(VAR means : DblDyneVec;
                        NoGrps : integer;
                        UCL, LCL, GrandMean : double;
                        Sender: TObject);
  public
    { public declarations }
  end; 

var
  UChartFrm: TUChartFrm;

implementation

{ TUChartFrm }

procedure TUChartFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     VarList.Clear;
     MeasEdit.Text := '';
     NoInspEdit.Text := '';
     XSigmaEdit.Text := '';
     SigmaOpts.ItemIndex := 0;
     for i := 1 to NoVariables do
         VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;

procedure TUChartFrm.VarListClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     MeasEdit.Text := VarList.Items.Strings[index];
end;

procedure TUChartFrm.FormShow(Sender: TObject);
begin
     ResetBtnClick(self);
end;

procedure TUChartFrm.HelpBtnClick(Sender: TObject);
begin
  ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;

procedure TUChartFrm.ComputeBtnClick(Sender: TObject);
var
   i, MeasVar : integer;
   X, size, count, UCL, LCL, Sigma : double;
   GrandMean, meanc, stddevc : double;
   means, defperunit : DblDyneVec;
   cellstring, outline : string;
   ColNoSelected : IntDyneVec;
   NoSelected : integer;
begin
     SetLength(ColNoSelected,2);
     MeasVar := 2;
     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);
     SetLength(defperunit,NoCases + 1);
     GrandMean := 0.0;
     size := 0.0;
     count := StrToFloat(NoInspEdit.Text);

     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;
          defperunit[i] := means[i] / count;
          size := size + count;
     end;

     meanc := GrandMean / size;
     stddevc := sqrt(meanc / count);
     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 No Defects Defects Per Unit');
     OutPutFrm.RichEdit.Lines.Add('______ __________ ________________');
     for i := 1 to NoCases do
     begin
          outline := format(' %3d     %8.2f    %8.2f',[i,means[i], defperunit[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('Def. / unit mean = %8.3f and variance = %8.3f',[meanc, stddevc]);
     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(defperunit,NoCases,UCL,LCL,meanc,self);

     defperunit := nil;
     means := nil;
     ColNoSelected := nil;
end;

procedure TUChartFrm.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 uchartunit.lrs}

end.