БЛАНКСШАБЛОНОМ[07.11.2005] "Конструктор инвентарных номеров", РЕДАКТОР РПО_СОЗДАТЬ_ИНВНОМ;
-- Редакция ЗАО "Агентство 'Русспромоценка'"
--2 Переменные
BTNNAME_MENU:s='Конструктор инв номеров';
btnClose  :Object;   cbUSE_SEP :Object;
btnSave   :Object;   cbЗащита  :Object;
btnReRead :Object;
--
СекцШапка1       :Object;
СекцТАБ  :Object;
СекцШапка2       :Object;
Позиции  :Integer;
--
var NewREC       :Logical=(CurrentState=crdusInserted);
var SelfCRD      :String="РПО_СОЗДАТЬ_ИНВНОМ";
var U            :String="]";
var Пользов      :String;
var First        :Logical;
var SEP_CUR      :String=if(USE_SEP, STR_SEP, " ");
var УМ_СТР       :String="Цифры - элементы инвентарного номера."+if(USE_SEP, " Символ разделителя - '"+STR_SEP+"'.", " Разделителя нет.");
--
var АКТИВНЫ_     :Logical=АКТИВНЫ;
var ФОРМ_ИНВ_НОМ :String;
var ДЛН_НОМЕР_   :Integer=ДЛН_НОМЕР;
var STR_SEP_     :String=STR_SEP;
--
var КОД[]        :String;
var ГРП[]        :String;
var USE[]        :Logical;
var LEN[]        :Integer;
--
var Buf[]        :String;
var BufI[]       :Integer;
var BufГР[]      :String;
var USE_[]       :Logical=USE[$];
--
var ИменаСекций[]  :String;
var BufField[]     :String;
var BufColorBg[]   :Integer;
var BufColorFo[]   :Integer;

2-- Общие процедуры и функции
Func Умолчание :Record;
var RO, num :Integer;
var REC :Record;
 REC=NIL;
 RO=OpenWorkArea(SelfCRD, "");
 Try
   if Records(RO)=0:
     BeginChanging(RO, False);
     Try
       num=InsertRecord(RO);
       num=PutFieldL(RO, num, "ЗАЩИТА"      , True);
       num=PutFieldS(RO, num, "НАИМЕН"      , "Параметры по умолчанию");
       num=PutFieldL(RO, num, "АКТИВНЫ"     , True);
       num=PutFieldL(RO, num, "USE_SEP"     , True);
       num=PutFieldS(RO, num, "STR_SEP"     , ".");
       num=PutFieldL(RO, num, "ГР01"        , False);
       num=PutFieldL(RO, num, "ГР02"        , False);
       num=PutFieldL(RO, num, "ГР03"        , True);
       num=PutFieldL(RO, num, "ГР04"        , True);
       num=PutFieldL(RO, num, "ГР05"        , False);
       num=PutFieldL(RO, num, "ГР80"        , False);
       num=PutFieldL(RO, num, "ГР90"        , True);
       num=PutFieldS(RO, num, "СТР_ПРЕФИКС" , "NN");
       num=PutFieldI(RO, num, "ДЛН_НОМЕР"   , 5);
       num=PutFieldS(RO, num, "ОЧЕРЕДНОСТЬ" , "ГР03.ГР04.ГР90");
       EndChanging(RO);
       REC=GetRecordKey(RO, num);
     Except
       CancelChanging(RO);
       Raise;
     end;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^REC;
end;

Func КлючЗаписиАктивныхНастроек :Record;
var RO, num, nn, i :Integer;
var RR :Record;
 RR=NIL;
 RO=OpenWorkArea(SelfCRD, "", "АКТИВНЫ=True");
 Try
   num=Records(RO);
   if num=1:
     RR=GetRecordKey(RO, 1);
   |  num=0:
     Message("Нет записи настроек подсистемы!^MБудет создана запись с настройками по умолчанию!", mtInformation);
     RR=Умолчание;
   |  num>1:
     Message("Ошибка!^MАктивна должна быть одна запись настроек подсистемы!^MБудет активирована первая запись.", mtError);
     BeginChanging(RO, False);
     Try
       for i=2 to num do nn=PutFieldL(RO, i, "АКТИВНЫ", False); od;
       EndChanging(RO);
     Except
       CancelChanging(RO); Raise;
     end;
     RR=GetRecordKey(RO, 1);
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^RR;
end;

Func ЕщеАктивнаяЗапись: Record;
-- В данной картотеке есть "отмеченные" поля (кроме текущей записи)? - если есть - запомним ключ записи
var RO, i, num :Integer;
var REC, SearchRec :Record;
 REC=NIL;
 RO=OpenWorkArea(SelfCRD, "", "1=0");
 Try
   SetFilter(RO, 'АКТИВНЫ=True');
   num=Records(RO);
   if num>0 :
     for i=1 to num do
       SearchRec=GetRecordKey(RO, i);
       if SearchRec<>Current: REC=SearchRec; Break; fi;
     od;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^REC;
end;

