БЛАНКСШАБЛОНОМ "Настройка привязки пользовательских групп НФА";
-- Редакция ЗАО "Агентство 'Русспромоценка'"
--2 Переменные
BTNNAME_MENU:s='Настройка привязки групп';
btnExit:Object; btnRead:Object; btnSave:Object; btnСинхро:Object;
СекцНФА:Object; СекцНФАУскор:Object; cbУскорить:Object;
--
var Позиции     :Integer;
var crdНФА      :String="РПО_НФА";
var crdГРП      :String="РПО_ОКЕИ_ГРУППЫ";
var Фокус       :String;
var Пользов     :String;
var ПОЛЕСОРТ    :Integer;
var LAST_GRP    :String;
var Ускорить    :Logical;
--
var Buf[]       :String;
var NN[]        :Integer=$;
--
var ВИДGRP[]    :String;
var КОДGRP[]    :String;
var ИМЯGRP[]    :String;
--
var BUFGRP[]    :String;
var TXTGR1[]    :String;
var TXTGR2[]    :String;
--
var KEYНФА[]    :Record;
var КОДНФА[]    :String;
var ИМЯНФА[]    :String;

2-- Общие процедуры и функции
Proc ОчиститьТаблицу;
 ClearVariable(BUFGRP); ClearVariable(TXTGR1); ClearVariable(TXTGR2);
 ClearVariable(KEYНФА); ClearVariable(КОДНФА); ClearVariable(ИМЯНФА);
 ClearVariable(ВИДGRP); ClearVariable(КОДGRP); ClearVariable(ИМЯGRP);
 ClearVariable(Позиции);
end;

Proc Очистить;
 ClearVariable(NN);
 ClearVariable(Buf);
 ClearVariable(LAST_GRP);
 ОчиститьТаблицу;
end;

Func ИмяПоляСортировки(State:Integer) :String;
 if State=0: ^"КОДНФА";
 |  State=1: ^"ИМЯНФА";
 |  State=2: ^"ВИДGRP";
 |  State=3: ^"КОДGRP";
 |  State=4: ^"ИМЯGRP";
 else ^"";
 fi;
end;

Func ВыборПоляСортировки(OldState:Integer) :Integer;
var nn :Integer;
 ClearVariable(Buf);
 Buf[1]="Сортировать по полю 'Код НФА'";
 Buf[2]="Сортировать по полю 'Наименование НФА'";
 Buf[3]="Сортировать по полю 'Вид ГРУППЫ'";
 Buf[4]="Сортировать по полю 'Код ГРУППЫ'";
 Buf[5]="Сортировать по полю 'Наименование ГРУППЫ'";
 nn=Alternate("Выберите поле сортировки...", Buf, -1, OldState+1, 12);
 if nn<1 or nn>10: ^OldState; fi;
 ^(nn-1);
end;

Func ЗаменитьСимволСтрокиВпозиции(valStr:String; repChar:String; repPos:Integer) :String;
var tmpFirst, tmpLast, out :String;
var len :Integer;
 tmpFirst=""; tmpLast=""; out="";
 len=Length(valStr);
 if repPos<1: repPos=1; fi;
 if repPos>len or repChar="" or valStr="": ^valStr; fi;
 repChar=SubStr(repChar, 1, 1);
 if repPos>1: tmpFirst=SubStr(valStr, 1, repPos-1); else tmpFirst=""; fi;
 if repPos<len: tmpLast=SubStr(valStr, repPos+1, len-repPos); else tmpLast=""; fi;
 out=tmpFirst+repChar+tmpLast;
 ^out;
end;

Func УдалитьРазделитель(Value:String) :String;
var nn :Integer;
 nn=Pos("|", Value);
 while nn>0 do Value=ЗаменитьСимволСтрокиВпозиции(Value, "_", nn); nn=Pos("|", Value); od;
 ^Value;
end;

