unit Unit4;
{$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;

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;
    sTabSheet3: TsTabSheet;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    Button3: TButton;
    sTabSheet4: TsTabSheet;
    Label7: TLabel;
    Label4: TLabel;
    Button4: TButton;
    sPanel1: TsPanel;
    sMemo1: TsMemo;
    sSplitter1: TsSplitter;
    Button5: TButton;
    Button6: TButton;
    Label8: TLabel;
    Button7: TButton;
    Label9: TLabel;
    Edit4: TEdit;
    sPageControl2: TsPageControl;
    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;
    Label16: TLabel;
    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 Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(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);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  PTable = ^TTable;

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


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

const
  db_kaf = 0;
  db_tch = 1;
  db_pct = 2;
  db_chk = 3;
  db_KSC = 4;
  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;
KAF_NAME	      =7;
TCH_NAME	      =8;
BOSS  	        =9;
INGROUP	        =10;
RANG1           =11;
RANG2           =12;
THING1          =13;
THING2          =14;
BUGS_LIST	      =15;
RESULT_PERCENT	=16;
RESULT_TEXT     =17;

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

  Tester : Record
   Data,
   Boss,
   inGrp,
   Rang,
   Rang2,
   Thing,
   Thing2,
   Reg_ID: String;

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

   TPCT : Array of TTreeField;
   TPCT_Used : Array of TTreeField;

   CurPCT : Integer;
  end;

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

  var
    Table : Array [0..5] 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;

 Function TTreeField.FindByID(zID: Integer): integer;
 var i : integer;
 begin
    for i := 0 to high(Item) do
      if item[i]._Id = zid then
       begin
        result:=i;
        exit;
       end;
        result :=-1;
 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 UpdateStats;
var s : single;
    i : Integer;
begin
  with Tester , Form1 do
  begin
    Label5.Caption := TPCT_Used[ CurPCT ].Name + ' '+IntToStr(CurPCT+1)+' / ' + IntToStr( Length( TPCT_Used ) ) ;
    Edit3.Text     := FloatToStr(TPCT_Used[ CurPCT ].Value);

    S:=0;
    for i := 0 to High(TPCT_Used) do                            
    S:= S + TPCT_Used[i].Value;
    Label8.Caption := 'На данный момент:'+FloatToStr(S);
  end;
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(355,150,false);
      3: 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_kaf ], @table[ db_tch ], @table[ db_pct ], @table[ db_ksc ] ]);

  Filter(@table[ db_kaf ],'Kaf_Name = '   +C+ComboBox1.Items.Strings [ ComboBox1.itemindex ]+C);
  Filter(@table[ db_tch ],'Teach_Name = '   +C+ComboBox2.Items.Strings [ ComboBox2.itemindex ]+C);
  Filter(@table[ db_ksc ],'KSC_Teach_ID = ' +C+table[ db_tch ].FieldByName('Teach_ID').asstring+C);

  with tester do
  begin
    Data    := DateToStr(now);
    BOSS    := Edit1.Text;
    Rang    := Edit2.Text;
    InGrp   := Edit5.Text;
    Rang2   := Edit7.Text;
    Reg_ID  := Edit4.Text;
    Thing   := Edit8.Text;
    Thing2  := Edit9.Text;

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

  sCheckListBox1.Items.Clear;

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from "'+table[ db_pct ].TableName+'", "'+table[ db_ksc ].TableName+'" where Punct_ID =KSC_Punct_ID ' +
                 ' and KSC_Teach_ID = '+C+table[ db_tch ].FieldByName('Teach_ID').asstring+C);
  Query1.Open;

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

    SetLength(TPCT,0);

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

                 TPCT[i]._Ratios  := Query1.FieldByName('Punct_Ratios').asstring;
                 TPCT[i]._Percent := Query1.FieldByName('Punct_Percent').asstring;
                 TPCT[i]._Value   := Query1.FieldByName('Punct_Value').asstring;
                 TPCT[i]._RepName := Query1.FieldByName('Punct_RepName').asstring;

                 TPCT[i].Checked := false;

     sCheckListBox1.Items.Add( TPCT[i].Name );
     Query1.Next;
   end;
 end;
  CloseBD([ @table[ db_kaf ], @table[ db_tch ], @table[ db_pct ], @table[ db_ksc ] ]);
  Query1.Close;

   ChangePage;