Proc ОтменитьТекущиеНастройки;
var RO, num :Integer;
var REC :Record;
 REC=ЕщеАктивнаяЗапись;
 if REC<>NIL:
   RO=OpenWorkArea(SelfCRD, "", "UKey="+RecordToString(REC));
   Try
     if Records(RO)=1:
       BeginChanging(RO, False);
       Try
         num=PutFieldL(RO, 1, "АКТИВНЫ", False);
         EndChanging(RO);
       Except
         CancelChanging(RO); Raise;
       end;
     fi;
   Finally
     CloseWorkArea(RO);
   end;
 fi;
end;

Proc СменитьАктивныеНастройки;
var Flag :Logical;
var REC :Record;
var msg :String;
 Flag=not(Активны);
 REC=ЕщеАктивнаяЗапись;
 if Flag and REC<>NIL:
   msg="В картотеке уже есть активные настройки.^MАктивировать текущие настройки?";
   if (EnqOkCancel(msg, mtConfirmation)=cmOk): ОтменитьТекущиеНастройки; else Flag=False; fi;
 fi;
 Активны=Flag;
end;

Proc Очистить;
 ClearVariable(Buf); ClearVariable(BufI); ClearVariable(USE_); ClearVariable(BufГР);
end;

Proc ОчиститьТаблицу;
 ClearVariable(КОД); ClearVariable(ГРП); ClearVariable(USE); ClearVariable(LEN);
end;

Proc СчитатьГруппыТекЗаписи;
var num, i, k :Integer;
var tmp :String;
 ClearVariable(Buf);
 num=GetCardFileFields(SelfCRD, Buf, mtlBOOLEAN);
 if not(num>0):
   Message("Ошибка считывания начальных данных!", mtError);
   Template.Object="btnReRead";
   Exit;
 fi;
 SortArray(Buf, False);
 ОчиститьТаблицу;
 i=num; k=1;
 while i>0 do
   if Match(Buf[i], "ГР??")=False:
     DeleteFromArray(Buf, i);
   else
     КОД[k]=Buf[i];
     tmp=GetCardFileFieldComment(SelfCRD, КОД[k]);
     ГРП[k]=Trim(ExtractWord(1 ,tmp, "|"));
     if КОД[k]="ГР90": num=if(ДЛН_НОМЕР>2 and ДЛН_НОМЕР<8, ДЛН_НОМЕР, 5);
                       LEN[k]=num;
                       USE[k]=True;
     |  КОД[k]="ГР80": num=Length(СТР_ПРЕФИКС);
                       LEN[k]=if(num>0, num, 20);
                       USE[k]=GetVariableL(КОД[k]);
     else
       LEN[k]=Int(Trim(ExtractWord(2 ,tmp, "|")));
       USE[k]=GetVariableL(КОД[k]);
     fi;
     k=k+1;
   fi;
   i=i-1;
 od;
 ClearVariable(Buf);
 Позиции=LengthOfArray(КОД);
end;

Func Mod(X:Integer; Y:Integer) :Integer; -- возвращает остаток от деления (X - делимое; Y - делитель)
 ^Int(X-Y*Int(Trunc(X/Y)));
end;

Func ЧетныйИндекс(Iter:Integer) :Logical;
 Iter=Abs(Iter);
 if Iter=1: ^False;
 |  Iter=2: ^True;
 |  Iter>2: if Mod(Iter, 2)=0: ^True; else ^False; fi;
 else ^False;
 fi;
end;

Func Объединить(Value1:String; Value2:String; Separator:String) :String;
var Ret :String;
 if Value1<>"" and Value2<>"": Ret=Value1+Separator+Value2;
 |  Value1= "" and Value2<>"": Ret=Value2;
 |  Value1<>"" and Value2="" : Ret=Value1;
 |  True: Ret="";
 fi;
 ^Ret;
end;

Proc СформироватьМеню;
var i, k, num :Integer;
var tmp :String;
 num=WordsCount(Очередность, SEP_CUR);
 ClearVariable(Buf); ClearVariable(BufГР);
 Buf[1]="*Выполнено*";
 k=2;
 for i=1 to num do
   tmp=ExtractWord(i, Очередность, SEP_CUR);
   BufГР[i]=tmp;
   Buf[k]=tmp+" - передвинуть ВВЕРХ";
   Buf[k+1]=tmp+" - передвинуть ВНИЗ";
   k=k+2;
 od;
end;

Proc ПоменятьМестами(Iter:Integer; Вверх:Logical);
var i, num :Integer;
var tmp :String;
 tmp="";
 if Вверх:
   if Iter=1:
     Message("Это первая строчка.^MПередвинуть выше строчку нельзя!", mtInformation);
   else
     tmp=BufГР[Iter-1]; BufГР[Iter-1]=BufГР[Iter]; BufГР[Iter]=tmp;
   fi;
 else
   if Iter=LengthOfArray(BufГР):
     Message("Это последняя строчка.^MПередвинуть ниже строчку нельзя!", mtInformation);
   else
     tmp=BufГР[Iter+1]; BufГР[Iter+1]=BufГР[Iter]; BufГР[Iter]=tmp;
   fi;
 fi;
 Очередность="";
 num=LengthOfArray(BufГР);
 for i=1 to num do Очередность=Объединить(Очередность, BufГР[i], SEP_CUR); od;
 СформироватьМеню;
end;