Func СчитатьГруппы :Logical;
var RO, j, num, k :Integer;
var OK :Logical;
var GRPKEY, GRPВИД, GRPКОД, GRPИМЯ, GRPГРП :String;
var tmp, txt1, txt2 :String;
 OK=False;
 ClearVariable(BUFGRP); ClearVariable(TXTGR1); ClearVariable(TXTGR2);
 RO=OpenWorkArea(crdГРП, "ВИД", "КОД<>'' or НАИМЕНОВАНИЕ<>''");
 ShowProgress(0, "Считывание групп НФА...");
 Try
   num=Records(RO);
   if num>0:
     ShowProgress(num, "Считывание групп НФА...");
     for j=1 to num do
       ProgressPos(j);
       GRPKEY=RecordToString(GetRecordKey(RO, j));
       GRPВИД=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "ВИД"))));
       if GRPВИД="": GRPВИД="_без группировки"; fi;
       GRPКОД=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "КОД"))));
       GRPИМЯ=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "НАИМЕНОВАНИЕ"))));
       if GRPКОД=""  and GRPИМЯ<>"": GRPКОД=GRPИМЯ;
       |  GRPКОД<>"" and GRPИМЯ="" : GRPИМЯ=GRPКОД;
       fi;
       GRPГРП=Lo(Trim(GetFieldS(RO, j, "ГРНФА")));
        tmp=GRPВИД+"|"+GRPКОД+"--"+GRPИМЯ;
       txt1=GRPВИД+"|"+GRPКОД+"|"+GRPИМЯ;
       txt2=GRPKEY+"|"+GRPГРП;
       if SearchInArray(BUFGRP, tmp, True, 1)<0:
         k=InsertInArraySort(BUFGRP, tmp);
         InsertInArray(TXTGR1, k, txt1);
         InsertInArray(TXTGR2, k, txt2);
       fi;
       tmp=GRPВИД+"|";
       if SearchInArray(BUFGRP, tmp, True, 1)<0:
         k=InsertInArraySort(BUFGRP, tmp+"--");
         InsertInArray(TXTGR1, k, "");
         InsertInArray(TXTGR2, k, "");
       fi;
     od;
     if LengthOfArray(BUFGRP)>0: OK=True; else OK=False; fi;
   fi;
 Finally
   CloseProgress;
   CloseWorkArea(RO);
 end;
 ^OK;
end;

Func СчитатьНФА(ИМЯСОРТ:Logical) :Logical;
var RO, j, num :Integer;
var OK :Logical;
 OK=False;
 ClearVariable(KEYНФА); ClearVariable(КОДНФА); ClearVariable(ИМЯНФА);
 ClearVariable(ВИДGRP); ClearVariable(КОДGRP); ClearVariable(ИМЯGRP);
 RO=OpenWorkArea(crdНФА, if(ИМЯСОРТ, "ИМЯ", "ПРИЗНАК"), "ПРИЗНАК<>''");
 ShowProgress(0, "Считывание номенклатуры НФА...");
 Try
   num=Records(RO);
   if num>0:
     ShowProgress(num, "Считывание номенклатуры НФА...");
     for j=1 to num do
       ProgressPos(j);
       KEYНФА[j]=GetRecordKey(RO, j);
       КОДНФА[j]=Lo(GetFieldS(RO, j, "ГРНФА"))+"."+Lo(GetFieldS(RO, j, "ПРИЗНАК"));
       ИМЯНФА[j]=Lo(Trim(GetFieldS(RO, j, "ИМЯ")));
       ВИДGRP[j]=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "ГРУППАВИД"))));
       if ВИДGRP[j]="": ВИДGRP[j]="_без группировки"; fi;
       КОДGRP[j]=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "ГРУППАКОД"))));
       ИМЯGRP[j]=УдалитьРазделитель(Lo(Trim(GetFieldS(RO, j, "ГРУППАССЫЛКА"))));
       if КОДGRP[j]=""  and ИМЯGRP[j]<>"": КОДGRP[j]=ИМЯGRP[j];
       |  КОДGRP[j]<>"" and ИМЯGRP[j]="" : ИМЯGRP[j]=КОДGRP[j];
       fi;
     od;
     if LengthOfArray(KEYНФА)>0 and num=(j-1): OK=True; else OK=False; fi;
   fi;
 Finally
   CloseProgress;
   CloseWorkArea(RO);
 end;
 ^OK;
end;

Func СчитатьСправочники(ИМЯСОРТ:Logical) :Logical;
var OK, f1, f2 :Logical;
 OK=False;
 f1=СчитатьГруппы;
 f2=СчитатьНФА(ИМЯСОРТ);
 if f1 and f2: OK=True; else OK=False; fi;
 ^OK;
end;

Proc НашаСортировка;
 ShowProgress(Позиции, "Идет сортировка...");
 Try
   SortSection("СекцНФА", ИмяПоляСортировки(ПОЛЕСОРТ), True, False);
 Finally
   CloseProgress;
 end;
 ClearVariable(NN);
end;

