unit u_audit;
{$Warnings off}
{$hints on}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, sSkinManager, sComboBox, sGroupBox, ComCtrls, ExtCtrls,
  sPageControl, CheckLst, sAlphaListBox, sCheckListBox, sPanel, sBevel,
  sSplitter, sMemo,DBTables, DB, WordXP,OleServer,comobj,FileUtils,
  XMLDoc, XMLintf;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    Button1: TButton;
    sComboBox1: TsComboBox;
    sGroupBox1: TsGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    sCheckListBox1: TsCheckListBox;
    sTabSheet4: TsTabSheet;
    Label7: TLabel;
    Label4: TLabel;
    Button4: TButton;
    sPanel1: TsPanel;
    sSplitter1: TsSplitter;
    Button7: TButton;
    Label9: TLabel;
    Edit4: TEdit;
    sCheckListBox2: TsCheckListBox;
    Button8: TButton;
    Button9: TButton;
    Edit5: TEdit;
    Label10: TLabel;
    Edit6: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    Edit7: TEdit;
    Label13: TLabel;
    Edit8: TEdit;
    Label14: TLabel;
    Edit9: TEdit;
    Label15: TLabel;
    ComboBox3: TComboBox;
    sMemo1: TsMemo;
    ComboBox4: TComboBox;
    procedure ComboBox1Select(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ComboBox2DropDown(Sender: TObject);
    procedure ComboBox1DropDown(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sComboBox1Select(Sender: TObject);
    procedure sPageControl1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure sCheckListBox2ClickCheck(Sender: TObject);
    procedure sCheckListBox2Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure ComboBox4DropDown(Sender: TObject);
    procedure ComboBox4Select(Sender: TObject);
  private
    { Private declarations }
  public
    procedure ReCheck;
    { Public declarations }
  end;
  PTable = ^TTable;

  TTreeField = Class
    ID,
    Name,
    _Ratios,
    _Percent,
    _Value,
    _RepName,
    _PreRatios,
    _Weight : String;
    _PrePercent: Double;


    value : Single;
    Checked : boolean;
    Item : Array of record
      _Used    : Boolean;
      _Name    : String;
      _Message : String;
      _FText   : String;
      _RText   : String;
      _CHK_ID  : String;
    end;
    Function Add(zName:String) : integer;
    Procedure Clear;
  end;

const
  db_dep = 0;
  db_kaf = 1;
  db_std = 2;
  db_chk = 3;
  db_KSC = 4;
  db_stdchk = 5;

  Month : Array [0..11] of String = ('января','февраля','марта','апреля','мая','июня','июля','авкуста','сентября','октября','ноября','декабря');

const
REG_ID		      =0;
CUR_DAY		      =1;
CUR_MONTH	      =2;
CUR_MONTH_NUM	  =3;
CUR_YEAR	      =4;
CUR_DATE	      =5;
NEXT_DATE	      =6;
DEP_NAME	      =7;
OBJ_NAME	      =8;
FIO1		        =9;
FIO2		        =10;
RANG1           =11;
RANG2           =12;
BOSS            =13;
INGROUP         =14;
BUGS_LIST	      =15;
RESULT_PERCENT	=16;
RESULT_TEXT     =17;

var
  Form1: TForm1;
  AppDir,
  DocDir : String;
  TAGS   : Array [0..17] of string;

  Tester : Record
   Date,
   FIO,
   FIO2,
   Rang,
   Rang2,
   Boss,
   inGrp,
   Reg_ID: String;

   TKaf  : record
    Name : Array [0..1] of string;
    ID   : Array [0..1] of string;
   end;

   TSTD      : Array of TTreeField;
   TSTD_Used : Array of TTreeField;

   CurSTD : Integer;
  end;

  // Дата, ФИО, и должность храняться в оценочном листе и в отчёте.

  var
    Table : Array [0..6] of TTable;
    Query1: TQuery;

//    WordApp1: TWordApplication;
//    WordDoc1: TWordDocument;


implementation

uses DateUtils;
{$R *.dfm}

const
 c : char = '''';
{------------------------------------------------------------------------------}

 Function TTreeField.Add(zName:String) : Integer;
 var i : Integer;
 begin
  I := Length(Item);
    SetLength(Item, I + 1 );
         with Item[ i ] do begin
          _Used    := true;
          _Name    := zName;
          _Message := '';
          _Ftext   := '';
          _RText   := '';
//          _ID      := 0;
         end;
    result := i;
 end;


 Procedure TTreeField.Clear;
 begin
  SetLength(Item,0);
 end;


{------------------------------------------------------------------------------}
  Procedure PSTR( S : String; var V: TStringList );
  var
   i,i2,c : integer;
  begin
    v.Clear;
     c  := Length( S ); i := 1;
    while (i < c) do begin
      i2 := i;
       while (s[i] <> ';') and (i<=C) do inc(i);
       if (i-i2)>0 then
       v.Add( copy(s,i2,i-i2) );
      inc(i);
    end;

  end;

 Procedure ChangeSize(W,H:Integer; _hide:boolean=true);
 begin
  with form1 do begin
   if _hide then ShowWindow(Form1.Handle, SW_Hide);
   ClientWidth  := W;
   ClientHeight := H;
   left := screen.Width  div 2 - width  div 2;
   top  := screen.Height div 2 - Height div 2;
   Refresh;
   if _hide then ShowWindow(Form1.Handle, SW_Show);
  end;
 end;

 Procedure Filter(Tbl:PTable; S:String);
 begin
    tbl.Filtered := false;
    tbl.Filter   := S;
    tbl.Filtered := true;
    if not tbl.eof then
    Tbl.First;
 end;

 Procedure OpenBD(Tbl: Array of PTable);
 var i : Integer;
 begin
   for i := 0 to high(tbl) do
   begin
    Tbl[i].Open;
    Tbl[i].First;
    TBL[i].Filtered := false;
   end;

 end;

 Procedure CloseBD(Tbl: Array of PTable);
 var i : Integer;
 begin
   for i := 0 to high(tbl) do
   begin
    Tbl[i].Filtered :=false;
    Tbl[i].First;
    Tbl[i].Close;
   end;
 end;

function IntToStr(Value: Integer): string; begin Str(Value, Result); end;
function FloatToStr(Value: Single; Digits: Integer = 6): string; begin Str(Value:0:Digits, Result); end;

function StrToInt(const Str: string; Def: Integer = 0): Integer;
var Code : Integer;
begin
  Val(Str, Result, Code);
  if Code <> 0 then Result := Def;
end;

function StrToFloat(const Str: string; Def: Single = 0): Single;
var Code : Integer;
begin
  Val(Str, Result, Code);
  if Code <> 0 then Result := Def;
end;


 Procedure ChangePage;
 begin
   with form1 do begin

   ShowWindow(Form1.Handle, SW_Hide);
    sPageControl1.ActivePage.Enabled := false;
    sPageControl1.ActivePageIndex    := (sPageControl1.ActivePageIndex +1) mod sPageControl1.PageCount;
    sPageControl1.ActivePage.TabVisible := true;

    case sPageControl1.ActivePageIndex of
      0: ChangeSize(545,250,false);
      1: ChangeSize(450,260,false);
      2: ChangeSize(500,350,false);
    end;
   ShowWindow(Form1.Handle, SW_Show);

   end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
    if (ComboBox1.itemindex = -1) or
       (ComboBox2.itemindex = -1) or
       (ComboBox3.ItemIndex = -1) then exit;

  OpenBD([ @table[ db_dep ], @table[ db_kaf ], @table[ db_std ], @table[ db_ksc ] ]);

  Filter(@table[ db_dep ],'Dep_Name = '   +C+ComboBox1.Items.Strings [ ComboBox1.itemindex ]+C);
  Filter(@table[ db_kaf ],'Kaf_Name = '   +C+ComboBox2.Items.Strings [ ComboBox2.itemindex ]+C);
  Filter(@table[ db_ksc ],'KSC_Kaf_ID = ' +C+table[ db_kaf ].FieldByName('Kaf_ID').asstring+C);

  with tester do
  begin
   Date     := DateToStr(now);
    FIO     := Edit1.Text;
    Rang    := Edit2.Text;
    FIO2    := Edit5.Text;
    Rang2   := Edit7.Text;
    Reg_ID  := Edit4.Text;
    Boss    := Edit8.Text;
    inGrp   := Edit9.Text;

  //--------------------------------------------------------------
    TKaf.name[0] := ComboBox1.Items.Strings[ComboBox1.itemindex];
    TKaf.name[1] := ComboBox2.Items.Strings[ComboBox2.itemindex];
    TKaf.ID[0]   := table[ db_dep ].FieldByName('Dep_ID').asstring;
    TKaf.ID[1]   := table[ db_kaf ].FieldByName('Kaf_ID').asstring;
  end;

  sCheckListBox1.Items.Clear;

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from "'+table[ db_std ].TableName+'", "'+table[ db_ksc ].TableName+'" where Standard_ID =KSC_Standard_ID ' +
                 ' and KSC_Kaf_ID = '+C+table[ db_kaf ].FieldByName('Kaf_ID').asstring+C);
  Query1.Open;

    with tester do begin
    for i := 0 to high(TSTD) do
    if @TSTD[i] <> nil then TSTD[i].FRee;

    SetLength(TSTD,0);

    while not Query1.Eof do  begin
     i := Length(TSTD);
       SetLength(TSTD, i +1);
                 TSTD[i] := TTReeField.Create;
                 TSTD[i].Name := Query1.FieldByName('Standard_Name').asstring;
                 TSTD[i].ID   := Query1.FieldByName('Standard_Id').asstring;

                 TSTD[i]._Ratios  := Query1.FieldByName('Standard_Ratios').asstring;
                 TSTD[i]._Percent := Query1.FieldByName('Standard_Percent').asstring;
                 TSTD[i]._Value   := Query1.FieldByName('Standard_Value').asstring;
                 TSTD[i]._RepName := Query1.FieldByName('Standard_RepName').asstring;
                 TSTD[i]._Weight  := Query1.FieldByName('KSC_Standard_Weight').asstring;

                 TSTD[i].Checked := false;

     sCheckListBox1.Items.Add( TSTD[i].Name +' ('+TSTD[i]._Weight+')' );
     Query1.Next;
   end;
 end;
  CloseBD([ @table[ db_dep ], @table[ db_kaf ], @table[ db_std ], @table[ db_ksc ] ]);
  Query1.Close;
   ChangePage;
end;

procedure TForm1.ComboBox1DropDown(Sender: TObject);
begin
  OpenBD([ @table[ db_dep ] ]);
  TCombobox(Sender).Items.Clear;
  while not table[ db_dep ].Eof do
  begin
   TCombobox(Sender).Items.Add(table[ db_dep ].FieldByName('Dep_Name').asstring);
   table[ db_dep ].Next;
  end;
  CloseBD([ @table[ db_dep ] ]);
  if TCombobox(Sender).Items.Count > 0 then
     TCombobox(Sender).ItemIndex := 0 ;
  ComboBox2DropDown( ComboBox2 );
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  ComboBox2DropDown( ComboBox2 );
end;

procedure TForm1.ComboBox2DropDown(Sender: TObject);
begin
  if Combobox1.ItemIndex = -1 then exit;
  OpenBD([ @table[ db_dep ], @table[ db_kaf ] ]);
  Filter(@table[ db_dep ],'Dep_Name = '+C+ComboBox1.Items.Strings [ ComboBox1.itemindex ]+C);
  Filter(@table[ db_kaf ],'Kaf_Dep_Id = '+C+table[ db_dep ].FieldByName('Dep_ID').AsString+C);
  TCombobox(Sender).Items.Clear;
  while not table[ db_kaf ].Eof do begin
   TCombobox(Sender).Items.Add(table[ db_kaf ].FieldByName('Kaf_Name').asstring);
   table[ db_kaf ].Next;
  end;
  CloseBD([ @table[ db_dep ], @table[ db_kaf ] ]);
  if TCombobox(Sender).Items.Count > 0 then
     TCombobox(Sender).ItemIndex := 0 ;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i :integer;
  SystemTime: TSystemTime;

Procedure CheckCreateField(Field: string);
var
i : Integer;
begin
  with table[ db_std ] do
  begin
      Open;
    for i := 0 to FieldDefs.count -1 do
               if FieldDefs.Items[i].Name = Field then
                  begin
                    Close;
                    exit;
                  end;
      Close;
  end;
    with TQuery.Create(form1) do
        begin
          Close;
           SQL.Clear;
           SQL.Add('alter table "'+table[ db_std ].TableName+'" add '+Field+' char(32) ;');
          ExecSQL;
          Close;
          Free;
        end;
end;

Procedure CheckCreateTable(TableName, addFields: string);
begin
  if FileExists(TableName) then exit;
    with TQuery.Create(form1) do
        begin
           SQL.Clear;
           SQL.Add('create table "'+TableName+'" ( '+addFields+' );');
          ExecSQL;
          Close;
          Free;
        end;
end;

 var
 CFG : TConfig;
begin
 ChangeSize(545,280,false);
 For i := 0 to high(Table) do
 Table[i] := TTable.Create(Self);
    Query1:= TQuery.Create(self);
//  Edit6.Text := FormatDateTime('MMMM DD YYYY',date);
  Appdir   := ExtractFilepath( Application.ExeName )+'\WorkDir\';
  DocDir   := ExtractFilepath( Application.ExeName )+'\Docs\';
  {READ CONFIG}
  CFG := TConfig.Create(Docdir+'config.cfg');
  TAGS[ REG_ID         ] := CFG.Entry.GetString('REG_ID');
  TAGS[ CUR_DAY        ] := CFG.Entry.GetString('CUR_DAY');
  TAGS[ CUR_MONTH      ] := CFG.Entry.GetString('CUR_MONTH');
  TAGS[ CUR_MONTH_NUM  ] := CFG.Entry.GetString('CUR_MONTH_NUM');
  TAGS[ CUR_YEAR       ] := CFG.Entry.GetString('CUR_YEAR');
  TAGS[ CUR_DATE       ] := CFG.Entry.GetString('CUR_DATE');
  TAGS[ NEXT_DATE      ] := CFG.Entry.GetString('NEXT_DATE');
  TAGS[ DEP_NAME       ] := CFG.Entry.GetString('DEP_NAME');
  TAGS[ OBJ_NAME       ] := CFG.Entry.GetString('OBJ_NAME');
  TAGS[ FIO1           ] := CFG.Entry.GetString('FIO1');
  TAGS[ FIO2           ] := CFG.Entry.GetString('FIO2');
  TAGS[ RANG1          ] := CFG.Entry.GetString('RANG1');
  TAGS[ RANG2          ] := CFG.Entry.GetString('RANG2');
  TAGS[ BOSS           ] := CFG.Entry.GetString('BOSS');
  TAGS[ INGROUP        ] := CFG.Entry.GetString('INGROUP');
  TAGS[ BUGS_LIST      ] := CFG.Entry.GetString('BUGS_LIST');
  TAGS[ RESULT_PERCENT ] := CFG.Entry.GetString('RESULT_PERCENT');
  TAGS[ RESULT_TEXT    ] := CFG.Entry.GetString('RESULT_TEXT');

//  Appdir := 'C:\D7\Borland Shared\Database Desktop\WorkDir\';
  table[ db_dep ].TableName := AppDir + 'dep1.DB';
  table[ db_kaf ].TableName := AppDir + 'kaf2.DB';
  Table[ db_std ].TableName := AppDir + 'standard3.DB';
  table[ db_stdchk ].TableName  := AppDir + 'std_check_log.db';
  Table[ db_chk ].TableName  := AppDir + 'check4.DB';
  Table[ db_ksc ].TableName  := AppDir + 'KSC5.DB';

  OpenBD ([ @table[ db_dep ], @table[ db_kaf ], @Table[ db_std ], @Table[ db_chk ], @Table[ db_ksc ] ]);
  CloseBD([ @table[ db_dep ], @table[ db_kaf ], @Table[ db_std ], @Table[ db_chk ], @Table[ db_ksc ] ]);

 Scombobox1.Items.Clear;
 for i := 0 to sSkinManager1.InternalSkins.Count -1 do
 Scombobox1.Items.Add ( sSkinManager1.InternalSkins.Items[i].Name );

 for i := 1 to sPageControl1.PageCount -1 do
 sPageControl1.Pages[i].TabVisible :=false;

 GetLocalTime(SystemTime);
 Edit6.Text := IntToStr(SystemTime.wDay) +' '+ Month[ SystemTime.WMonth-1 ] +' '+ IntToStr(SystemTime.wYear) ;

end;

procedure TForm1.sComboBox1Select(Sender: TObject);
begin
sSkinManager1.SkinName := sSkinManager1.InternalSkins.Items[ Scombobox1.ItemIndex ].Name;
end;

procedure TForm1.sPageControl1Change(Sender: TObject);
begin
  case sPageControl1.ActivePageIndex of
    0: ChangeSize(545,280);
    1: ChangeSize(450,260);
    2: ChangeSize(500,350);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,TSTD_UsedCount : integer;
begin
 if Application.MessageBox( Pchar ( ' Продолжить ? '), 'Подтвердите свой выбор', MB_YESNO ) <> 6 then exit;
    with Tester do begin
    TSTD_UsedCount := 0;

    for i := 0 to sCheckListBox1.Items.Count-1 do
    begin
         TSTD[i].Checked := sCheckListBox1.Checked[i];
      if TSTD[i].Checked then inc( TSTD_UsedCount );
    end;

    if TSTD_UsedCount = 0 then  begin
              Application.MessageBox( Pchar ( 'Вы ничего не выбрали'), nil, MB_IconError );
              exit;
              end;
    SetLength( TSTD_Used , TSTD_UsedCount );
    TSTD_UsedCount := 0;

    for i := 0 to high(TSTD) do
    if TSTD[i].Checked then begin
                    TSTD_Used[ TSTD_UsedCount ] := TTreeField.Create;
                    TSTD_Used[ TSTD_UsedCount ].ID        := TSTD[i].ID;
                    TSTD_Used[ TSTD_UsedCount ].Name      := TSTD[i].Name;
                    TSTD_Used[ TSTD_UsedCount ]._Ratios   := TSTD[i]._Ratios;
                    TSTD_Used[ TSTD_UsedCount ]._Percent  := TSTD[i]._Percent;
                    TSTD_Used[ TSTD_UsedCount ]._Value    := TSTD[i]._Value;
                    TSTD_Used[ TSTD_UsedCount ]._RepName  := TSTD[i]._RepName;
                    TSTD_Used[ TSTD_UsedCount ]._Weight   := TSTD[i]._Weight;
                    TSTD_Used[ TSTD_UsedCount ].Checked   := TSTD[i].Checked;
                    TSTD_Used[ TSTD_UsedCount ].value     := StrToFloat(TSTD[i]._Weight);
                    inc ( TSTD_UsedCount );
    end;
    CurSTD := 0;
    end;
    ReCheck;
//    ChangePage;
end;

procedure TForm1.ReCheck;
var s : single;
    i,i2 : Integer;
  Function FindSTD(ID:String) : integer;
  var i : integer;
  begin
    with Tester do
    for i := 0 to High(TSTD_Used) do
      if TSTD_Used[i].ID = ID then
      begin
        result:= i;
        exit;
      end;
      result:=-1;
  end;
begin

  with tester do begin
       S:= 0;
       for i := 0 to High(TSTD_Used) do
       S:= S + TSTD_Used[i].Value;
       if S <> 1 then begin
         Application.MessageBox( Pchar ( ' Суммма коэффициентов не равна 1 '+#13+#10+' сумма равна:'+ FloatToStr(S)), ' Исправьте весовые коэффициенты', 0 );
       end else
       begin
         //------------------------
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from "'+table[ db_chk ].TableName+'", "'+table[ db_ksc ].TableName + '"'
                +' where (Check_Standard_ID = KSC_Standard_ID) '
                +' and (KSC_Kaf_ID = '+C+Tester.TKaf.ID[1] +C+')' );
  with tester do
  begin
   Query1.Open;

      while not Query1.Eof do
      begin
           i := FindSTD( Query1.FieldByName('Check_Standard_ID').asstring );
        if i <> -1 then  begin
         i2 := TSTD_Used[i].Add( Query1.FieldByName('Check_Name').asstring );
               TSTD_Used[i].Item[ i2 ]._FText  :=  Query1.FieldByName('Check_RepName').asstring;
               TSTD_Used[i].Item[ i2 ]._Chk_ID :=  Query1.FieldByName('Check_ID').asstring;
        end;
        Query1.Next;
      end;
  Query1.Close;

    sCheckListBox2.Items.Clear;
    for i := 0 to High(TSTD_Used[0].Item) do
    sCheckListBox2.Items.Add(TSTD_Used[0].item[i]._Name);
    CurSTD:=0;
    Label7.Caption := TSTD_Used[ CurSTD ].Name + ' ' + inttostr( CurSTD + 1) +' / ' + IntToStr( Length ( TSTD_Used ) ) ;
  end;

         ChangePage;
       end;
       SMemo1.Clear;
  end;
end;

procedure TForm1.sCheckListBox2ClickCheck(Sender: TObject);
var i : integer;
    b : boolean;
begin
  i := sCheckListBox2.ItemIndex;
  b := not sCheckListBox2.Checked[ i ];
  sMemo1.Visible := b;
  with tester do begin
    TSTD_USED[ CurSTD ].Item[ i ]._Used := b;
    if not b then
    TSTD_USED[ CurSTD ].Item[ i ]._Message := '';
  end;
  ComboBox4DropDown(ComboBox4);
end;

procedure TForm1.sCheckListBox2Click(Sender: TObject);
var i : integer;
begin
  i := sCheckListBox2.ItemIndex;
  with tester do begin
     sMemo1.Visible := TSTD_USED[ CurSTD ].Item[ i ]._Used;

    if TSTD_USED[ CurSTD ].Item[ i ]._Used then
    sMemo1.Text := trim( TSTD_USED[ CurSTD ].Item[ i ]._Message ) else
    sMemo1.Lines.Clear;
    ComboBox4DropDown(ComboBox4);
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var i : integer;
begin
  i := sCheckListBox2.ItemIndex;
  if (i = -1) then exit;

  with tester do begin
    if TSTD_USED[ CurSTD ].Item[ i ]._Used then
       TSTD_USED[ CurSTD ].Item[ i ]._Message := Trim( sMemo1.text );
  end;
end;

{form1.Caption := smemo1.Text;
  with tester do begin
      i :=  GetTreb ( sCheckListBox2.ItemIndex );
       if i <> -1 then
       begin
         Treb[i].Msg := '';
           for i2 := 0 to smemo1.Lines.Count-1 do
           begin
             Treb[i].Msg := Treb[i].Msg + sMemo1.Lines.Strings[i2];
             if i2 <> smemo1.Lines.Count-1 then
             Treb[i].Msg := Treb[i].Msg + #13+#10;
           end;
      end;
  end;
 }


procedure TForm1.Button4Click(Sender: TObject);
//type
// POleVariant = ^OleVariant;
var
 wordapp : OleVariant;

    Procedure _Replace2(A,B:String; _BOLD:boolean=false);
    begin
      if b = '' then b := '-- ? -- ' + A + ' --- ?? ---';
      WordApp.Selection.Find.Replacement.Text  := A;
      WordApp.Selection.Find.Forward           := True;
      WordApp.Selection.Find.Wrap              := $1;
      WordApp.Selection.Find.Format            := False;
      WordApp.Selection.Find.Format            := False;
      WordApp.Selection.Find.MatchCase         := False;
      WordApp.Selection.Find.MatchWholeWord    := False;
      WordApp.Selection.Find.MatchWildcards    := False;
      WordApp.Selection.Find.MatchSoundsLike   := False;
      WordApp.Selection.Find.MatchAllWordForms := False;

       while WordApp.Selection.Find.Execute( FindText := A ) do
       begin
       WordApp.Selection.Font.Bold := _BOLD;
       WordApp.Selection.TypeText( B );
       end;
    end;

var
 FileName,
 BugsReport: String;
 i,i2,c : integer;
 Sum1,Sum2: Double;

 SystemTime,
 SystemTime2: TSystemTime;

  Function ProcessString( S :String ) : String;
  var i : integer;
   v: String;
  begin
    v:='';
    for i := 1 to Length(S) do
    if S[i] <> #10 then v:=v + S[i];
    result:=v;
  end;
  Procedure PrepareDoc;
  begin
   _Replace2(TAGS[ REG_ID         ]    , Tester.Reg_ID );
   _Replace2(TAGS[ CUR_DAY        ]    , IntToStr(SystemTime.wDay) );
   _Replace2(TAGS[ CUR_MONTH      ]    , Month   [SystemTime.WMonth-1 ] );
   _Replace2(TAGS[ CUR_MONTH_NUM  ]    , IntToStr(SystemTime.WMonth) );
   _Replace2(TAGS[ CUR_YEAR       ]    , IntToStr(SystemTime.wYear) );
   _Replace2(TAGS[ CUR_DATE       ]    , IntToStr(SystemTime.wDay)+ ' '+Month[ SystemTime.WMonth-1 ] + ' '+ IntToStr(SystemTime.wYear) );
   _Replace2(TAGS[ NEXT_DATE      ]    , IntToStr(SystemTime2.wDay)+ ' '+Month[ SystemTime2.WMonth-1 ] + ' '+ IntToStr(SystemTime2.wYear) );

   _Replace2(TAGS[ DEP_NAME       ]    , Tester.TKAF.name[0] );
   _Replace2(TAGS[ OBJ_NAME       ]    , Tester.TKAF.name[1] );
   _Replace2(TAGS[ FIO1           ]    , Tester.FIO   );
   _Replace2(TAGS[ FIO2           ]    , Tester.FIO2  );
   _Replace2(TAGS[ RANG1          ]    , Tester.Rang  );
   _Replace2(TAGS[ RANG2          ]    , Tester.Rang2 );
   _Replace2(TAGS[ BOSS           ]    , Tester.Boss );
   _Replace2(TAGS[ INGROUP        ]    , Tester.InGRP );
   _Replace2(TAGS[ BUGS_LIST      ]    , BugsReport, True );
   _Replace2(TAGS[ RESULT_PERCENT ]    , FloatToStr(Sum1*Sum2,2), True );
   if ( (Sum1*Sum2 > 0) and ( Round(Sum1*Sum2) < 49) ) then
   _Replace2(TAGS[ RESULT_TEXT    ]    , 'не соответствует требованиям ГОСТ Р ИСО  9001-2008.', True ) else
   if ( (Round(Sum1*Sum2) > 50) and (Round(Sum1*Sum2) < 74)) then
   _Replace2(TAGS[ RESULT_TEXT    ]    , 'в целом соответствует требованиям ГОСТ Р ИСО  9001-2008, но требует существенного улучшения.', false ) else
   if Round(Sum1*Sum2) > 74 then
   _Replace2(TAGS[ RESULT_TEXT    ]    , 'в целом соответствует требованиям ГОСТ Р ИСО  9001-2008.', false );

  end;


  Procedure DumpToLog;
  var
   I,J : integer;
  begin
    OpenBD([ @table[ db_stdchk ] ]);
     with table[ db_stdchk ] do
     begin


       with tester  , table[ db_stdchk ] do
       for i := 0 to high(TSTD_USED) do
       for j := 0 to high(TSTD_USED[i].item) do
       if TSTD_USED[i].item[j]._Used then
       begin
           Append;
             FieldByName('stdchk_dep_id'       ).asstring := Tkaf.id[0];
             FieldByName('stdchk_kaf_id'       ).asstring := Tkaf.id[1];
             FieldByName('stdchk_std_id'       ).asstring := TSTD_USED[i].ID;
             FieldByName('stdchk_chk_id'       ).asstring := TSTD_USED[i].item[j]._CHK_ID;
             FieldByName('stdchk_std_date'     ).asstring := FormatDateTime('DD.MM.YYYY', Now);
             FieldByName('stdchk_std_reg_id'   ).asstring := Reg_ID;
             FieldByName('stdchk_std_errortext').asstring := TSTD_USED[i].item[j]._Message;
             FieldByName('stdchk_boss_name'    ).asstring := FIO;

           post;
        end;
     end;

    CloseBD([ @table[ db_stdchk ] ]);
  end;

  Function TESTDATA():boolean;
  var i , i2 : integer;
  begin
      result:=false;

   with tester do
   for i := 0 to high(TSTD_USED) do
   for i2:= 0 to high(TSTD_USED[i].item) do
   if TSTD_USED[i].item[i2]._Used  and (TSTD_USED[i].item[i2]._Message = '') then
   begin
      Application.MessageBox( PAnsiChar(TSTD_USED[i].Name +':'+ #13#10+TSTD_USED[i].item[i2]._Name) , 'Сообщение несоответствия пустое !'  );
      exit;
   end;
   result:=true;
  end;

  procedure DumpToXML;
  var
    Xml : TXMLDocument;
    i,j : integer;
  begin
    Xml := TXMLDocument.Create (nil);
    with XML do begin
      Active   := true;
      Version  := '1.0';
      Encoding := 'unicode';
    end;

    with Xml do
    begin
      // создаем корневой узел
      with AddChild ('Audit') do
        begin

          with AddChild ('User') do
            begin
               ChildValues ['Date'  ] := Tester.Date;
               ChildValues ['Date2' ] := IntToStr(SystemTime2.wDay)+ ' '+Month[ SystemTime2.WMonth-1 ] + ' '+ IntToStr(SystemTime2.wYear);
               ChildValues ['Reg_Id'] := Tester.Reg_ID ;
               ChildValues ['FIO1'  ] := Tester.FIO;
               ChildValues ['FIO2'  ] := Tester.FIO2;

               ChildValues ['RANG1' ] := Tester.Rang;
               ChildValues ['RANG2' ] := Tester.Rang2;
               ChildValues ['GRP'   ] := Tester.inGRP;
               ChildValues ['KAF1'  ] := Tester.TKaf.name[0];
               ChildValues ['KAF2'  ] := Tester.TKaf.name[1];

               ChildValues ['KAF1_ID' ] := Tester.TKaf.id[0];
               ChildValues ['KAF2_ID' ] := Tester.TKaf.id[1];
               ChildValues ['Result_Percent' ] := FloatToStr(Sum1*Sum2,2);
            end;

          for i := 0 to high( Tester.TSTD_USED ) do
          with AddChild ('STD') do
            begin
               ChildValues ['ID'      ] := Tester.TSTD_USED[i].ID;
               ChildValues ['Name'    ] := Tester.TSTD_USED[i].Name;
               ChildValues ['Ratios'  ] := Tester.TSTD_USED[i]._PreRatios;
               ChildValues ['Percent' ] := Tester.TSTD_USED[i]._PrePercent;
               ChildValues ['Value'   ] := Tester.TSTD_USED[i].Value;
                for j := 0 to high( Tester.TSTD_USED[i].item ) do
                  with AddChild ('CHK') do
                  begin
                     ChildValues ['Name'    ] := Tester.TSTD_USED[i].Item[j]._Name;
                     ChildValues ['cheked'  ] := Tester.TSTD_USED[i].Item[j]._used;
                     ChildValues ['Message' ] := Tester.TSTD_USED[i].Item[j]._Message;
                  end;
            end;
        end;

    end;

     Xml.SaveToFile (AppDir+'LastSession.xml');
    end;

begin
 if not testdata then exit;
 FileName:= DocDir+'\оц_аудит1tmp.doc';
 WordApp := CreateOleObject('Word.Application');
 wordapp.Documents.Add(FileName);
 GetLocalTime(SystemTime);
 DateTimeToSystemTime(NOW + ComboBox3.ItemIndex,SystemTime2);
 DumpToLog;

 with tester do
  for i := 0 to high(TSTD_USED) do
  begin
   c := 0;
    for i2:= 0 to high(TSTD_USED[i].item) do
    Begin
     if TSTD_USED[i].item[i2]._Used then
     begin
       inc(c);
      _Replace2(TSTD_USED[i].item[i2]._FText , '-)'+TSTD_USED[i].item[i2]._Name + '(' +ProcessString(TSTD_USED[i].item[i2]._Message) + ')', true );
     end else
     begin
      _Replace2(TSTD_USED[i].item[i2]._FText , '+)'+TSTD_USED[i].item[i2]._Name  );
     end;

    End;

    with TSTD_USED[i] do
    begin
    _PreRatios := IntToStr( Length(Item ) - c) + '/'+inttostr( length(Item ) );
    if length(Item) >0 then
    _PrePercent :=  (Length(Item ) - c )/ length(Item)*100  else _PrePercent := 0;

    _Replace2(_Ratios ,  _PreRatios);
    _Replace2(_Percent,  FloatToStr(_PrePercent, 1)+'%');
    _Replace2(_Value  ,  FloatToStr(value , 2));
    end;
  end;

 BugsReport:='';
 Sum1:=0;
 Sum2:=0;
 C   :=0;
 with tester do
  for i := 0 to high(TSTD_USED) do
  with TSTD_USED[i] do
  begin
    for i2:= 0 to high(item) do
     if item[i2]._Used then
     begin
     BugsReport := BugsReport +Char(ORD('а')+C)+') '+ ProcessString(item[i2]._Message) + ' (несоответствие требованиям ГОСТ Р ИСО 9001-2008 в п. ' +Name +');'+#13#10;
     inc(c);
     end;

     _Replace2(_Ratios ,  _PreRatios);
     _Replace2(_Percent,  FloatToStr(_PrePercent, 1)+'%');
     _Replace2(_Value  ,  FloatToStr(value , 2));
     _Replace2(_RepName,  Name);

     Sum1 := Sum1 + _PrePercent * Value;
     Sum2 := Sum2 + value;
  end;
 DumpToXML;
 PrepareDoc;

 FileName:= DocDir+'\бланк отчета по аудиту.doc';
 wordapp.Documents.Add(FileName);
 PrepareDoc;

 WordApP.Visible:=true;

end;

procedure TForm1.Button8Click(Sender: TObject);
var i : integer;
begin
 with Tester Do
 begin
   CurSTD:=(CurSTD+1) mod Length(TSTD_USED);

    sCheckListBox2.Items.Clear;
    for i := 0 to High(TSTD_USED[ CurSTD ].Item) do
    begin
      sCheckListBox2.Items.Add(TSTD_USED[ CurSTD ].item[i]._Name);
      sCheckListBox2.Checked[i] :=not TSTD_USED[ CurSTD ].item[i]._Used;
    end;
    sCheckListBox2.ItemIndex :=0;
    sCheckListBox2Click(nil);
    Label7.Caption := TSTD_USED[ CurSTD ].Name + ' ' + inttostr( CurSTD + 1) +' / ' + IntToStr( Length ( TSTD_USED ) ) ;
 end;

end;

procedure TForm1.Button9Click(Sender: TObject);
var i : integer;
begin
 with Tester Do
 begin
   dec(CurSTD);
   IF CurSTD < 0 then CurSTD:= High(TSTD_USED);

    sCheckListBox2.Items.Clear;
    for i := 0 to High(TSTD_USED[ CurSTD ].Item) do
    begin
      sCheckListBox2.Items.Add(TSTD_USED[ CurSTD ].item[i]._Name);
      sCheckListBox2.Checked[i] :=not TSTD_USED[ CurSTD ].item[i]._Used;
    end;
    sCheckListBox2.ItemIndex :=0;
    sCheckListBox2Click(nil);
    Label7.Caption := TSTD_USED[ CurSTD ].Name + ' ' + inttostr( CurSTD + 1) +' / ' + IntToStr( Length ( TSTD_USED ) ) ;
 end;
end;

procedure TForm1.ComboBox4DropDown(Sender: TObject);
var i : integer;
  id  : String;
begin
      i := sCheckListBox2.ItemIndex;
  if (i  = -1) then exit;
     TCombobox(Sender).ItemIndex := -1 ;
  with tester do
  begin
    if not TSTD_USED[ CurSTD ].Item[ i ]._Used then exit;

    OpenBD( [ @table[ db_stdchk ] ]);
    Filter(   @Table[ db_stdchk ], 'stdchk_chk_id = '+ c + TSTD_USED[ CurSTD ].Item[ i ]._CHK_ID  + c);
//    writeln('stdchk_chk_id = '+ c + TSTD_USED[ CurSTD ].Item[ i ]._CHK_ID  + c);
  end;
  TCombobox(Sender).Items.Clear;
  with table[ db_stdchk ] do
  while not Eof do
  begin
  if FieldByName('stdchk_std_errortext').asstring <> '' then
        TCombobox(Sender).Items.Add( FieldByName('stdchk_std_errortext').asstring );
//        writeln('add : [',FieldByName('stdchk_std_errortext').asstring,']');
   Next;
  end;
//  writeln( TCombobox(Sender).Items.Count);
  if TCombobox(Sender).Items.Count > 0 then
     TCombobox(Sender).ItemIndex := 0 ;

  CloseBD( [ @table[ db_stdchk ] ]);
end;

procedure TForm1.ComboBox4Select(Sender: TObject);
begin
    if TCombobox(Sender).Items.Count <0 then exit;
  sMemo1.text := TCombobox(Sender).Items.Strings[ TCombobox(Sender).ItemIndex ];
end;

end.