Proc ПоменятьМестамиМеню;
var num, k, j :Integer;
var Flag :Logical;
 if Очередность="":
   Message("Нет ни одной группы, применяемой^Mпри построении инвентарного номера!", mtError);
   Template.Field="USE_";
   Template.Frame=1;
   Exit;
 fi;
 if not(LengthOfArray(КОД)>0):
   Message("Ошибка считывания начальных данных!", mtError);
   Template.Object="btnReRead";
   Exit;
 fi;
 num=WordsCount(Очередность, SEP_CUR);
 if num=1: Message("Обнаружена одна группа.^MПередвигать нечего!", mtInformation); Exit; fi;
 СформироватьМеню;
 num=0; j=1;
 while num<>1 do
   num=Alternate("Выберите действие...", Buf, -1, j, 12);
   if num>1: 
     j=num;
     Flag=ЧетныйИндекс(num);
     k=Int(Trunc(num/2));
     ПоменятьМестами(k, Flag);
   fi;
 od;
end;

Func DeleteWordInStr(sStr:String; dStr:String; Raz:String) :String;
var out :String;
var k, len :Integer;
 out="";
 len=Length(dStr);
 if len=0: ^sStr; fi;
 k=Pos(Up(dStr), Up(sStr));
 if k=0: ^sStr; fi;
 if k>1: k=k-1; fi;
 len=len+1;
 out=Delete(sStr, k, len);
 ^out;
end;

Proc СобратьГруппы;
var len, i, p :Integer;
 len=LengthOfArray(КОД);
 if len>0:
   for i=1 to len do
     p=Pos(КОД[i], Очередность);
     if USE[i]=True  and p=0: Очередность=Объединить(Очередность, КОД[i], SEP_CUR);
     |  USE[i]=False and p>0: Очередность=DeleteWordInStr(Очередность, КОД[i], SEP_CUR);
     fi;
   od;
 else
   Очередность="";
 fi;
end;

Func ЗаменитьРазделительНабора(sStr:String; sepOld:String; sepNew:String) :String;
var num, i :Integer;
var Res :String;
 Res="";
 num=WordsCount(sStr, sepOld);
 for i=1 to num do Res=Res+sepNew+ExtractWord(i, sStr, sepOld); od;
 Res=SubStr(Res, Length(sepNew)+1, 255);
 ^Res;
end;

Proc СобратьИнвНомер;
var num, i, k :Integer;
var tmp, sep :String;
 ФОРМ_ИНВ_НОМ="";
 sep=if(USE_SEP, STR_SEP, ""); -- Здесь, если нет разделителя, то не пробел, как везде, а пустая строка
 num=WordsCount(Очередность, SEP_CUR);
 if LengthOfArray(КОД)=0 or num=0: Exit; fi;
 for i=1 to num do
   tmp=ExtractWord(i, Очередность, SEP_CUR);
   k=SearchInArray(КОД, tmp);
   if k>0:
     if tmp="ГР80":
       ФОРМ_ИНВ_НОМ=ФОРМ_ИНВ_НОМ+СТР_ПРЕФИКС+sep;
     else
       ФОРМ_ИНВ_НОМ=ФОРМ_ИНВ_НОМ+RepStr(Str(i), LEN[k])+sep;
     fi;
   fi;
 od;
 if sep<>"": ФОРМ_ИНВ_НОМ=SubStr(ФОРМ_ИНВ_НОМ, 1, Length(ФОРМ_ИНВ_НОМ)-1); fi;
end;

Func TemplateSaveOK :Logical; -- проверка правильности ввода данных
var REC :Record;
var num, i :Integer;
var OK :Logical;
 if НАИМЕН=""      : Message("Опишите (прокомментируйте) Ваш набор построения инвентарного номера!", mtWarning); Template.Field="НАИМЕН";      ^False; fi;
 if СТР_ПРЕФИКС="" : Message("Не задан возможный префикс инвентарного номера!", mtWarning);                      Template.Field="СТР_ПРЕФИКС"; ^False; fi;
 if ДЛН_НОМЕР=0    : Message("Не задано количество символов нумерации инвентарного номера!", mtWarning);         Template.Field="ДЛН_НОМЕР_";  ^False; fi;
 if STR_SEP=""     : Message("Не задан символ-разделитель инвентарного номера!", mtWarning);                     Template.Field="STR_SEP_";    ^False; fi;
 num=LengthOfArray(КОД);
 if not(num>0):
   Message("Ошибка считывания начальных данных!", mtError);
   Template.Object="btnReRead";
   ^False;
 fi;
 OK=False;
 for i=1 to num do if USE[i]=True: OK=True; Break; fi; od;
 if OK=False:
   Message("Нет ни одной группы, применяемой^Mпри построении инвентарного номера!", mtError);
   Template.Field="USE_";
   Template.Frame=1;
   ^False;
 fi;
 REC=ЕщеАктивнаяЗапись;
 if REC<>NIL:
   if АКТИВНЫ: Message("Уже есть активные настройки!", mtWarning); ^False; fi;
 else
   if АКТИВНЫ:
     ^True;
   else
     num=Enquiry("Выберите действие...", "Нет активных настроек!", "Активировать и записать текущие;Вернуться к редактированию", mtConfirmation);
     if num=1 : АКТИВНЫ=True; else АКТИВНЫ=False; ^False; fi;
   fi;
 fi;
 ^True;
end;