end;

procedure TForm1.ComboBox1DropDown(Sender: TObject);
begin
  OpenBD([ @table[ db_kaf ] ]);
  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_kaf ] ]);
  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_kaf ], @table[ db_tch ] ]);
  Filter(@table[ db_kaf ],'Kaf_Name = '+C+ComboBox1.Items.Strings [ ComboBox1.itemindex ]+C);
  Filter(@table[ db_tch ],'Teach_Kaf_Id = '+C+table[ db_kaf ].FieldByName('Kaf_ID').AsString+C);
  TCombobox(Sender).Items.Clear;
  while not table[ db_tch ].Eof do begin
   TCombobox(Sender).Items.Add(table[ db_tch ].FieldByName('Teach_Name').asstring);
   table[ db_tch ].Next;
  end;
  CloseBD([ @table[ db_kaf ], @table[ db_tch ] ]);
  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_pct ] 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_pct ].TableName+'" add '+Field+' char(32) ;');
          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[ KAF_NAME       ] := CFG.Entry.GetString('KAF_NAME');
  TAGS[ TCH_NAME       ] := CFG.Entry.GetString('TCH_NAME');
  TAGS[ BOSS           ] := CFG.Entry.GetString('BOSS');
  TAGS[ INGROUP        ] := CFG.Entry.GetString('INGROUP');
  TAGS[ RANG1          ] := CFG.Entry.GetString('RANG1');
  TAGS[ RANG2          ] := CFG.Entry.GetString('RANG2');
  TAGS[ THING1         ] := CFG.Entry.GetString('THING1');
  TAGS[ THING2         ] := CFG.Entry.GetString('THING2');
  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_kaf ].TableName := AppDir + 'kaf1.DB';
  table[ db_tch ].TableName := AppDir + 'teach2.DB';
  Table[ db_pct ].TableName  := AppDir + 'punct3.DB';
  //!!
  CheckCreateField('Punct_RepName');

  Table[ db_chk ].TableName  := AppDir + 'check4.DB';
  Table[ db_ksc ].TableName  := AppDir + 'KSC5.DB';

  OpenBD ([ @table[ db_kaf ], @table[ db_tch ], @Table[ db_pct ], @Table[ db_chk ], @Table[ db_ksc ] ]);
  CloseBD([ @table[ db_kaf ], @table[ db_tch ], @Table[ db_pct ], @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(355,150);
    3: ChangeSize(500,350);
  end;
end;

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

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

    if TPCT_UsedCount = 0 then  begin
              MessageBox(0, Pchar ( 'Вы ничего не выбрали'), nil, MB_IconError );
              exit;
              end;
    v := 1 / TPCT_UsedCount;
    SetLength( TPCT_Used , TPCT_UsedCount );
    TPCT_UsedCount := 0;

    for i := 0 to high(TPCT) do
    if TPCT[i].Checked then begin
                    TPCT_Used[ TPCT_UsedCount ] := TTreeField.Create;
                    TPCT_Used[ TPCT_UsedCount ].ID        := TPCT[i].ID;
                    TPCT_Used[ TPCT_UsedCount ].Name      := TPCT[i].Name;
                    TPCT_Used[ TPCT_UsedCount ]._Ratios   := TPCT[i]._Ratios;
                    TPCT_Used[ TPCT_UsedCount ]._Percent  := TPCT[i]._Percent;
                    TPCT_Used[ TPCT_UsedCount ]._Value    := TPCT[i]._Value;
                    TPCT_Used[ TPCT_UsedCount ]._RepName  := TPCT[i]._RepName;
                    TPCT_Used[ TPCT_UsedCount ].Checked   := TPCT[i].Checked;
                    TPCT_Used[ TPCT_UsedCount ].value     := v;
                    inc ( TPCT_UsedCount );
    end;
    CurPCT := 0;
    UpdateStats;
    end;
    ChangePage;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 with Tester Do
 begin
   TPCT_Used[CurPCT].value := StrToFloat(Edit3.Text,0);
   CurPCT:=(CurPCT+1) mod Length(TPCT_Used);
   UpdateStats;
 end;

end;

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

  with tester do begin
       S:= 0;
       TPCT_Used[CurPCT].value := StrToFloat(Edit3.Text,0);
       for i := 0 to High(TPCT_Used) do
       S:= S + TPCT_Used[i].Value;
       if S <> 1 then begin
         MessageBox(0, 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_Punct_ID = KSC_Punct_ID) '
                +' and (KSC_Teach_ID = '+C+Tester.TTch.ID[1] +C+')' );
  Query1.Open;
  with tester do
  begin

  while not Query1.Eof do begin
    i := FindPCT( Query1.FieldByName('Check_Punct_ID').asstring );
{    WRiteLN(
            Query1.FieldByName('Check_Name').asstring
   ,#13,#10,Query1.FieldByName('Check_ID').asstring
   ,#13,#10,Query1.FieldByName('Check_Punct_ID').asstring );
      if i = -1 then begin
              MessageBox(0, Pchar ( 'Нарушение логики программы !! в памяти не найден Check_Punct_ID = '+ Query1.FieldByName('Check_Punct_ID').asstring ), nil, MB_IconError );
              exit;
      end;}
      if i <> -1 then
      begin
         i2 := TPCT_Used[i].Add( Query1.FieldByName('Check_Name').asstring );
               TPCT_Used[i].Item[ i2 ]._FText :=  Query1.FieldByName('Check_RepName').asstring;
      end;
     Query1.Next;
   end;
  Query1.Close;
//exit;
    sCheckListBox2.Items.Clear;
    for i := 0 to High(TPCT_Used[0].Item) do
    sCheckListBox2.Items.Add(TPCT_Used[0].item[i]._Name);
    CurPCT:=0;
    Label7.Caption := TPCT_Used[ CurPCT ].Name + ' ' + inttostr( CurPCT + 1) +' / ' + IntToStr( Length ( TPCT_Used ) ) ;
  end;

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

procedure TForm1.Button5Click(Sender: TObject);
begin
 with Tester Do
 begin
   TPCT_Used[CurPCT].value := StrToFloat(Edit3.Text,0);
        CurPCT:=CurPCT-1;
     if CurPct < 0 then CurPct := High(TPCT_Used);
   UpdateStats;
 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
    TPCT_USED[ CurPCT ].Item[ i ]._Used := b;
    if not b then
    TPCT_USED[ CurPCT ].Item[ i ]._Message := '';
  end;
end;

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

    if TPCT_USED[ CurPCT ].Item[ i ]._Used then
    sMemo1.Text := trim( TPCT_USED[ CurPCT ].Item[ i ]._Message ) else
    sMemo1.Lines.Clear;
  end;
end;

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

  with tester do begin
    if TPCT_USED[ CurPCT ].Item[ i ]._Used then
       TPCT_USED[ CurPCT ].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[ KAF_NAME       ]    , Tester.TTCH.name[0] );
   _Replace2(TAGS[ TCH_NAME       ]    , Tester.TTCH.name[1] );
   _Replace2(TAGS[ BOSS           ]    , Tester.Boss   );
   _Replace2(TAGS[ INGROUP        ]    , Tester.InGRP  );
   _Replace2(TAGS[ RANG1          ]    , Tester.Rang  );
   _Replace2(TAGS[ RANG2          ]    , Tester.Rang2 );
   _Replace2(TAGS[ THING1         ]    , Tester.Thing );
   _Replace2(TAGS[ THING2         ]    , Tester.Thing2 );
   _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    ]    , 'не соответствует требованиям', True ) else
   if ( (Round(Sum1*Sum2) > 50) and (Round(Sum1*Sum2) < 74)) then
   _Replace2(TAGS[ RESULT_TEXT    ]    , 'в целом соответствует требованиям, но требует существенного улучшения.', false ) else
   if Round(Sum1*Sum2) > 74 then
   _Replace2(TAGS[ RESULT_TEXT    ]    , 'в целом соответствует требованиям', false );

  end;
begin
 FileName:= DocDir+'\пр_эксп1tmp.doc';
 WordApp := CreateOleObject('Word.Application');
 wordapp.Documents.Add(FileName);
 GetLocalTime(SystemTime);
 DateTimeToSystemTime(NOW + ComboBox3.ItemIndex,SystemTime2);

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

    End;

    with TPCT_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(TPCT_USED) do
  with TPCT_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) + ' (невыполнение критерия, указанного в п. ' +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;
 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
   CurPCT:=(CurPCT+1) mod Length(TPCT_USED);

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

end;

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

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

end.