Proc ПостроениеОтчета;
 ClearVariable(Позиции);
 if not СчитатьСправочники(if(ПОЛЕСОРТ=1, True, False)): Message("Нет данных для отчета", mtInformation); Exit; fi;
 Позиции=LengthOfArray(KEYНФА);
 НашаСортировка;
 Template.Freeze(asInteger(СекцНФА.Column(6, ColLeft, "")), asInteger(СекцНФА.Row(1, RowTop, "")));
end;

Func ВыборГруппы(valВИД:String; valКОД:String; valИМЯ:String) :Integer;
var num, k :Integer;
var tmp :String;
 tmp=valВИД+"|"+valКОД+"--"+valИМЯ;
 k=SearchInArray(BUFGRP, tmp, True, 1);
 if k=-1: k=SearchInArray(BUFGRP, LAST_GRP, True, 1); fi;
 num=AlternateTree("Выберите группу...", BUFGRP, -1, k, 12, "|", "ГРУППЫ", "ПОЯСНЕНИЕ", -1, False);
 ^num;
end;

Func SaveOK :Logical;
var RO, num, len, i, k, y, next :Integer;
var SaveПОЛЕСОРТ, tmp :String;
var REC :Record;
var Режим, OK :Logical;
 OK=False;
 Режим=AutoRefresh;
 ToggleAutoRefresh(False);
 ShowProgress(0, "Подготовка...");
 RO=OpenWorkArea(crdНФА, "", "");
 Try
   len=Records(RO);
   if LengthOfArray(KEYНФА)>0 and len>0:
     SaveПОЛЕСОРТ=ИмяПоляСортировки(ПОЛЕСОРТ);
     SortSection("СекцНФА", "KEYНФА", True, False);
     k=0; y=0;
     Try
       next=1;
       ShowProgress(len, "Сохранение групп НФА...");
       for i=1 to len do
         ProgressPos(i);
         if k=0: -- если новая порция, то открываем RO на изменения
           BeginChanging(RO);
         fi;
         k=k+1;
         -- *** --
         REC=GetRecordKey(RO, i);
         num=SearchInArray(KEYНФА, REC, True, next);
         if num>0:
           next=num;
           tmp=ВИДGRP[num];
           if tmp="_без группировки": tmp=""; fi;
           i=PutFieldS(RO, i, "ГРУППАВИД",    tmp);
           i=PutFieldS(RO, i, "ГРУППАКОД",    КОДGRP[num]);
           i=PutFieldS(RO, i, "ГРУППАССЫЛКА", ИМЯGRP[num]);
         fi;
         -- *** --
         if k=200: --записываем очередную порцию
           EndChanging(RO);
           y=y+k;
           k=0;
         fi;
       od;
       if k>0: EndChanging(RO); y=y+k; fi; --если последняя порция неполная
       OK=True;
     Except
       Message(if((y+k)>0, "Сохранение групп.^MВсего записано "+Str(y+k)+" записей из "+Str(len)+"."+Chr(13), "")+
                           "'"+crdНФА+"'. Ошибка "+Str(ErrorCode)+"."+Chr(13)+
                           "Дальнейшая запись невозможна!", mtError);
       CancelChanging(RO);
       Raise;
     end;
   fi;
 Finally
   SortSection("СекцНФА", SaveПОЛЕСОРТ, True, False);
   ClearVariable(NN);
   CloseWorkArea(RO);
   CloseProgress;
   ToggleAutoRefresh(Режим);
 end;
 ^OK;
end;

Proc СинронизироватьКОДгруппыНФАспискомНФА;
var Режим :Logical;
var ROнфа, ROгрп, i, num, j, len, k, y :Integer;
var ВИДГРП, КОДГРП, ИМЯГРП, FTR :String;
 Режим=AutoRefresh;
 ToggleAutoRefresh(False);
 ShowProgress(0, "Подготовка...");
 ROнфа=OpenWorkArea(crdНФА, "", "1=0");
 ROгрп=OpenWorkArea(crdГРП, "ВИД", "");
 Try
   num=Records(ROгрп);
   if num>0:
     ShowProgress(num, "Обработка групп НФА...");
     for i=1 to num do
       ProgressPos(i);
       FTR="";
       ВИДГРП=Trim(GetFieldS(ROгрп, i, "ВИД"));
       КОДГРП=Trim(GetFieldS(ROгрп, i, "КОД"));
       ИМЯГРП=Trim(GetFieldS(ROгрп, i, "НАИМЕНОВАНИЕ"));
       if ВИДГРП<>"" and ИМЯГРП<>"" and КОДГРП<>"":
         FTR="ГРУППАВИД='"+ВИДГРП+"'"+" and "+"ГРУППАССЫЛКА='"+ИМЯГРП+"'";
       else
         FTR="";
       fi;
       if FTR<>"":
         SetFilter(ROнфа, FTR);
         len=Records(ROнфа);
         if len>0:
           k=0; y=0;
           Try
             for j=1 to len do
               if k=0: -- если новая порция, то открываем RO на изменения
                 BeginChanging(ROнфа);
               fi;
               k=k+1;
               -- *** --
               j=PutFieldS(ROнфа, j, "ГРУППАКОД", КОДГРП);
               -- *** --
               if k=200: --записываем очередную порцию
                 EndChanging(ROнфа);
                 y=y+k;
                 k=0;
               fi;
             od;
             if k>0: EndChanging(ROнфа); y=y+k; fi; --если последняя порция неполная
           Except
             CancelChanging(ROнфа);
           end;
         fi;
       fi;
     od;
   fi;
 Finally
   CloseWorkArea(ROгрп);
   CloseWorkArea(ROнфа);
   CloseProgress;
   ToggleAutoRefresh(Режим);
 end;