Proc ЦветаПолей;
var nn, len :Integer;
 ClearVariable(BufField); ClearVariable(BufColorBg); ClearVariable(BufColorFo);
 nn=InsertInArraySort(BufField,"АКТИВНЫ_");    InsertInArray(BufColorBg,nn,coTeal);
 nn=InsertInArraySort(BufField,"НАИМЕН");      InsertInArray(BufColorBg,nn,coAqua);
 nn=InsertInArraySort(BufField,"USE_");        InsertInArray(BufColorBg,nn,coTeal);
 nn=InsertInArraySort(BufField,"U");           InsertInArray(BufColorBg,nn,coYellow);
 nn=InsertInArraySort(BufField,"СТР_ПРЕФИКС"); InsertInArray(BufColorBg,nn,coAqua);
 nn=InsertInArraySort(BufField,"ДЛН_НОМЕР_");  InsertInArray(BufColorBg,nn,coTeal);
 nn=InsertInArraySort(BufField,"STR_SEP_");    InsertInArray(BufColorBg,nn,coTeal);
 len=LengthOfArray(BufField);
 for nn=1 to len do
   if BufColorBg[nn]=coTeal: BufColorFo[nn]=coWhite;
   |  True: BufColorFo[nn]=coBlack;
   fi;
 od;
end;

Proc ТолькоЧтение(Flag:Logical);
var len, k, i, j, ik, jk, n, цвFont, цвBack :Integer;
var ТЧ :Logical;
var tmp :String;
var СекцИмя : Object;
 ClearVariable(ИменаСекций);
 ИменаСекций[1] ="СЕКЦШАПКА1";
 ИменаСекций[2] ="СЕКЦТАБ";
 ИменаСекций[3] ="СЕКЦШАПКА2";
 len=LengthOfArray(ИменаСекций);
 ShowProgress(len, "Обработка данных...");
 Try
   for k=1 to len do
     ProgressPos(k);
     if FindObject(ИменаСекций[k], СекцИмя):
       ik=asInteger(СекцИмя.RowsCount); jk=asInteger(СекцИмя.ColsCount);
       for i=1 to ik do
         for j=1 to jk do
           tmp=Up(asString(СекцИмя.Cell(i, j, CellContents, ""))); n=SearchInArray(BufField, tmp, True);
           if n<>-1:
             if Flag: цвFont=coBlack; цвBack=coTransparent; ТЧ=True; else цвFont=BufColorFo[n]; цвBack=BufColorBg[n]; ТЧ=False; fi;
             СекцИмя.Cell(i, j, CellFontColor, цвFont); СекцИмя.Cell(i, j, CellBgColor, цвBack); СекцИмя.Cell(i, j, CellReadOnly, ТЧ);
           fi;
         od;
       od;
     fi;
   od;
 Finally
   CloseProgress;
 end;
 cbUSE_SEP.Enabled=not(Flag);
 btnReRead.Enabled=not(Flag);
 btnSave.Enabled=not(Flag);
 ClearVariable(ИменаСекций);
end;

Func ВерныйСимвол(Char :String) :Logical;
 if Char>="0" and Char<="9": ^True;
 |  Char>="A" and Char<="Z": ^True;
 |  Char>="a" and Char<="z": ^True;
 |  Char>="А" and Char<="Я": ^True;
 |  Char>="а" and Char<="я": ^True;
 fi;
 Message("В строке могут присутствовать только буквы и цифры!", mtError);
 ^False;
end;

Proc Перечитать;
 СчитатьГруппыТекЗаписи;
 СобратьГруппы;
 СобратьИнвНомер;
end;

Proc Инициализация;
 if СТР_ПРЕФИКС="": СТР_ПРЕФИКС="NN"; fi;
 if ДЛН_НОМЕР=0: ДЛН_НОМЕР=5; fi;
 if STR_SEP="": STR_SEP="."; fi;
 if NewREC:
   Защита=False; cbЗащита.State  = Защита;
   USE_SEP=True; cbUSE_SEP.State = USE_SEP;
   ГР03=True;
   ГР04=True;
   ГР90=True;
 fi;
 Перечитать;
end;

Func Сохранить :Logical;
var num, i :Integer;
 if TemplateSaveOK=False: ^False; fi;
 СобратьГруппы;
 СобратьИнвНомер;
 num=LengthOfArray(КОД);
 for i=1 to num do PutVariableL(КОД[i], USE[i]); od;
 ^True;
end;

2-- События объектов
Proc btnOnClick(Sender:String); -- объекты при нажатии
 if Sender="btnClose" : if Защита=False: EditorCancel; fi; Close;
 |  Sender="btnReRead": Перечитать;
 |  Sender="btnSave"  : if Сохранить: EditorApply; Message("Сохранение прошло успешно!", mtInformation); fi;
 fi;
end;

Proc cbЗащита_onChange(Sender:String);
var Flag, SaveOK :Logical;
var qq :Integer;
 if Защита=False:
   SaveOK=True; -- если защита 'снимается' значит проверка данных уже производилась
   qq=EnqOkCancel("Вы действительно хотите снять защиту^M от изменений у данного документа?", mtConfirmation);
   if qq=cmCancel: Flag=True; else Flag=False; fi;
 else
   SaveOK=TemplateSaveOK;
   Flag=SaveOK;
 fi;
 Защита=Flag; cbЗащита.State=Защита;
 ТолькоЧтение(Flag);
 if not(SaveOK): Exit; fi; -- Избегаем двойных сообщений
 EditorApply;
end;

Proc cbUSE_SEP_onChange(Sender:String);
var Flag :Logical;
 Flag=not(USE_SEP);
 Очередность=ЗаменитьРазделительНабора(Очередность, if(Flag, STR_SEP, " "), if(USE_SEP, STR_SEP, " "));
 СобратьИнвНомер;
end;

2-- События клеток
Func Field_onEnter(Field:String; Iter:Integer) :Logical; -- на входе в клетку
var k, num :Integer;
var oldVal :String;
 oldVal="";
 if Field="2U0":
   ПоменятьМестамиМеню;
   СобратьГруппы;
   СобратьИнвНомер;
   ^False;
 |  Field="2USE_0":
   if КОД[Iter]<>"ГР90":
     USE[Iter]=not(USE[Iter]);
   else
     Message("Группа 'НОМЕР' всегда применяется!", mtInformation);
   fi;
   СобратьГруппы;
   СобратьИнвНомер;
   ^False;
 |  Field="2ДЛН_НОМЕР_0":
   ClearVariable(Buf);
   for k=3 to 7 do Buf[k-2]="Количество символов номера - "+Str(k); od;
   k=Alternate("", Buf, -1, ДЛН_НОМЕР-2, 12);
   if k<>0: ДЛН_НОМЕР=k+2; fi;
   k=SearchInArray(КОД, "ГР90");
   if k>0: LEN[k]=ДЛН_НОМЕР; fi;
   ClearVariable(Buf);
   СобратьГруппы;
   СобратьИнвНомер;
   ^False;
 |  Field="2STR_SEP_0":
   oldVal=STR_SEP;
   ClearVariable(Buf);
   Buf[1]="Символ-разделитель - .";
   Buf[2]="Символ-разделитель - -";
   Buf[3]="Символ-разделитель - *";
   Buf[4]="Символ-разделитель - :";
   Buf[5]="Символ-разделитель - @";
   Buf[6]="Символ-разделитель - #";
   Buf[7]="Символ-разделитель - $";
   Buf[8]="Символ-разделитель - ~";
   Buf[9]="Символ-разделитель - _";
   num=SearchInArray(Buf, "Символ-разделитель - "+STR_SEP, False, 1);
   k=Alternate("", Buf, -1, num, 12);
   if k<>0: STR_SEP=SubStr(Buf[k], Length(Buf[k]), 1); fi;
   ClearVariable(Buf);
   Очередность=ЗаменитьРазделительНабора(Очередность, oldVal, STR_SEP);
   СобратьГруппы;
   СобратьИнвНомер;
   ^False;
 |  Field="АКТИВНЫ_": СменитьАктивныеНастройки; ^False;
 fi;
 ^True;
end; 

Proc Field_onExit(Field:String; Iter:Integer); -- на выходе из клетки
 if Field="2СТР_ПРЕФИКС0":
  if СТР_ПРЕФИКС="": СТР_ПРЕФИКС="NN"; fi;
 fi;
 СобратьГруппы;
 СобратьИнвНомер;
end;

Func Field_OnValidateS(Field:String; Iter:Integer; Value:String) :Logical;
var len, i :Integer;
 if Field="СТР_ПРЕФИКС":
   len=Length(Value);
   if len=0: Message("Префикс должен содержать хотя бы один символ!", mtError); ^False; fi;
   for i=1 to len do if ВерныйСимвол(SubStr(Value, i, 1))=False: ^False; fi; od;
 fi;
 ^True;
end;

2-- События шаблона
Proc Template_OnOpen(Create:Logical); -- при открытии шаблона
var tmp :String;
 EnableCommands(False, cmDelRec);
 РАБ.НАСТР_ПЕЧАТЬ.Cfg("","RPO_STD_000.cfg"); -- стандартная настройка
 ЦветаПолей;
 tmp=UserName(AliasName(SelfCRD));
 Пользов=if(tmp<>"", "Пользователь - "+tmp, "Пользователь локальной версии");
 First=True;
end;

Proc Template_AfterOpen(Create:Logical); -- при открытии шаблона
 if First:
   Инициализация;
   ТолькоЧтение(Защита);
 fi;
 First=False;
end;

Proc Template_OnClose(Destroy:Logical); -- при закрытии шаблона
 ClearVariable(BufField); ClearVariable(BufColorBg); ClearVariable(BufColorFo);
 Очистить;
 if CurrentState=CrdusUndefined: Destroy=True; fi;
end;

Proc Template_onRead; -- при считывании шаблона
 Очистить;
 if First=False:
   Инициализация;
   ТолькоЧтение(Защита);
 fi;
 Template.Object="btnClose";
end;

Proc Template_onCancel; -- при отмене редактирования шаблона
 Очистить;
 if CurrentState=CrdusUndefined: 
   Message("Была произведена отмена редактирования!^MВ картотеке нет записей, бланк будет закрыт.", mtInformation);
   Close;
 else
   Перечитать;
 fi;
end;