end;

2-- События полей
Func Field_onEnter(Field:String; Iter:Integer) :Logical; -- на входе в клетку
var num :Integer;
 if Field="ПОЛЕСОРТ": ПОЛЕСОРТ=ВыборПоляСортировки(ПОЛЕСОРТ);
                      НашаСортировка;
                      ^False;
 |  Field="ВИДGRP":   num=ВыборГруппы(ВИДGRP[Iter], КОДGRP[Iter], ИМЯGRP[Iter]);
                      if num=0: Message("Отказ от выбора группы!", mtInformation); ^False; fi;
                      ВИДGRP[Iter]=ExtractWord(1, TXTGR1[num], "|");
                      КОДGRP[Iter]=ExtractWord(2, TXTGR1[num], "|");
                      ИМЯGRP[Iter]=ExtractWord(3, TXTGR1[num], "|");
                      LAST_GRP=ВИДGRP[Iter]+"|"+КОДGRP[Iter]+"--"+ИМЯGRP[Iter];
                      ^False;
 fi;
 ^True;
end;

Proc Field_onExit(Field:String; Iter:Integer); -- на выходе из клетки
 if Field="ПОЛЕСОРТ": НашаСортировка;
 fi;
end;

Proc ФлагУскорить(flg:Logical);
 if Позиции>0:
   Template.Freeze(0, 0);
   СекцНФАУскор.Visible = flg;
   СекцНФА.Visible      = not flg;
   Template.Freeze(asInteger(СекцНФА.Column(6, ColLeft, "")), asInteger(СекцНФА.Row(1, RowTop, "")));
 fi;
end;

2-- События объектов
Proc btnOnClick(Sender:String); -- объекты при нажатии
 if Sender="btnRead"   : ПостроениеОтчета;
 |  Sender="btnSave"   : if SaveOK: Message("Сохранение прошло успешно!", mtInformation); fi;
 |  Sender="btnСинхро" : СинронизироватьКОДгруппыНФАспискомНФА; ПостроениеОтчета;
 |  Sender="btnExit"   : Close;
 fi;
end;

Proc cbУскорить_onChange(Sender:String);
 ФлагУскорить(Ускорить);
end;

2-- События шаблона
Proc Template_OnOpen(Create:Logical); -- при открытии шаблона
var tmp :String;
 if not ExistsCardFile(crdНФА): Message("В данной схеме доступа отсутствует^Mнеобходимая для работы картотека '"+crdНФА+"'!", mtError); Close; fi;
 if not ExistsCardFile(crdГРП): Message("В данной схеме доступа отсутствует^Mнеобходимая для работы картотека '"+crdГРП+"'!", mtError); Close; fi;
 tmp=UserName(AliasName("РПО_НФА"));
 Пользов=Lo(if(tmp<>"", "Пользователь - "+tmp, "Пользователь локальной версии"));
 РАБ.НАСТР_ПЕЧАТЬ.Cfg(PlanVar("НФА")+"\Настройки\","RPO_STD_000.CFG"); -- стандартная настройка
 --btnСинхро.Visible=False;
end;

Proc Template_AfterOpen(Create:Logical); -- при открытии шаблона
 Очистить;
 Template.Freeze(0, 0);
 ФлагУскорить(Ускорить);
 Template.Field="Фокус";
end;

Proc Template_OnClose(Destroy:Logical); -- при закрытии шаблона
 Очистить;
end;

КОНЕЦ -- конец бланка