Func Template_OnValidate: Logical; -- при проверке шаблона
var nn :Integer;
var SaveOK :Logical;
 if NewREC=False: if not(TemplateSaveOK): ^False; fi; fi;
 if NewREC and Защита=False:
   if not(TemplateSaveOK): ^False; fi;
   nn=EnqOkCancel("Защитить данный документ от изменений?", mtConfirmation);
   if nn=cmOk:
     SaveOK=TemplateSaveOK;
     Защита=SaveOK;
     cbЗащита.State=Защита;
     ТолькоЧтение(SaveOK);
   fi;
 fi;
 SaveOK=Сохранить;
 ^True;
end;

-- Процедуры и Функции для экспорта в другие бланки
Func DelDot(Value:String) :String;
var p :Integer;
 p=Pos(".", Value);
 while p>0 do Value=Delete(Value,p,1); p=Pos(".",Value); od;
 ^Value;
end;

var МаскаВедИнвНомер_res[]:s;
var МаскаВедИнвНомер_Acc_КодНФА[]:s;


Func МаскаВедИнвНомер(Acc:String; КодНФА:String) :String;
var REC :Record;
var res, СТРУКТУРА, sep, pfx, ss, tmp :String;
var RO, len1, num, i :Integer;
var flg :Logical;
 res="";
 tmp=SubStr(Acc, 1, 22)+SubStr(КодНФА, 5, 6);
 i=searchinarray(МаскаВедИнвНомер_Acc_КодНФА,tmp,true);
 if i>0:
   ^МаскаВедИнвНомер_res[i];
 fi;
 if Match(Acc, РАБ.БЮДЖЕТ2005.МаскаСчетаФКР)=False:
   trace("Счет "+Acc+" не соотвествует структуре учета!");
   ^"";
 fi;
 if Name_A(кодНФА)=" ": Message("НФА с кодом "+КодНФА+" нет в структуре учета!", mtError); ^""; fi;
 REC=КлючЗаписиАктивныхНастроек;
 if REC=NIL:
   Message("Не найдена запись с ведомственными настройками!", mtError);
   ^"";
 fi;
 RO=OpenWorkArea(SelfCRD, "", "Ukey="+RecordToString(REC)); --РПО_СОЗДАТЬ_ИНВНОМ
 Try
   СТРУКТУРА=GetFieldS(RO, 1, "ОЧЕРЕДНОСТЬ");
   flg=GetFieldL(RO, 1, "USE_SEP");
   if flg: sep=GetFieldS(RO, 1, "STR_SEP"); else sep=""; fi;
   len1=GetFieldI(RO, 1, "ДЛН_НОМЕР");
   pfx=GetFieldS(RO, 1, "СТР_ПРЕФИКС");
 Finally
   CloseWorkArea(RO);
 end;
 ss=if(sep<>"", sep, " ");
 num=WordsCount(СТРУКТУРА, ss);
 if num=0: Message("Строка структуры (порядок следования групп) пустая!", mtError); ^""; fi;
 for i=1 to num do
   tmp=ExtractWord(i, СТРУКТУРА, ss);
   if tmp="ГР01": res=res+SubStr(Acc, 1, 3)+sep;
   |  tmp="ГР02": res=res+DelDot(SubStr(Acc, 5, 16))+sep;
   |  tmp="ГР03": res=res+SubStr(КодНФА, 5, 3)+sep;
   |  tmp="ГР04": res=res+SubStr(КодНФА, 9, 2)+sep;
   |  tmp="ГР05": res=res+SubStr(Acc, 22, 1)+sep;
   |  tmp="ГР80": res=res+pfx+sep;
   |  tmp="ГР90": res=res+RepStr("?", len1)+sep;
   fi;
 od;
 if sep<>"": res=SubStr(res, 1, Length(res)-1); fi;
 tmp=SubStr(Acc, 1, 22)+SubStr(КодНФА, 5, 6);
 i=insertinarraysort(МаскаВедИнвНомер_Acc_КодНФА,tmp);
 insertinarray(МаскаВедИнвНомер_res,i,res);

 ^res;
end;


Func СформироватьВедИнвНомер(Acc:String; КодНФА:String; CurREC:Record; pgsBar:Logical) :String;
var REC :Record;
var CRDинв, res, СТРУКТУРА, sep, pfx, ss, tmp :String;
var RO, len, num, i, next, k ,maxBufI:Integer;
var flg :Logical;
--var f01, f02, f03, f04, f05, f80, f90 :Logical;
 res=""; next=0;
 CRDинв="РПО_ИНВКАРТ_ОС";
 if Match(Acc, РАБ.БЮДЖЕТ2005.МаскаСчетаФКР)=False:
   Message("Счет "+Acc+" не соотвествует структуре учета!", mtError);
   ^"";
 fi;
 if Name_A(кодНФА)=" ": Message("НФА с кодом "+КодНФА+" нет в структуре учета!", mtError); ^""; fi;
 REC=КлючЗаписиАктивныхНастроек;
 if REC=NIL:
   Message("Не найдена запись с ведомственными настройками!", mtError);
   ^"";
 fi;
 RO=OpenWorkArea(SelfCRD, "", "Ukey="+RecordToString(REC)); --РПО_СОЗДАТЬ_ИНВНОМ
 if pgsBar: ShowProgress(0, "Поиск данных..."); fi;
 Try
   СТРУКТУРА=GetFieldS(RO, 1, "ОЧЕРЕДНОСТЬ");
   flg=GetFieldL(RO, 1, "USE_SEP");
   if flg: sep=GetFieldS(RO, 1, "STR_SEP"); else sep=""; fi;
   len=GetFieldI(RO, 1, "ДЛН_НОМЕР");
   pfx=GetFieldS(RO, 1, "СТР_ПРЕФИКС");
--   f01=GetFieldL(RO, 1, "ГР01"); -- Код главы | 3
--   f02=GetFieldL(RO, 1, "ГР02"); -- Код ФКР | 14
--   f03=GetFieldL(RO, 1, "ГР03"); -- Код счета | 3
--   f04=GetFieldL(RO, 1, "ГР04"); -- Код субсчета | 2
--   f05=GetFieldL(RO, 1, "ГР05"); -- Код источника финансирования | 1
--   f80=GetFieldL(RO, 1, "ГР80"); -- Префикс | 20
--   f90=GetFieldL(RO, 1, "ГР90"); -- Номер | 7
 Finally
   CloseWorkArea(RO);
   if pgsBar: CloseProgress; fi;
 end;
 ss=if(sep<>"", sep, " ");
 num=WordsCount(СТРУКТУРА, ss);
 if num=0: Message("Строка структуры (порядок следования групп) пустая!", mtError); ^""; fi;
--???.????.???????.???.?.???.??.???    - Счет классификации расходов
--000000000111111111122222222223333333
--123456789012345678901234567890123456
-- if pgsBar: ShowProgress(num, "Считывание настроек..."); fi;
-- Try
--   for i=1 to num do
--     if pgsBar: ProgressPos(i); fi;
--     tmp=ExtractWord(i, СТРУКТУРА, ss);
--     if tmp="ГР01": res=res+SubStr(Acc, 1, 3)+sep;
--     |  tmp="ГР02": res=res+DelDot(SubStr(Acc, 5, 16))+sep;
--     |  tmp="ГР03": res=res+SubStr(КодНФА, 5, 3)+sep;
--     |  tmp="ГР04": res=res+SubStr(КодНФА, 9, 2)+sep;
--     |  tmp="ГР05": res=res+SubStr(Acc, 22, 1)+sep;
--     |  tmp="ГР80": res=res+pfx+sep;
--     |  tmp="ГР90": res=res+RepStr("?", len)+sep;
--     fi;
--   od;
-- Finally
--   if pgsBar: CloseProgress; fi;
-- end;
 res=МаскаВедИнвНомер(Acc,КодНФА);
-- if sep<>"": res=SubStr(res, 1, Length(res)-1); fi;
 k=Pos("?", res);
 RO=OpenWorkArea(CRDинв, "ИНВ_ВЕД", "Match(ИНВ_ВЕД,'"+res+"') and Ukey<>"+RecordToString(CurREC));
 if pgsBar: ShowProgress(0, "Поиск нового инвентарного номера..."); fi;
 Try
   num=Records(RO);
   if num>0:
     if pgsBar: ShowProgress(num, "Поиск нового инвентарного номера..."); fi;
     maxBufI=0;
     for i=1 to num do tmp=GetFieldS(RO, num-i+1, "ИНВ_ВЕД");
       if pgsBar: ProgressPos(i); fi;
       maxBufI=max(maxBufI,Int(SubStr(tmp, k, len)));
       if maxBufI>0:break;fi;
     od;
     next=maxBufI+1;
   else
     next=1;
   fi;
 Finally
   CloseWorkArea(RO);
   if pgsBar: CloseProgress; fi;
 end;
 num=Length(Str(next));
 tmp=RepStr("0", len-num)+Str(next);
 res=Delete(res, k, len);
 res=Insert(tmp, res, k);
 ^res;
end;


var  var_flg :l;
var  var_sep :S;
var  var_len1:i;
var  var_pfx :s;
var  var_ss  :s;
var  var_num :i;
var  var_СТРУКТУРА:s;

Func МаскаВедИнвНомер1:l;
var REC :Record;
var RO  :Integer;
 REC=КлючЗаписиАктивныхНастроек;
 if REC=NIL:
   Message("Не найдена запись с ведомственными настройками!", mtError);
   ^false;
 fi;
 RO=OpenWorkArea(SelfCRD, "", "Ukey="+RecordToString(REC)); --РПО_СОЗДАТЬ_ИНВНОМ
 Try
   var_СТРУКТУРА=GetFieldS(RO, 1, "ОЧЕРЕДНОСТЬ");
   var_flg=GetFieldL(RO, 1, "USE_SEP");
   if var_flg: var_sep=GetFieldS(RO, 1, "STR_SEP"); else var_sep=""; fi;
   var_len1=GetFieldI(RO, 1, "ДЛН_НОМЕР");
   var_pfx=GetFieldS(RO, 1, "СТР_ПРЕФИКС");
 Finally
   CloseWorkArea(RO);
 end;
 var_ss=if(var_sep<>"", var_sep, " ");
 var_num=WordsCount(var_СТРУКТУРА, var_ss);
 if var_num=0: Message("Строка структуры (порядок следования групп) пустая!", mtError); ^false; fi;
^true;
end;

var cache_МаскаВедИнвНомер2[]:s;
var cache_МаскаВедИнвНомер2_res[]:s;
var cache_МаскаВедИнвНомер2_ini:l;
Func МаскаВедИнвНомер2
(
  Acc:S;
  КодНФА:S
--  СТРУКТУРА:S;
--  flg:l;
--  sep:S;
--  len1:i;
--  pfx:s;
--  ss:s;
--  num:i
) :S;

var SubStrКодНФА_ACC :String;
var res,tmp :String;
var RO, i :Integer;
 res="";
 if not cache_МаскаВедИнвНомер2_ini:
     ClearVariable(НФА.СЕРВИС.КОНСТРУКТОР.ИНВ_НОМЕРА.cache_МаскаВедИнвНомер2);
     ClearVariable(НФА.СЕРВИС.КОНСТРУКТОР.ИНВ_НОМЕРА.cache_МаскаВедИнвНомер2_res);
    cache_МаскаВедИнвНомер2_ini=true;
 fi;
 SubStrКодНФА_ACC=SubStr(Acc, 1, 3)+'|'+SubStr(Acc, 5, 16)+'|'+SubStr(Acc, 22, 1);
 SubStrКодНФА_ACC=SubStrКодНФА_ACC+'|'+SubStr(КодНФА, 5, 3)+'|'+SubStr(КодНФА, 9, 2);
 i=searchinarray(cache_МаскаВедИнвНомер2,SubStrКодНФА_ACC,true);
 if i>0:^cache_МаскаВедИнвНомер2_res[i];fi;
 for i=1 to var_num do
   tmp=ExtractWord(i, var_СТРУКТУРА, var_ss);
   if tmp="ГР01": res=res+SubStr(Acc, 1, 3)+var_sep;
   |  tmp="ГР02": res=res+DelDot(SubStr(Acc, 5, 16))+var_sep;
   |  tmp="ГР03": res=res+SubStr(КодНФА, 5, 3)+var_sep;
   |  tmp="ГР04": res=res+SubStr(КодНФА, 9, 2)+var_sep;
   |  tmp="ГР05": res=res+SubStr(Acc, 22, 1)+var_sep;
   |  tmp="ГР80": res=res+var_pfx+var_sep;
   |  tmp="ГР90": res=res+RepStr("?", var_len1)+var_sep;
   fi;
 od;
 if var_sep<>"": res=SubStr(res, 1, Length(res)-1); fi;
 i=insertinarraysort(cache_МаскаВедИнвНомер2,SubStrКодНФА_ACC);
 insertinarray(cache_МаскаВедИнвНомер2_res,i,res);
 ^res;
end;

Func НачальнаяПозицияНумерации :Integer;
var REC :Record;
var res, СТРУКТУРА, sep, pfx, ss, tmp :String;
var RO, len, num, i, k :Integer;
var flg :Logical;
 res=""; k=0; len=0;
 REC=КлючЗаписиАктивныхНастроек;
 if REC=NIL: Message("Не найдена запись с ведомственными настройками!", mtError); ^0; fi;
 RO=OpenWorkArea(SelfCRD, "", "Ukey="+RecordToString(REC)); --РПО_СОЗДАТЬ_ИНВНОМ
 Try
   СТРУКТУРА=GetFieldS(RO, 1, "ОЧЕРЕДНОСТЬ");
   flg=GetFieldL(RO, 1, "USE_SEP");
   if flg: sep=GetFieldS(RO, 1, "STR_SEP"); else sep=""; fi;
   len=GetFieldI(RO, 1, "ДЛН_НОМЕР");
   pfx=GetFieldS(RO, 1, "СТР_ПРЕФИКС");
 Finally
   CloseWorkArea(RO);
 end;
 ss=if(sep<>"", sep, " ");
 num=WordsCount(СТРУКТУРА, ss);
 if num=0: Message("Строка структуры (порядок следования групп) пустая!", mtError); ^0; fi;
 for i=1 to num do
   tmp=ExtractWord(i, СТРУКТУРА, ss);
   if tmp="ГР01": res=res+RepStr("%", 3)+sep;
   |  tmp="ГР02": res=res+RepStr("%", 14)+sep;
   |  tmp="ГР03": res=res+RepStr("%", 3)+sep;
   |  tmp="ГР04": res=res+RepStr("%", 2)+sep;
   |  tmp="ГР05": res=res+RepStr("%", 1)+sep;
   |  tmp="ГР80": res=res+pfx+sep;
   |  tmp="ГР90": res=res+RepStr("?", len)+sep;
   fi;
 od;
 if sep<>"": res=SubStr(res, 1, Length(res)-1); fi;
 k=Pos("?", res);
 ^k;
end;
var ДлинаНумерации_res:i;
Func ДлинаНумерации :Integer;
var REC :Record;
var RO, len :Integer;
 len=0;
 if ДлинаНумерации_res>0:^ДлинаНумерации_res;fi;
 REC=КлючЗаписиАктивныхНастроек;
 if REC=NIL: Message("Не найдена запись с ведомственными настройками!", mtError); ^0; fi;
 RO=OpenWorkArea(SelfCRD, "", "Ukey="+RecordToString(REC)); --РПО_СОЗДАТЬ_ИНВНОМ
 Try len=GetFieldI(RO, 1, "ДЛН_НОМЕР"); Finally CloseWorkArea(RO); end;
 ДлинаНумерации_res=len;
 ^len;
end;

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