// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.
/*

     Модуль содержит функции, позволяющие программисту строить интерфейс
работы с базами данных.
     Основная функция InitList() - обеспечивает выполнение следующих опраций:
     - просмотр базы данных или связанной совокупности баз;
     - ввод-редактирование с применением справочников и с программным постро-
     ением картинок ввода;
     - выполнение сопроцедуры при перемещении по базам;
     - сортировка и поиск в базе данных;
     - печать;
     - поддержка встроенного меню.


    ***********************************
     InitList() - описание интерфейса
    ***********************************

FUNCTION InitList(
01.nTop      - верхняя строка
02.nBottom   - нижняя строка
03.cColHead  - строка или массив строк - заголовок над полями,
               или если число, тогда считается, что заголовка нет и это
               ширина области вывода InitList
04.aBlockCols - массив блоков кода для QBrowse() - см.S_Browse.prg
05.cCurProc   - сопроцедура для QBrowse() - см.S_Browse.prg
06._aHeads - Массив описания области ввода:
   //z0ne: чего та достала не интерактивность заголовков
   {{блок->cтроку,имя поля,использование при вводе,исп-е.в фильтре,исп-е.в подсчете сумм}} или
   {{Строка,имя поля,использование при вводе,исп-е.в фильтре,исп-е.в подсчете сумм}} или
   {{y,x},
           имя поля или имя PRIVATE переменной или
           указание на элемент многомерного массива
           причем если массив не определен он инициализируется
           ,...}

          Необязательные параметры (по умолчанию '1'):

     элемент N

       3   Использование при вводе/корректировке:
          '0'-не используется
          '1'-используется

       4   Использование в фильтре:
          '0'-не используется
          '1'-используется, если тип-строка, то проверяется на принадлежность ($)
          '2'-используется, если тип-строка, то проверяется на равно слева (для счетов)

       5   Использование в подсчете сумм (если тип-число):
          '0'-не используется
          '1'-используется

       6   строка для подстановки фильтра
           в ней могут участвотать конструкции вызова массива aIn
           (заменяются на соотв.значения элементов)
           в виде aIn[x,y],aIn[x], но не aIn[x][y], а если
           использование aIn не явно, то предусмотреть, что
           его может не существовать после установки фильтра

        7  блок кода для суммирования

        8  кол-во строк занимаемых элементом aHeads (0 невыводятся)

             Пример 1:
             aInputHeads:={;
             {'Группа.................... ','Grup'},;
             {'Н/номер................... ','NNum'},;
             {'Кол-во на начало периода.. ','Kol0'},;
             {'Цена   на начало периода.. ','Cena0'},;
             {'Склад..................... ','Sklad'},;
             {'Место хранения............ ','Mesto'};
              }
             В этом случае координаты ввода и вид картинки строится программно.
             Пример 2:
             aInputHeads:={;
             {{4,5},'Grup'},;
             {{4,25},'NNum'},;
             {{5,5},'Kol0'},;
             {{5,25},'Cena0'},;
             {{6,5},'Sklad'},;
             {{6,25},'Mesto'};
              }
             В этом случае картинку можно построить с помощью _bScrInit, а
             Getы будут располагаться в соответствии с указанными координатами.

     Если используется вывод заголовков посредством bSayHead,
     то aHeads обязательно ручной с координатами

07._aRef      - массив имен справочников для полей ввода (построение - см.S_Refer);
08._aPict     - массив шаблонов ввода;
09._aWhen     - массив предусловий для ввода;
10._aValid    - массив постусловий;

          В When-Valid функциях могут использоваться PRIVATE переменные:
             - nApp - режим ввода:
               0-ввод значений для фильтрации,
               1-корректировка,
               2-дополнение базы,
             - aIn[LEN(_aHeads)] - массив вводимых значений,
             - aLastIn[LEN(_aHeads)] - массив исходных значений (перед вводом)

11._nUniMode  - режим проверки на уникальность:
             0 - не проверяет,
             1 - предупреждает,но позволяет вводить записи с одинаковыми ключами,
             2 - сообщает и не позволяет вводить записи с одинаковыми ключами.

12._bDelInit  - блок проверки на возможность удаления текущей записи,
             выполняющийся перед запросом на удаление.
             Если возвращает (.F.), то дальнейшие действия не производятся,
             в противном случае может возвратить  наименование запроса на
             уничтожение ("Удалить документ?" и т.п.)

13._bScrInit  - блок,выполняющийся перед построением картинки ввода, может исполь-
             зоваться для построения индивидуальных картинок ввода или для
             других предварительных действий;
             Возвращаемое значение:
              - 0 - дальнейший ввод не производится (запрет);
              - 1 - после EVAL(_bScrInit) выполняется стандартный ввод со
                    стандартной картинкой и скроллингом;
              - 2 - после EVAL(_bScrInit) выполняется стандартный ввод
                    по заданным в _aHeads координатам без построения
                    стандартной картинки,но со скроллингом, в этом случае
                    программист должен позаботиться,чтобы область ввода не
                    пересекалась с областью скроллинга (списка);
              - 3 или NIL - то же самое, что и 2, но без скроллинга.
              - 4 - то же самое, что и 1, но без скроллинга.

14._aSortSeek - массив сортировок и характеристик поиска.
             Если присутствует, то будет осуществляться поиск и
             выбор вида сортировки с соответствующей сменой главного индекса.
             Кол-во элементов равно кол-ву видов сортировки.
             Структура элемента:
             {
             1.строка в меню выбора,
             2.указание при вводе искомого значения,
             3.макровыражение для инициализации исходного значения aIn[1],
             4.макровыражение для Seek-поиска после ввода aIn[1] или после поиска в связанной базе,
             5.cPicture-шаблон для ввода искомого значения,
             6.cValid для ввода искомого значения,
             7.cRef - имя справочника при вводе искомого значения,
             8.nOrd - имя тэга поиска/сортировки
                      (по умолчанию - порядковый номер строки массива)
                      если указывать в качестве 11 элемента массива
                      имя тэга и не указывать 10 элемент, то 11 элемент
                      используется для установки тэга поиска, а 8 для
                      сортировки
             9.aGetBlock - массив oGet:bBlock
            10.алиас связанной базы
               - алиас дочерней базы по которой производится поиск
            11.тэг для поиска в родительской базе
               - имя тэга который выставляется перед поиском
                 значения полученного выполнение 12 параметра
            12.макровыражение для Seek-поиска в родительской базе
               - значение выражения используется для поиска записи
                 в родительской базе
            13.признак сортировки - если .F., то по данному описанию
               производится только поиск и никакой сортировки
            14.макровыражение сортировки ключа для сортировки -
               если указано, то поиск по данной позиции некогда не выполняется
            15.признак отмены поиска - если .T., то  исключаем
               позицию из поиска
             }
  ВЫПОЛНЯЮТСЯ ПОСТРОЕНИЯ ВРЕМЕННЫХ СОРТИРОВОК В ВАРИАНТАХ :
     ПЕРВЫЙ ВАРИАНТ (сортировка снизу вверх) :
            Если aSortSeek[n,14] = NIL или не указан, то
             При указании алиаса связанной базы (10-12-ты элементы)
             производится поиск в дочерней базе
             по aSortSeek[n,4] и возврат
             по aSortSeek[n,12] в родительскую
             с учетом Scope и Filter в родительской базе
             Производится поиск с учетом связей 1:1,1:M и M:1 (с возможностью
             найти следующую запись)
             Производится сортировка с учетом связей 1:1 и M:1, но не 1:M !
             Если требуется сортировка по связанной базе, то указание 8,10,11
             параметров обязательно.
             Причем при использовании связанной базы в родительской
             базе со scope тип scope должен быть символьный
        ПРЕИМУЩЕСТВА : быстрый поиск, медленная сортировка

     ВТОРОЙ ВАРИАНТ :
            Если aSortSeek[n,14] = макровыражение ключа сортировки, то
             Поиск не производится, производится сортировка
             При указании алиаса связанной базы (10-12-ты элементы)(можно не указывать)
             производится поиск в связанной базе по ключу
             по aSortSeek[n,12] и вычисление aSortSeek[n,14]
             для использования результата в качестве ключа для
             сортировки.
             Производится поиск с учетом связей 1:M
             Производится сортировка с учетом связей  M:1 !

        ПРЕИМУЩЕСТВА : поиск отсутствует, относительно быстрая сортировка


        МИНИМАЛЬНЫЙ ПРИМЕР ИСПОЛЬЗОВАНИЯ :

             Номер строки массива соответствует номеру индекса (если нет nOrd).
             Если производится поиск сразу по нескольким полям, то подэлементы
             2-3,5-7 должны быть массивами.
             Ввод искомых значений производится в PRIVATE-массив aIn, если
             одно значение, то - в элемент aIn[1].
             Пример:
             aSortSeek:={;
             {'- по кодам        ','Введите искомый код','Cod','UPPER(aIn[1])'},;
             {'- по наименованиям','Введите пеpвые символы наименования',;
                       'LEFT(Name,5)',TRIM(UPPER(aIn[1]))}}

15._aPHeads   - массив описания полей для печати:
             Простая структура,если последовательность полей в отчете соответ-
             ствует последовательности в базе данных:
             {Наименование отчета,наименование 1 поля,наименование 2 поля,...}
             Пример:
             aPHeads:=;
             {'Справочник групп товаров','Код','Наименование','Счет'}

             Более сложная структура:
             {
             Наименование отчета,;
             {наименование 1 поля,имя 1 поля в базе,шаблон вывода,признак суммирования},;
             {наименование 2 поля,имя 2 поля в базе,шаблон вывода,признак суммирования},;
             {блок кода возвращающий наименование 3,имя 3 поля в базе,шаблон вывода,признак суммирования},;
              ...
             }
             Пример:
             aPHeads:=;
             {"КАPТОТЕКА УЧЕТА ТМЦ НА СКЛАДЕ,{'Группа','Grup','XXXXXX'},;
             {'Н/ном','NNum'},{'Наименование','MLabel->Name'},;
             {{|| IF(n=1,"Тест 1","Тест 2" },'MLabel->Name'},;
             {'Нач.остаток','Kol0',,.T.},{'Тек.кол-во','KolTek','99999999',.T.}}

16._bPost     - постблок, выполняющийся после записи (REPLACE) данных в базу
17._bDelPost  -блок,выполняющийся после запроса на удаление записи перед непосред-
            ственным удалением текущей записи
18._aGetBlock - массив блоков считываания-записи для Get-объектов.Если указан,то
             заменяет стандартные блоки,формируемые автоматически.
             ему передается три параметра :
               1) x    - присваемое значение или NIL
               2) oGet - get объект (см. в конце описания доп.информацию)
               3) i    - второй индекс aIn[x,i] (в случае фильтра) или ноль
                         если элемент aIn одномерный
               4) lDisplay - флаг первой прорисовки GetList

          ВНИМАНИЕ !!
             Если требуется подменить стандартно формируемые блоки кода
             в фильтре (при nApp = 0), своими , то требуется
             дополнительно передать в qInput параметр lGetBlock равный .T.

19.bColor    - блок кода,возвращающий цвет для каждого поля вывода.
            Если указан, то по результату его выполнения будет устанавливаться
            цвет  при выдаче каждого в QBrowse() элемента строки (позволяет
            делать разноцветные строки и графы - см.также S_Browse)

20.bColor1  - блок кода,возвращающий цвет для каждого поля вывода,аналогичный
            bColor, только для активной строки (см.также S_Browse)
21.nLeftBrd - левая граница для Browse (при необходимости располагать не по центру)
22.bScrPost - блок,выполняющийся после возврата из стандартной функции ввода/редакт
23.cFindMacro - выражение поиска в символьном виде для функций Find(),FindFilter()
              искомая строка - PRIVATE cFind - вводится пользователем
24.cCol_Browse - цвета для qBrowse(), по умолчанию COL_BROWSE
25.lYesClear - если присутствует, то QBrowse() при скроллировании сначала очищает
            область, а потом отображает данные
26.bPreGet - блок кода выполняемый пеpед каждым выполнением READ, до
             пpоpисовки GetList (при необходимости заранее проинециализировать aIn,
             а так же для навески SetKey'ев и формирования связанных таблиц до
             непосредственного редактирования)
             В блок кода передается флаг выхода по сслыке
             если его сбросить в .T. то быдет произведен выход из qInput
             не выполняя bPostGet
             В блок кода вторым параметром передается текущий aHeads
27.bPostGet - блок кода выполняемый после каждого завеpшения READ,
              ему пеpедается флаг сохpанения данных .T. - данные были записаны в базу
             .F. - данные не были записаны в базу (выполняется после возможного
             выполнения bPost ),флаг изменения данных и флаг циклического
             ввода по ссылке, если его сбросить в -1 то циклического ввода не будет
             Если bPostGet вернет .F., то произойдет повторный вход в редактирование
             тем самым дается возможность не выпускать пользователя из режима редактирования
             пока он не исправит ошибки или вообще не будет сохранять данные
             Можно использовать для каких либо завершающих действий, в независимости
             от того, захотел ли пользователь сохранить данные или нет (например удаления
             проводок сформированных при добавлении документа и т.п.).
28.nTag     - номер тега, по которому проверяется уникальность индекса
29.nDispRow  - активная строка на экране (по умолчанию первая)

30.aHotKey   - Массив описания "ГОРЯЧИХ" клавиш
             { ;  // CTRL
               { 'F8:Удаление документа',;
                 { 'F8:Удаление документа', K_CTRL_F8, {||DelDoc}, 1 },;
                 { {|| IF( lTrue,'F8:Удаление документа', )}, ;
                                            K_CTRL_F8, {||DelDoc}, 2 },;
                 { '', 555, , 3 } ;
               },;
               {},;   // SHIFT
               {} ;   // ALT
             }
             Где:
                 (1) 'F8:Удаление документа' - Подсказка
                     {|| ... }               - блок кода возвращающий подсказку
                                               или NIL, если подсказка ненужна
                 (2) K_CTRL_F8               - Код горячей клавиши
                     555                     - Признак, что подсказку нужно
                                               дополнить '─────'
                 (3) {|| DelDoc }            - Блок кода выполняемы при нажатие
                                               клавиши, если он неуказан
                                               будет выполнен SetKey( )
                 (4) 1                       - Порядок для сортировки
                                               подсказок на экране

31.bRestSave - блок кода для восстановления и сохранения окружения GetList
               ему передается массив новых параметров или NIL, а он должен
               переопределить их и возвратить массив старых параметров

32. bPostRead  - Блок кода выполняемый после READ
    Ему передаются два параметра: lUpdate, nLastKey
    Должен вернуть: .T. / .F.
    Если .F. - Возврат в READ
    Если .T. - Пошли на запись
    Пример:
    { |lUpdate, nLastKey| IF( nLastKey == K_ESC, .T., !EMPTY( aIn[1] ) ) }

33.lSubIndex - .T. построение субиндекса при установке фильтра
               иначе ручного индекса (актуально только при фильтре и ручной сортировке)

34.[bSayHead] - Блок вывода заголовка по ключу bKeyHead, если не выводить
               то должен вернуть NIL, выполняется только при смене ключа.
               (длина стоки = длине строки BlockCols,;
                рисует начиная от nLeftBrd).
               Получает параметры текущего ключа, и предидущего.
               (PreFiltOrd()- имя тэга до установки фильтра)
35.[bKeyHead] - Блок ключа заголовка. ({|| UPPER(Grup)})
                Если не рисовать вернуть NIL.

<nSetGet> используется для прямого позиционирования по GetList
          (сбрасывается после обработки)
<lLoop>   используется для перезапука ReadModal() без выполнения чего либо
          (сбрасывается после обработки)


_bDelPostPost  -блок, выполняющийся удаления текущей записи








Информация по обработке в qInput :
─────────────────────────────────
В каждом obj - get объекте дополнительно в name хранится специальная информация
 obj:name хранится массив структуры :
   {
    <имя aIn[индекс_1,индекс_2] - строка символов     >,;
    <ссылка на массив спец.информации (см.ниже)       >,;
    <индекс_1 - число                                 >,;
    <индекс_2 - число                                 >,;
    <предыдущее значение (до выполнение bGetBlock )   >,;
    <технологический  массив информации
      для обмена oGet:reader <-> oGet:block на уровне
      расширителей Get системы                        >,;
    <пользовательский зарезервированный элемент       >,;
    <имя в aHeads>;
    }
 если aIn[i] одномерный, то индекс_2 равен 0
 <предыдущее значение> - обновляется после выполнения bGetBlock
                         присвоением aIn[i]

Массив спец. информации :
    {
     <aGetBlock - ссылка на массив block                      >,;
     <aValid - ссылка на массив post блоков                   >,;
     <aIn - ссылка на aIn                                     >,;
     <bRestSave - ссылка на блок кода восст.и сохр.окружения  >,;
     <EVAL(bRestSave)> - ссылка на массив информ.для восстан  >,;
     <GetList - ссылка на массив get объектов                 >,;
     <lLoop> - флаг повторного запуска ReadModal()            >,;
               без выполнения bPostGet,bPostRead, если .T.
     <nSetGet> - номер позиционирования в GetList             >;
     }

При выполнении aValid[i] или aGetBlock[i] (если указанный элемент блок кода !)
для соответсвующего элемента предварительно восстанавливается
оригинальная ссылка на aIn и другая информация, если указан bRestSave, а
по выходу восстановливается текущая.
Дополнительно для aIn[i] типа дата или число проводится проверка на
максимальное значение перед выполнением оригинальной проверки.

ДОПОЛНИТЕЛЬНО см. описание доп.параметров qInput


Дополнительные функции :
                     GetUpdateIn(a1,a2) возвращает .T. если массивы
                                        отличаются
                          SaveSeekPos() возвращает массив координат
                                        окна запроса поиска
                          GetSortSeek() возвращает текущий актуальный
                                        номер в aSortSeek
*/

#INCLUDE "inkey.ch"
#INCLUDE "s_refer.ch"
#INCLUDE "s_public.ch"
#INCLUDE "getexit.ch"
#INCLUDE "my.ch"

#DEFINE MAX_NUMBER 999999999999999

//#TRANSLATE NTOC(<x>) => ALLTRIM(STR(<x>,10,0))

#DEFINE TOP_TAG(x)  IF(;
                       ValType(x) = "C",;
                       x,;
                       IF(;
                           ORDNAME(1) == "MY_INDEX" .OR.;
                           ORDNAME(1) == "MY_FILTER",;
                           IF(ValType(x) = "N",x,1)+1,;
                           IF(ValType(x) = "N",x,IF(EMPTY(ORDNAME(1)),0,1));
                          );
                       )

#translate self() => qself()

#DEFINE SYM15 '════════════════'
#translate _ALT_HOT(   <x>, <y> ) => ;
               IF( aHotLine\[4\],( IF( aHotLine\[3\], ( AADD(aHotKey\[3\], {'',555,,100} ),aHotLine\[3\]:=.F.),),;
																 AADD(aHotKey\[3\], {<x>,0,,<y>} )),	)
#translate _CTRL_HOT(  <x>, <y>  ) =>;
               IF( aHotLine\[4\],( IF( aHotLine\[1\], ( AADD(aHotKey\[1\], {'',555,,100} ),aHotLine\[1\]:=.F.),),;
																 AADD(aHotKey\[1\], {<x>,0,,<y>} )),	)
#translate _SHIFT_HOT( <x>, <y>  ) =>;
               IF( aHotLine\[4\],( IF( aHotLine\[2\], ( AADD(aHotKey\[2\], {'',555,,100} ),aHotLine\[2\]:=.F.),),;
																 AADD(aHotKey\[2\], {<x>,0,,<y>} )),	)

#translate LEN_HEADS( <aHeads>) => (nLenHeads := 0,AEVAL(<aHeads>,{|x| nLenHeads += IF(LEN(x) \< 8 .OR. x\[8\] = NIL,1,x\[8\]) }),nLenHeads )

STATIC aSaveInit := {},nLenHeads
STATIC nTopi,nLefti,nBottomi,nRighti,sResti,sRest23
STATIC statCod,aArea,lWasApp:=.F.
STATIC bFindBlock, nPozSortSeek
STATIC sPre:={}, nStOrder
STATIC lMySort := .F.,bMySort, lMyRecurs := .F.
STATIC aNameArray := {}, lDisplay := .F.
STATIC lPlugGetBlock := .F.,lPlugValid := .F.
Static OnRefer := .T.
MEMVAR cFind

 FUNCTION InitList(;
 _nTop,_nBottom,cColHead,aBlockCol,cCurProc,aHeads,aRef,aPict,aWhen,aValid,;
 nUniMode,bDelInit,bScrInit,aSortSeek,aPrintHeads,bPost,bDelPost,;
 aGetBlock,bColor,bColor1,_nLeftBrd,bScrPost,cFindMacro,cCol_Browse,;
 lYesClear,bPreGet,bPostGet,nTag,nDispRow, aHotKey,bRestSave, bPostRead,;
 lSubIndex,bSayHead,bKeyHead,lSet1Tag,bDelPostPost)

LOCAL cTrap
PLOCAL _Buff := qInitPush()
PLOCAL _cLastColor:=SETCOLOR()
PLOCAL _nLeft,_nRight
PLOCAL _nTopF,_nBottomF,_nLeftF,_nRightF
PLOCAL _nTopS,_nBottomS,_nLeftS,_nRightS
PLOCAL _nLen:=IF(VALTYPE(cColHead)=='A',LEN(cColHead[1]),IF(ValType(cColHead) = "C",LEN(cColHead),cColHead))
PLOCAL nCo:=0,_cType,cCol_Heads
PLOCAL nMaxFiSize:=0,nMaxFiSizF:=0,nMaxFiSizS:=0,lenPict
PLOCAL bEdit :=SETKEY(K_RETURN)
PLOCAL bAdd  :=SETKEY(K_F4)
PLOCAL bFltr :=SETKEY(K_F6)
PLOCAL bCFltr :=SETKEY(K_CTRL_F6)
PLOCAL bAFltr :=SETKEY(K_ALT_F6)
PLOCAL bShFltr :=SETKEY(K_SH_F6)
PLOCAL bSort :=SETKEY(K_F3)
PLOCAL bSeek :=SETKEY(K_F7)
PLOCAL bLocate:=SETKEY(K_ALT_F7)
PLOCAL bDel  :=SETKEY(K_F8)
PLOCAL bPrint:=SETKEY(K_F9)
PLOCAL bA3Date:=SETKEY(297)
PLOCAL cFltr0:=DBFILTER()  //Глобальный фильтр (до входа в InitList)
PLOCAL cScopeMacro:=ScopeMacro()  //Глобальный Scope (до входа в InitList)
PLOCAL aHeadsI:={},aHeadsF:={},aHeadsS:={}
PLOCAL aRefI:={},aRefF:={}
PLOCAL aPictI:={},aPictF:={}
PLOCAL aWhenI:={},aWhenF:={}
PLOCAL aValidI:={},aValidF:={}
PLOCAL aGetBlockI:={},aGetBlockF:={}
PLOCAL aBlockCols:=ACLONE(aBlockCol), lenPict1
PLOCAL aRetKey := {},;
      aHotLine := { .T., .T., .T., .T. }
PLOCAL __bStPrint
PLOCAL bGetHead1Len:={|x|; //z0ne
                      If(ValType(x)=="B",x:=EVAL(x),) ,;
                      LEN(x);
                     }

RunPlugIns("РЕЕСТР","ВХОД",IF(GetScope() != NIL,GetScope()[2],NIL),aHeads,cColHead)

IF EMPTY(cFltr0)
  cFltr0:='.T.'
ENDIF

  // Сделаем массив горячих клавиш
  IF !( ValType( aHotKey ) $ 'AB' )
    aHotLine[1] := aHotLine[2] := aHotLine[3] := .F.
    aHotKey := { {}, {}, {} }
  ELSEIF ValType( aHotKey ) == 'B'
    aHotLine[4] := .F.
  ELSE
    AEVAL( aHotKey, {|x,xi|IF( ValType(x)<>'A', aHotKey[xi]:={}, ),;
                           IF( EMPTY(x), aHotLine[xi]:= .F., ) } )
  ENDIF

  _ALT_HOT( 'Z:Калькулятор', 120 )

  If GlobalTask != 'KP'
     _ALT_HOT( 'K:Блокнот',     121 )
     _ALT_HOT( 'V:Курсы валют', 122 )
  EndIf






  _CTRL_HOT( 'PageUp:На первую запись', 123 )
  _CTRL_HOT( 'PageDown:На последнюю запись',124 )


//  __HARBOUR__
  _ALT_HOT( 'X:Экспорт в Excel', 125 )






_nLeft:=INT(IF(_nLeftBrd==NIL, (80-_nLen)/2, _nLeftBrd))
_nLeft:=IF(_nLeft<=1,1,_nLeft)
_nRight:=_nLeft+_nLen-1

IF cCol_Browse!=NIL
   SETCOLOR(cCol_Browse)
   cCol_Heads:=cCol_Browse
ELSE
   SETCOLOR(COL_BROWSE)
   cCol_Heads:=COL_HEADS
ENDIF

IF (VALTYPE(cColHead)=='C')
   @ _nTop++,_nLeft SAY cColHead COLOR cCOL_HEADS
ELSEIF ValType(cColHead) = 'A'
   AEVAL(cColHead,{|x|DEVPOS(_nTop++,_nLeft),DEVOUT(x,cCOL_HEADS)})
ENDIF
AEVAL(aBlockCols,{|x|aBlockCols[++nCo,2]:=x[2]+_nLeft})  //Пересчет aBlockCols

IF (aHeads != NIL)

   //Определение координат поля ввода
   FOR nCo=1 TO LEN(aHeads)

   lenPict := IF((lenPict := IF(aPict==NIL .OR. LEN(aPict)<nCo .OR. aPict[nCo]==NIL,0,LEN(TRANSFORM(SPACE(100),aPict[nCo])))) = 100,0,lenPict)

   _cType:=IF(EMPTY(aHeads[nCo,2]),'C',(FiAlias(aHeads[nCo,2]))->(FIELDTYPE(FiNum(aHeads[nCo,2]))))

   // справочное поле со скрытым кодом !!!!!!!!
   _cType := IF(_cType != "N" .OR. aRef = NIL .OR. LEN(aRef) < nCo .OR. EMPTY(aRef[nCo]),_cType,"C")

   IF LEN(aHeads[nCo])<3.OR.aHeads[nCo,3]='1'.OR.aHeads[nCo,3]=NIL
      AADD(aHeadsI,{aHeads[nCo,1],aHeads[nCo,2],,,,,,IF(LEN(aHeads[nCo]) >= 8,aHeads[nCo,8],1)})
      IF aRef!=NIL.AND.LEN(aRef)>=nCo
         AADD(aRefI,aRef[nCo])
      ENDIF
      IF aPict!=NIL.AND.LEN(aPict)>=nCo
         AADD(aPictI,aPict[nCo])
      ENDIF
      IF aWhen!=NIL.AND.LEN(aWhen)>=nCo
         AADD(aWhenI,aWhen[nCo])
      ENDIF
      IF aValid!=NIL.AND.LEN(aValid)>=nCo
         AADD(aValidI,aValid[nCo])
      ENDIF
      IF aGetBlock!=NIL.AND.LEN(aGetBlock)>=nCo
         AADD(aGetBlockI,aGetBlock[nCo])
      ENDIF
      nMaxFiSize:=MAX(nMaxFiSize,IF(lenPict==0.AND.!EMPTY(aHeads[nCo,2]),;
      (FiAlias(aHeads[nCo,2]))->(FIELDSIZE(FiNum(aHeads[nCo,2]))),lenPict))
   ENDIF

   IF LEN(aHeads[nCo])<4.OR.aHeads[nCo,4]>='1'
      AADD(aHeadsF,aHeads[nCo])
      IF aRef!=NIL.AND.LEN(aRef)>=nCo
         AADD(aRefF,aRef[nCo])
      ENDIF
      IF aPict!=NIL.AND.LEN(aPict)>=nCo
         AADD(aPictF,aPict[nCo])
      ENDIF
      IF aWhen!=NIL.AND.LEN(aWhen)>=nCo
         AADD(aWhenF,aWhen[nCo])
      ENDIF
      IF aValid!=NIL.AND.LEN(aValid)>=nCo
         AADD(aValidF,aValid[nCo])
      ENDIF
      IF aGetBlock!=NIL.AND.LEN(aGetBlock)>=nCo
         AADD(aGetBlockF,aGetBlock[nCo])
      ENDIF
      nMaxFiSizF:=MAX(nMaxFiSizF,IF(_cType=='N'.OR._cType=='D',2,1)*;
      IF(lenPict==0.AND.!EMPTY(aHeads[nCo,2]),;
      (FiAlias(aHeads[nCo,2]))->(FIELDSIZE(FiNum(aHeads[nCo,2]))),lenPict)+;
      IF(_cType=='N'.OR._cType=='D',3,0))
   ENDIF

   IF _cType='N'.AND.(LEN(aHeads[nCo])<5.OR.aHeads[nCo,5]='1')
      AADD(aHeadsS,{aHeads[nCo,1],aHeads[nCo,2],IF(LEN(aHeads[nCo]) >= 7,aHeads[nCo,7],NIL),,,,,IF(LEN(aHeads[nCo]) >= 8,aHeads[nCo,8],1)})
      nMaxFiSizS:=20
   ENDIF

   NEXT

   // Изменение 3.110
   IF LEN(aHeadsI)>0
      nTopi:= IF(_nBottom-LEN_HEADS(aHeadsI)-2 < 0,0,_nBottom-LEN_HEADS(aHeadsI)-2)
      nLefti:=(MAXCOL()-EVAL(bGetHead1Len,aHeadsI[1,1])-nMaxFiSize-4)/2 //z0ne
      nBottomi:= nTopi+LEN_HEADS(aHeadsI)+1
      nRighti := nLefti+EVAL(bGetHead1Len,aHeadsI[1,1])+nMaxFiSize+3
      IF(nBottomi < MaxRow() .AND. nTopi = 0,(nTopi += 1,nBottomi += 1),NIL)
      IF(nBottomi < MaxRow() .AND. nTopi = 1,(nTopi += 1,nBottomi += 1),NIL)
      sResti:= BrSaveScreen(nTopi,0,nBottomi+1,MAXCOL(),sResti)
   ENDIF

   IF bEdit==NIL.AND.LEN(aHeadsI)>0
      SETKEY(K_RETURN,;
      {||QInput(nTopi,nLefti,nBottomi,nRighti,aHeadsI,;
      1,aRefI,aPictI,aWhenI,aValidI,nUniMode,bScrInit,;
      bPost,cFltr0,,aGetBlockI,bScrPost,,bPreGet,bPostGet,;
      nTag,,,,,bRestSave,bPostRead,,bSayHead,bKeyHead)})
   ENDIF

   IF bAdd==NIL.AND.LEN(aHeadsI)>0
      SETKEY(K_F4,;
      {||QInput(nTopi,nLefti,nBottomi,nRighti,aHeadsI,2,aRefI,aPictI,aWhenI,aValidI,;
      nUniMode,bScrInit,bPost,cFltr0,,aGetBlockI,bScrPost,,bPreGet,bPostGet,;
      nTag,,,,,bRestSave,bPostRead,,bSayHead,bKeyHead)})
   ENDIF

   IF bFltr==NIL.AND.LEN(aHeadsF)>0
      _nTopF:= IF(_nBottom-LEN_HEADS(aHeadsF)-2 < 0,0,_nBottom-LEN_HEADS(aHeadsF)-2)
      _nLeftF:=(MAXCOL()-EVAL(bGetHead1Len,aHeadsF[1,1])-nMaxFiSizF-4)/2
      _nBottomF:=_nTopF+LEN_HEADS(aHeadsF)+1
      _nRightF := _nLeftF+EVAL(bGetHead1Len,aHeadsF[1,1])+nMaxFiSizF+3
      sResti:= BrSaveScreen(_nTopF,0,_nBottomF+1,MAXCOL(),sResti)
      IF(_nBottomF < MaxRow() .AND. _nTopF = 0,(_nTopF += 1,_nBottomF += 1),NIL)
      IF(_nBottomF < MaxRow() .AND. _nTopF = 1,(_nTopF += 1,_nBottomF += 1),NIL)
      SETKEY(K_F6,;
      {||QInput(_nTopF,_nLeftF,_nBottomF,_nRightF,aHeadsF,0,aRefF,aPictF,aWhenF,aValidF,;
      nUniMode,bScrInit,bPost,cFltr0,,aGetBlockF,bScrPost,cScopeMacro,bPreGet,bPostGet,;
      nTag,,,,,bRestSave,bPostRead,lSubIndex,bSayHead,bKeyHead)})
      SETKEY(K_CTRL_F6,{||QSetFilter(aHeads,,"Снять")})
			_CTRL_HOT( 'F6:Снять фильтр', 106 )
   ENDIF

   IF bShFltr==NIL.AND.LEN(aHeadsS)>0
      _nTopS:= IF(_nBottom-LEN_HEADS(aHeadsS)-2 < 0,0,_nBottom-LEN_HEADS(aHeadsS)-2)
      _nTopS:=_nBottom-LEN_HEADS(aHeadsS)-2
      _nLeftS:=(MAXCOL()-EVAL(bGetHead1Len,aHeadsS[1,1])-nMaxFiSizS-4)/2
      _nBottomS:=_nTopS+LEN_HEADS(aHeadsS)+1
      _nRightS := _nLeftS+EVAL(bGetHead1Len,aHeadsS[1,1])+nMaxFiSizS+3
      sResti:= BrSaveScreen(_nTopS,0,_nBottomS+1,MAXCOL(),sResti)
      IF(_nBottomS < MaxRow() .AND. _nTopS = 0,(_nTopS += 1,_nBottomS += 1),NIL)
      IF(_nBottomS < MaxRow() .AND. _nTopS = 1,(_nTopS += 1,_nBottomS += 1),NIL)
      SETKEY(K_SH_F6,;
      {||QInput(_nTopS,_nLeftS,_nBottomS,_nRightS,aHeadsS,-1,,,,,,bScrInit,,cFltr0)})
			_SHIFT_HOT('F6:Суммирование', 106)
   ENDIF
ENDIF

IF cFindMacro!=NIL
   PRIVATE cFind:=SPACE(30)
   IF bLocate=NIL
      IniString(cFindMacro,cFltr0)
      SETKEY(K_ALT_F7,{||FindName()})
			_ALT_HOT('F7:Контекстный поиск', 107 )
   ENDIF
   IF bAFltr=NIL
      SETKEY(K_ALT_F6,{||FiltName(cFindMacro,cFltr0,cScopeMacro,,,,lSubIndex)})
			_ALT_HOT(IF(IsMsNT(),'F6','F12')+':Контекстный фильтр', 106 )
      SETKEY(K_ALT_F12,{||FiltName(cFindMacro,cFltr0,cScopeMacro,,,,lSubIndex)})
      SETKEY(K_CTRL_F6,{||QSetFilter(aHeads,,"Снять")})
   ENDIF
ENDIF
lSet1Tag := if(lSet1Tag == NIL,.T.,lSet1Tag)
ViewSortSeek(aSortSeek,lSet1Tag,{||QSeek(aSortSeek,,,,.T.)},{||QSort(aSortSeek,,,,.T.)})

IF (bDel==NIL)
   bDel:=SETKEY(K_F8,{||QDel(bDelInit,bDelPost,nTag,,bDelPostPost)})
ENDIF

IF (aPrintHeads!=NIL .AND. bPrint==NIL)
   SETKEY(K_F9,{||QPrint(aPrintHeads,,,bSayHead,bKeyHead)})
ENDIF

//Lexx
SETKEY(297,{||A3DateView()})
//SETKEY(-41,{||QIni(,2)}) //F12 - теперь будет для печати исп-ся

IF IsRunPlugIns("РЕЕСТР","ПЕЧАТЬ")
  __bStPrint := SetKey(K_F9,{|| RunPlugIns("РЕЕСТР","ПЕЧАТЬ",__bStPrint) })
ENDIF

WHILE .T.
  QBrowse(_nTop,_nLeft,_nBottom,_nRight,aBlockCols,,cCurProc,bColor,lYesClear,bColor1,nDispRow,aHotKey,@aRetKey,bSayHead,bKeyHead)

  IF aRetKey != NIL
    cTrap:=TRAPSHIFT("")
    aRetKey[1] := EVAL(aRetKey[3],ProcName(1), ProcLine(1), "")
    TRAPSHIFT(cTrap)
  ELSE
    EXIT
  ENDIF
ENDDO
COMMIT
QSetFilter(aHeads,,"Снять",,"End")

RunPlugIns("РЕЕСТР","ВЫХОД")

SETKEY(K_RETURN,bEdit)
SETKEY(K_F4,bAdd)
SETKEY(K_F6,bFltr)
SETKEY(K_CTRL_F6,bCFltr)
SETKEY(K_ALT_F6,bAFltr)
SETKEY(K_SH_F6,bShFltr)
SETKEY(K_F8,bDel)
SETKEY(K_F3,bSort)
SETKEY(K_F7,bSeek)
SETKEY(K_ALT_F7,bLocate)
SETKEY(K_F9,bPrint)
SETKEY(297,bA3Date)
SETCOLOR(_cLastColor)
qInitPop()
RETURN (NIL)



#IFNDEF PPARAMETERS
  FUNCTION QInput(;
       nTop,nLeft,nBottom,nRight,aHeads,;
       nAppp,aRef,aPict,aWhen,aValid,nUnique,bScrInit,bPost,cFltr0,lSpec,;
       aGetBlock,bScrPost,cScope,bPreGet,bPostGet,nTag,lNoAppend,lNoRestScreen,;
       lGetBlock,cMessSave,bRestSave,bPostRead,lSubIndex,bSayHead,bKeyHead;
                 )
#ELSE
  FUNCTION QInput
  PARAMETERS;
       nTop,nLeft,nBottom,nRight,aHeads,;
       nAppp,aRef,aPict,aWhen,aValid,nUnique,bScrInit,bPost,cFltr0,lSpec,;
       aGetBlock,bScrPost,cScope,bPreGet,bPostGet,nTag,lNoAppend,lNoRestScreen,;
       lGetBlock,cMessSave,bRestSave,bPostRead,lSubIndex,bSayHead,bKeyHead
#ENDIF
//lSpec должен присутствовать при входе не через InitList()
//lSpec='REFER'-вход из Refer:цвет,нет цикла,нет поддержки скроллинга,специфические When,Valid
//lSpec='RESTOFF'-вход из ProBase:все как в штатном режиме,но без восст.области
//Если EVAL(bScrInit)->0,то редактирования не происходит вообще
//  lNoAppend - .T., то добавление записи при любом nApp не происходит
//             предпологается, что добавление и откат производится
//             в bPreGet и bPostGet
//             также происходит сохранение полей даже если не было коррекции
//  lGetBlock - .T. в фильтре на поле интервал aGetBlock вешается
//             на два oGet и ему передается значение,oGet и nPoz ({|x,oGet,nPoz| })
//             где nPoz 1-ый или 2-ой эл-т интервала
/// lNoRestScren - .T., то восстановление пред. состояния экрана
//                 в любом случае не происходит, предполагается
//                 что восстановление либо не требуется, либо
//                 выполняется в bPostDisp или bScrPost
//  cMessSave - запрос о записи документа
//  lSubIndex - .T. построение субиндекса при установке фильтра
//               иначе ручного индекса



PLOCAL currFilter:=DBFILTER()
PLOCAL lFound:=.F.,aScope:=GetScope()
PLOCAL lMore := .t.,lBlock,cStri,lYes:=.T.
PLOCAL _cLastColor:=SETCOLOR()
PLOCAL _cColor:=IF(lSpec!=NIL .AND. lSpec=="REFER" ,COL_REF1,COL_INPUT)
PLOCAL nFi,nCo,lUpDated
PLOCAL sRest:=BrSaveScreen(IF(nAppp = -1,0,24),0,24,MAXCOL())
PLOCAL aPos:={},xIndexKey
PLOCAL nOrd
PLOCAL cIndexKey
PLOCAL nRecNo:=RECNO(),lEof:=.F.
PLOCAL nRow0:=ROW()
PLOCAL nScroll:=IF(lSpec==NIL .OR. lSpec=='RESTOFF',nTop-1,NIL)
PLOCAL lRefer:=IF(lSpec!=NIL .AND. lSpec=="REFER" ,.T.,.F.)
PLOCAL aBlockKey,x,cLastCol, sRet, lReadExit, nLastKey
PLOCAL sRestii:=sResti ,nScrInit:=1
PLOCAL sRestS, lSaveFlagArray := .F., lSkipApp := .F., xExit
PLOCAL nWi:=WSELECT(),cAli,nWin1
PLOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()}), lExit
PLOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2]), _nMore
PLOCAL nBakRec, xRest23, nPozGet, nPoz
PLOCAL aSave
PLOCAL lbSayHead:= ValType(bSayHead)=="B".AND.ValType(bKeyHead)=="B" //New
PLOCAL __bStPrint

PRIVATE V_LSPEC := lSpec // Вася 10 декабря. Это для того, чтобы в складе когда делается рефер на MLABEL я видел,
      //что картинка для QINPUT должна быть черного цвета. Этот параметр здесь нигде больше не используется
		       // но удалять его не нужно.

// Вася 17 января 2005 - для экспорта в инитлист.

PRIVATE lNoInt:=.F. // - это для импорта строк в инитлист. Эта переменная определена всегда.

If TYPE("lNoInteractiv")$"L"
  If ValType(lNoInteractiv)=="L"
	lNoInt := lNoInteractiv
  ENDIF
ENDIF


IF (aHeads==NIL)  //М.б. вызов из S_Refer c пустым aHeads
   RETURN (1)
ENDIF
IF (EOF().OR.BOF().OR.LastRec()=0)
   IF (nAppp<2)
      RETURN (1)
   ELSE
      lEof:=.T.
   ENDIF
ENDIF

aBlockKey:=SaveKey()

IF( VALTYPE( bPreGet  ) <> 'B', bPreGet := {||NIL}, )
IF( VALTYPE( bPostGet ) <> 'B', bPostGet:= {||NIL}, )
IF( VALTYPE( lNoAppend ) <> 'L', lNoAppend := .F., )
IF( VALTYPE( lGetBlock ) <> 'L', lGetBlock := .F., )
IF( VALTYPE( lNoRestScreen ) <> 'L', lNoRestScreen := .F., )
IF( ValType( bPostRead ) == 'B',, bPostRead := {|| .T. } )

PRIVATE aIn := ARRAY(LEN(aHeads)),GetList:={}
PRIVATE aLastIn:=ARRAY(LEN(aHeads)),nApp:=nAppp
IF nApp = 0
  PRIVATE aFilIn
  MemVar->aFilIn := ARRAY(LEN(aHeads))
ENDIF
IF (VALTYPE(aHeads[1,1])=='A' )
   nTopi:=0;nLefti:=0;nBottomi:=MAXROW()-3;nRighti:=MAXCOL()
   sResti:= BrSaveScreen(nTopi,0,nBottomi+1,MAXCOL(),sResti)
ENDIF
xRest23 := IF(nApp = 0,BrSaveScreen(23,0,23,MAXCOL()),NIL)
IF nApp=-1
   nApp:=0
ENDIF
IF (bScrInit!=NIL)  //Индивидуальная картинка
   nScrInit:=EVAL(bScrInit,nAppp)
   nScrInit:=IF(lbSayHead.and.(ValType(nScrInit)=="N".and.nScrInit#0),2,nScrInit)
   IF nScrInit=NIL.OR.VALTYPE(nScrInit)!='N'
      IF (VALTYPE(aHeads[1,1])=='A' )
         nScrInit:=3
      ELSE
         nScrInit:=1
      ENDIF
   ELSEIF VALTYPE(nScrInit)='N'
      IF nScrInit=0
         SETCOLOR(_cLastColor)
         RestKey(aBlockKey)
         RETURN (1)
      ELSEIF nScrInit==2.AND.VALTYPE(aHeads[1,1])=='A'
         nScroll := qScroll()[3] // ИЗВЛЕЧЕМ ИЗ QBROWSE
      ENDIF
   ENDIF
ENDIF
nApp:=nAppp

// Выход по K_F10
IF(EMPTY(SetKey(K_F10)),SetKey(K_F10,{|oGet,nGet| oGet := GetActive(),;
                                             oGet := IIF(ValType(oGet) = "O",oGet,;
                                                   ( nGet := CurrentGet(), IIF(nGet > 0.AND.nGet <= LEN(GetList), GetList[nGet], Nil)) ),;
                                             IF(ValType(oGet) = "O" .AND. oGet:hasFocus,;
                                                        (IF(oGet:changed .AND. (ValType(oGet:name) != "A" .OR. LEN(oGet:name) < 5 .OR. IF(ValType(aIn[oGet:name[3]])=="A",&(oGet:name[1]),aIn[oGet:name[3]]) != oGet:name[5]),oGet:assign(),NIL), IF(!(ValType(oGet:PostBlock)=="B".AND.!EVAL(oGet:PostBlock)), ReadKill(.T.), NIL)),NIL) }),NIL)

IF (nApp > 0 .AND.VALTYPE(aHeads[1,1])!='A'.AND.;
   nRow0 >= nTop .AND. nRow0<=nBottom).AND.nScrInit<3
   Qini(nScroll,2)
ENDIF

// Сброс фильтра или сортировки
IF nApp = 2
  MyCloseFilter()
ENDIF
cIndexKey:=ORDKEY()

IF (VALTYPE(aHeads[1,1])!='A' .AND. (nScrInit=1.OR.nScrInit=4))
   IF (lSpec==NIL)
      IF !lNoRestScreen
        BrRestScreen(sResti)
      ENDIF
   ELSE
      nTopi:=nTop;nLefti:=nLeft;nBottomi:=nBottom;nRighti:=nRight
      sResti:= BrSaveScreen(nTopi,0,nBottomi+1,MAXCOL(),sResti)
      IF (lSpec=='RESTOFF')
         SETCOLOR(COL_BROWSE)
         @ nTopi,1 CLEAR TO nBottomi+1,MAXCOL()-1
         SETCOLOR(COL_INPUT)
      ENDIF
   ENDIF
   DO CASE
      CASE nApp==-1
      cStri:=' Расчет сумм '
      CASE nApp==0
      cStri:=' Условие фильтра '
      CASE nApp==1
      cStri:=' Корректировка '
      CASE nApp==2
      cStri:=' Новая запись '
   ENDCASE
   IF !lNoInt
       ShadowBox(cStri,nTop,nLeft,nBottom,nRight,_cColor)
   ENDIF
ENDIF

nOrd:=ORDNUMBER()

//SETCOLOR(_cColor)
nCo:=nTop
IF (VALTYPE(aHeads[1,1])=='A')
   AEVAL(aHeads,{|x|AADD(aPos,{x[1][1],x[1][2]})})
ELSE
   SETCOLOR(_cColor)
 	 nCo++
   IF !lNoInt  // Есть интерактив!
     AEVAL(aHeads,;
           {|x,y|;
            DEVPOS(nCo,nLeft+2),;
            ;//z0ne
            y:=If(ValType(x[1])=="B",EVAL(x[1]),x[1]) ,;
            IIF(LEN(x) >= 8 .AND. x[8]!=Nil.AND.x[8]==0,,DEVOUT(y)),;     // Вася 7 декабря 2004 было DEVOUT(y)
            AADD(aPos,{nCo,nLeft+LEN(y)+2}),;
            nCo += IF(LEN(x) < 8 .OR. x[8] = NIL,1,x[8]);
           })
   ELSE // Нет интерактива! для импорта
     AEVAL(aHeads,;
           {|x,y|;
            y:=If(ValType(x[1])=="B",EVAL(x[1]),x[1]) ,;
            AADD(aPos,{nCo,nLeft+LEN(y)+2}),;
            nCo += IF(LEN(x) < 8 .OR. x[8] = NIL,1,x[8]);
           })
   ENDIF // !lNoInt
   SETCOLOR(_cLastColor)
ENDIF

aNameArray := {}
IF (nApp==2)
   AEVAL(aIn,{|x,nCo|aIn[nCo]:= IIF(lNoInt,RetValue_ForImport(nCo),RetValue(aHeads[nCo,2]))})
ENDIF
WHILE lMore

IF lNoInt
	lMore := .F.
ENDIF

   IF (nApp<2)
      aNameArray := {}
      nCo:=0
      AEVAL(aIn,{|x,nCo|aIn[nCo]:= IIF(lNoInt,RetValue_ForImport(nCo),RetValue(aHeads[nCo,2]))})
   ENDIF
   IF (nApp<=0)
      FOR nCo:=1 TO LEN(aIn)
      IF !EMPTY(aHeads[nCo,2])
         nFi:=FiNum(aHeads[nCo,2])
         cAli:=FiAlias(aHeads[nCo,2])
         IF (cAli)->(TYPE(aHeads[nCo,2]))=='N' .AND. IF(ValType(aRef) = "A" .AND. LEN(aRef) >= nCo,EMPTY(aRef[nCo]),.T.)
            x:=VAL(STR(0,(cAli)->(FIELDSIZE(nFi)),(cAli)->(FIELDDECI(nFi))))
            IF nApp==0
               aIn[nCo]:=aLastIn[nCo]:={x,x}
            ELSE
               aIn[nCo]:=aLastIn[nCo]:=x
            ENDIF
         ELSEIF (cAli)->(FIELDTYPE(nFi))=='C'
            aIn[nCo]:=SPACE(MAX(IF(LEN(aPict)>=nCo.AND.VALTYPE(aPict[nCo])='C',;
                                   IF(LEFT(aPict[nCo],1)='@'.AND.AT(' ',aPict[nCo])#0,;
                                      LEN(SUBSTR(aPict[nCo],AT(' ',aPict[nCo])+1)),;
                                      LEN(aPict[nCo])),;
                                   0),;
                                (cAli)->(FIELDSIZE(nFi))))
         ELSEIF (cAli)->(TYPE(aHeads[nCo,2]))=='D'
            x:=CTOD('  /  /  ')
            IF nApp==0
               aIn[nCo]:=aLastIn[nCo]:={x,x}
            ENDIF
         ELSEIF (cAli)->(FIELDTYPE(nFi))=='L'
            aLastIn[nCo]:=aIn[nCo]
            aIn[nCo]:=' ' //Подставка для фильтра
         ELSE
            aIn[nCo]:=aLastIn[nCo]:=BLANK(aIn[nCo],.T.)
         ENDIF
      ENDIF
      NEXT
   ENDIF

   IF (LEN(cIndexKey) > 0)
      xIndexKey:=&(cIndexKey)
   ENDIF
   nRecNo:=RECNO()
   lWasApp:=.F.  //Признак добавления записи с увеличенным номером (QHelp())
   IF (nApp==0)
      ScrTitul(24,'Пустое поле:безразличный фактор <+>:Поле не пусто <->:Поле пусто')
      SETKEY(K_CTRL_F6,{||Keyb(K_CTRL_W)})
   ENDIF

   cLastCol := SETCOLOR(IF(lSpec!=NIL.AND.lSpec=="REFER",COL_REF1,COL_GET))
   lUpdated:=.F.
   lReadExit:=READEXIT(.F.)
   sRet:=SETKEY(K_RETURN,NIL)

   IF EMPTY(GetList)
     MyInputFrame(aPos,aRef,aGetBlock,aPict,aWhen,aValid,aHeads,lSpec,bPreGet,lGetBlock,bRestSave,@aSave)
   ENDIF

   lExit := .F.

   IF nApp >= 0
     EVAL(bPreGet,@lExit,aHeads,@lFound)
     IF nApp>0
       aLastIn := AClone(aIn)
     ENDIF
     lFound :=.F.
   ENDIF

   RunPlugIns("ДОКУМЕНТ","ВХОД",nApp,@lExit)

   IF ValType(lExit) = "L" .AND. lExit
     EXIT
   ENDIF

   IF IsRunPlugIns("ДОКУМЕНТ","ПЕЧАТЬ")
     __bStPrint := SetKey(K_F9,{|| RunPlugIns("ДОКУМЕНТ","ПЕЧАТЬ",__bStPrint) })
   ENDIF

   //altD()
   DO WHILE .T.
      IF nApp >= 0
        lDisplay := .T.
        IF EMPTY(aSave[7])
          // Начальная инициализация
          AEVAL(GetList, {|oGet| IF(ValType(oGet:name) = "A",oGet:name[5] := IF(oGet:name[4] = 0,aIn[oGet:name[3]],aIn[oGet:name[3],oGet:name[4]]),NIL) })
          IF !lNoInt // для импорта! 18 января 2005 Вася
            AEVAL(GetList, {|oGet| oGet:Display() })
          ENDIF //!lNoInt
          lDisplay := .F.
        ENDIF
        nPozGet := aSave[8]
        aSave[8] := aSave[7] := NIL
        IF nPozGet != NIL
          nPoz := nPozGet-1
          IF ASCAN(GetList,{|oGet| nPoz++,(oGet:preBlock=NIL.OR. EVAL(oGet:preBlock, @oGet)).AND.(nPozGet := nPoz,.T.) },nPozGet) = 0
            nPoz := 0
            IF ASCAN(GetList,{|oGet| nPoz++,oGet := GetList[nPozGet-nPoz+1],EVAL(oGet:preBlock, @oGet).AND.(nPozGet := nPozGet-nPoz+1,.T.) },1,nPozGet) = 0
              nPozGet := NIL
            ENDIF
          ENDIF
        ENDIF
        IF lNoInt // для импорта! 18 января 2005 Вася
	      EmulateRead(GetList,aRef)
        ELSE
              SETCURSOR(1);  ReadModal(GetList,nPozGet) ;   SETCURSOR(0)
        ENDIF
        IF !EMPTY(aSave[7])
          LOOP
        ENDIF
        If (nApp>0)
         lUpdated := IIF(lNoInt,.T.,GetUpdateIn(aIn,aLastIn) ) //и это тоже для импорта - 18 января 2005 Вася
        EndIf
      EndIf
      //altD()
      nLastKey := LastKey()
      IF lUpdated .and. nLastKey = K_ESC .and.; // И здесь я тоже поменял
			(lNoInt.OR.(!lNoInt.AND.; // 18 января 2005
         IF(cMessSave = NIL,YesOrNo({" Сохранить изменения? " },.T.,,,14,,COL_REFER),YesOrNo(cMessSave,.T.,' Да ',' Нет ',10)) ))
        SetLastKey(K_F10)
      ELSE
        SetLastKey(nLastKey)
      ENDIF


   // Выпустим, только при выполнение
   IF EVAL( bPostRead, lUpdated, LastKey())
     EXIT
   ELSE // Если это не выполнено
       IF lNoInt // и нет интерактива (то есть когда есть импорт)
                // то надо какой-то след оставить что, дескать, все приехали!
               SayError("Ошибка при вводе данных!")
		EXIT
       ENDIF
   ENDIF

   IF IsRunPlugIns("ДОКУМЕНТ","ВЫХОД_ПЕРЕД_СОХРАНЕНИЕМ") .AND.  RunPlugIns("ДОКУМЕНТ","ВЫХОД_ПЕРЕД_СОХРАНЕНИЕМ",nApp,lUpdated,Lastkey())
     EXIT
   ELSE // Если это не выполнено
       IF lNoInt // и нет интерактива (то есть когда есть импорт)
                // то надо какой-то след оставить что, дескать, все приехали!
               SayError("Ошибка при вводе данных! (plugins)")
		EXIT
       ENDIF
   ENDIF

   ENDDO

   SETKEY(K_RETURN,sRet)

   SETCOLOR(cLastCol)
   READEXIT(lReadExit)

   statCod:=.T.
   lSaveFlagArray := .F.
   IF (LASTKEY()==K_ESC .OR. nApp<=0)
      SETKEY(K_ESC,NIL)
      lMore := .F.
      IF (lWasApp)
         xDELETE();lWasApp:=.F.;GO nRecNo
      ENDIF
      IF nApp==-1
         sRestS := BrSaveScreen()
         ScrTitul(24,'Esc:Прервать' )
         nWin1:=NoOrYes( {'','Суммирование [ ]',''},,,10,35,COL_REFER )
         lYes := INDIK_NEW(13,53)
         nCo:=x:=0
         GO nRecNo

         GO TOP

         AEVAL(aHeads,{|y| ASIZE(y,MAX(LEN(y),3)),IF(ValType(y[3]) != "B",y[3] := &("{||"+y[2]+"}"),NIL) })

         WHILE !EOF()
            x++;nCo++
            IF  nCo=10.AND.(nCo:=0)=0
               INDIK_UPDATE(lYes)
            ENDIF
            AEVAL(aHeads,{|y,j| aIn[j] += EVAL(y[3]) })
            IF INKEY()=K_ESC
               EXIT
            ENDIF
            SKIP
         ENDDO
         GO nRecNo
         INDIK_END(lYes)
         BrRestScreeen(sRestS)
         IF LASTKEY()!=K_ESC
            FOR nCo:=1 TO LEN(aIn)
            @ aPos[nCo,1],aPos[nCo,2] SAY aIn[nCo] PICTURE SummaPic(3,19) COLOR COL_HEADR
            NEXT
            ScrTitul(24,'Итого записей : '+;
            ALLTRIM(STR(x))+'. Для продолжения нажмите любую клавишу...')
            INKEY(0)
         ENDIF
         SETLASTKEY(K_ESC)
         WSELECT(nWin1)
         WCLOSE()
         WSELECT(nWi)
      ENDIF
      EVAL(bPostGet,lSaveFlagArray,lUpdated)   // Пеpедает блоку кода флаг выполнения bPost и флаг изменения
      LOOP
   ELSEIF (nApp==2 .OR. (nApp==1 .AND. lUpDated))

      IF (nUnique != NIL .AND. nUnique > 0)
         SET FILTER TO
         SetScope()
         ORDSETFOCUS(TOP_TAG(nTag))
         nBakRec:=RECNO()
         lFound:=DBSEEK(&(FiIn(INDEXKEY(),aHeads)))
         SetScope(aScope)
         IF !EMPTY(currFilter)
           dbSetFilter(&("{||"+currFilter+"}"),currFilter)
         ENDIF
         ORDSETFOCUS(nOrd)
         IF ((nApp==2.AND.lFound.AND.!(RECNO()=nBakRec.AND.lWasApp)) .OR.;
          (lFound .AND. nApp==1 .AND. RECNO()!=nBakRec))
            GO nBakRec
            IF (lWasApp)
               xDELETE();lWasApp:=.F.;GO nRecNo
            ENDIF
            IF (nUnique == 1 .AND. !YesOrNo(' Запись с таким ключом уже введена ',.F.,' Ввод ',' Отмена ',10) )
            ELSE
               SayError(' Запись с таким ключом уже введена ')
            ENDIF
            // Изменение 3.120
            EVAL(bPostGet,lSaveFlagArray,lUpdated)   // Пеpедает блоку кода флаг выполнения bPost и флаг изменения
            lFound := .T.
            LOOP
         ELSE
            GO nBakRec
            lFound := .F.
         ENDIF
      ENDIF
      IF (!lRefer .AND.nApp==2 .AND.  !( LastKey() = K_F10 .or. IIF(lNoInt, EMPTY(__HiddenError) ,YesOrNo(' Ввести новую '+;
      'запись? ',.T.,' Ввод ',' Отмена ',10))))
		// Вася - 18 января 2005 - внес изменения с HiddenError
         statCod:=NIL
         IF (lWasApp)
            xDELETE();lWasApp:=.F.;GO nRecNo
         ENDIF
         EVAL(bPostGet,lSaveFlagArray,lUpdated)
         LOOP
      ENDIF
   ENDIF
   IF ((lBlock:=IF(nApp==2.AND.!lWasApp .AND.!lNoAppend,AddRec(),RecLock())) .AND.;
       ((nApp==1 .AND. (lUpdated .OR. lNoAppend)) .OR. nApp==2))

	// qSave надо делать аккуратно! Вася 18 января 2005.
      IF !lNoInt.OR.(lNoInt.AND.EMPTY(__HiddenError))
         qSave( aHeads, @bPost ) // Это когда все по человечески и нет никакого импорта - то все просто так.
				// а если есть импорт - то сохранение только в случае пустого HiddenError
      ENDIF

      RunPlugIns("ДОКУМЕНТ","ВЫХОД_ПОСЛЕ_СОХРАНЕНИЯ",nApp)

      lSaveFlagArray := .T.
      //SETCOLOR(_cLastColor)
      IF (!lRefer .AND. VALTYPE(aHeads[1,1])!='A'.AND.nScrInit!=4).OR.nScrInit=2
         IF (LEN(cIndexKey) > 0)
            IF (nApp>=2.OR.xIndexKey != &(cIndexKey))
               QIni(nScroll,2)  //nMode=2 - Обновить все строки
            ELSEIF (LASTKEY()!=K_PGDN .AND. LASTKEY()!=K_PGUP)
               QIni(nScroll,IF(lbSayHead,2,3)) // nMode=3 - Обновить одну строку
            ENDIF
         ELSEIF (LASTKEY()!=K_PGDN .AND. LASTKEY()!=K_PGUP)
            QIni(nScroll,IF(lbSayHead,2,3))
         ENDIF
      ELSEIF (lRefer)
         lMore:=.F.
      ENDIF
      //SETCOLOR(_cColor)
   ELSEIF !lBlock
      Error_Lock()
      lMore := .f.
   ENDIF
   UNLOCK ALL
   _nMore := 1
   IF (xExit := EVAL(bPostGet,lSaveFlagArray,lUpdated,@_nMore),ValType(xExit) = "L") .and. !xExit
      IF nApp = 2  // т.к. в повторный запуск редактирования запись уже создана
        lSkipApp := .T.
        nApp := 1
      ENDIF
      LOOP
   ELSEIF lSkipApp   // восстановим пред. режим - для циклического ввода
      lSkipApp := .F.
      nApp := 2
   ENDIF
   IF ValType(_nMore) = "N" .AND. _nMore = -1
     lMore := .F.
   ENDIF
   IF (nApp == 1)
      IF (VALTYPE(aHeads[1,1])!='A') //.AND.nRow0 >= nTop .AND. nRow0<=nBottom)
         SETCOLOR(_cColor)
         @ nBottom,nLeft+2 SAY SYM15
         SETCOLOR(_cLastColor)
      ENDIF
      DO CASE
         CASE (LASTKEY() == K_RETURN .or. LASTKEY() == K_F10)
         lMore:=.F.
         CASE (LASTKEY() == K_PGUP)
         IF (VALTYPE(aHeads[1,1])!='A'.AND.nScrInit!=4).OR.nScrInit=2
            IF !QUp(nScroll)
               IF VALTYPE(aHeads[1,1])!='A'
                  SETCOLOR(_cColor)
                  @ nBottom,nLeft+2 SAY ' Начало базы '
                  SETCOLOR(_cLastColor)
               ENDIF
            ENDIF
         ELSE
            SKIP -1
         ENDIF
         CASE (LASTKEY() == K_PGDN)
         IF (VALTYPE(aHeads[1,1])!='A'.AND.nScrInit!=4).OR.nScrInit=2
            IF !QDown(nScroll)
               IF VALTYPE(aHeads[1,1])!='A'
                  SETCOLOR(_cColor)
                  @ nBottom,nLeft+2 SAY ' Конец базы '
                  SETCOLOR(_cLastColor)
               ENDIF
            ENDIF
         ELSE
            SKIP
            IF EOF()
               SKIP-1
            ENDIF
         ENDIF
      ENDCASE
   ENDIF
ENDDO
GetList := {}
UNLOCK ALL
WSELECT(nWi)
IF (nApp==0)
   DO CASE
      CASE (LASTKEY()==K_CTRL_W)
        QSetFilter(aHeads,,"Снять")
      CASE (LASTKEY()!=K_ESC)
        BrRestScreen(sRest)
        QSetFilter(aHeads,cFltr0,,,,cScope,,,,lSubIndex,@xRest23)
   ENDCASE
ENDIF
IF nTopi!=NIL.AND.nBottomi!=NIL .AND. !lNoRestScreen
   BrRestScreen(sResti)
ENDIF
IF !lNoRestScreen
  BrRestScreen(sRest)
ENDIF
IF xRest23 != NIL
  BrRestScreen(xRest23)
ENDIF
SETCOLOR(_cLastColor)
RestKey(aBlockKey)
statCod:=NIL
IF bScrPost!=NIL
   EVAL(bScrPost)
ENDIF
COMMIT
aNameArray := {}
sResti:=sRestii
RETURN (2)

PROCEDURE qSave( aHeads, bPost )
PLOCAL oGet := GetList[1]
PLOCAL aOldIn,aOldData,aInfo
  aInfo := oGet:name
  aOldIn := aIn
  aOldData := EVAL(aInfo[2,4],aInfo[2,5])
  aIn := aInfo[2,3]

  AEVAL(aIn,{|x,nCo| RetValue(aHeads[nCo,2],x) })
  lWasApp:=.F.
  IF (bPost!=NIL)
    EVAL(bPost)
  ENDIF
  IF FILE( 'NEW.NEW' ) // новые чистые базы
    FERASE( 'NEW.NEW' )
  ENDIF
//  UNLOCK ALL Вася. UnlockAll не работает. См. S_Public.ch и _Harbourex.prg
    MyDBUnLockAll()
  COMMIT

  aIn := aOldIn
  EVAL(aInfo[2,4],aOldData)

RETURN
//--------------------------------------------------------------------------//
FUNCTION QSetFilter(aHeads,cFltr0,cErase,cOutFilter,lEnd,cScopeMacro,nRow,nCol,cFilter,lSubIndex,xRest23)
//--------------------------------------------------------------------------//
// Если задан cOutFilter,то устанавливаем его
// lSubIndex - .T. построение субиндекса иначе ручного индекса
// Фильтр одноразовый если макроподстановка не проходит
PLOCAL _cLastColor:=SETCOLOR(COL_BROWSE)
PLOCAL nCo, LastHandler
PLOCAL nRecNo:=RECNO()
PLOCAL cSumFilter, aTHeads
PLOCAL xKey,nWi:=WSELECT()
PLOCAL aFilter := {}, lRotate,ll


IF ((EOF().OR.LASTREC()=0).AND.cErase=NIL)
   RETURN (1)
ENDIF

IF TYPE("_qSetFilter") != "B"
  PUBLIC _qSetFilter
ENDIF


cScopeMacro:=IF(cScopeMacro==NIL,ScopeMacro(),cScopeMacro)
cFilter:=''
IF (cErase==NIL)
   IF (cOutFilter != NIL)
      cFilter:=cOutFilter
   ELSE
      //altd()
      FOR nCo:=1 TO LEN(aHeads)
      // Приведем в формат фильтра
      aTHeads := {aHeads[nCo,1],aHeads[nCo,2],IF(LEN(aHeads[nCo])<4,'1',aHeads[nCo,4]),IF(LEN(aHeads[nCo])<6,NIL,if(ValType(aHeads[nCo,6])=='B',Eval(aHeads[nCo,6]),aHeads[nCo,6]))}
      // Флаг Rotate
      lRotate := TYPE("aFilIn") = "A" .AND. nCo <= LEN(MemVar->aFilIn) .AND. MemVar->aFilIn[nCo] != NIL

      IF LEN(aTHeads) > 3 .AND. aTHeads[4] != NIL .AND. ValType(aTHeads[4]) = "C" .AND. LEN(aTHeads[4]) != 1.AND. !EMPTY(IF(lRotate,MemVar->aFilIn[nCo],aIn[nCo]))
         IF !EMPTY(aTHeads[4]) .AND. IF(ValType(aIn[nCo]) != "A",!EMPTY(aIn[nCo]),!EMPTY(aIn[nCo,1]).OR.!EMPTY(aIn[nCo,2]))
           AADD(aFilter,InsEl(aTHeads[4]))
         ENDIF
      ELSEIF (VALTYPE(aIn[nCo])=='A')
         IF !EMPTY(aIn[nCo]) .and. (!EMPTY(aIn[nCo,1]).OR.!EMPTY(aIn[nCo,2]))
           AADD(aFilter,aTHeads[2]+'>='+LockStrF(aIn[nCo,1])+'.AND.'+aTHeads[2]+'<='+LockStrF(aIn[nCo,2]))
         ENDIF
      ELSEIF !EMPTY(IF(lRotate,MemVar->aFilIn[nCo],aIn[nCo])).AND.!(ValType(aIn[nCo]) = "C".AND.LEN(aIn[nCo])=1.AND.ALLTRIM(aIn[nCo])=='*')

         IF ValType(aIn[nCo])=='C'.AND.ALLTRIM(aIn[nCo])=='+'
              AADD(aFilter,'!EMPTY('+TRIM(aTHeads[2])+')')
         ELSEIF ValType(aIn[nCo])=='C'.AND.ALLTRIM(aIn[nCo])=='-'
              AADD(aFilter,'EMPTY('+TRIM(aTHeads[2])+')')
         ELSEIF ValType(aIn[nCo])=='C'.AND.LEFT(ALLTRIM(aIn[nCo]),1)='*'
           aIn[nCo]:=ALLTRIM(SUBSTR(ALLTRIM(aIn[nCo]),2))
           AADD(aFilter,LockStrF(ALLTRIM(aIn[nCo]),,aLastIn[nCo])+'$'+LockStrH(aTHeads[2],aIn[nCo],aLastIn[nCo],'AllTrim'))
         ELSEIF ValType(aIn[nCo])=='C'.AND.(LEFT(ALLTRIM(aIn[nCo]),1)='~' .OR. RIGHT(ALLTRIM(aIn[nCo]),1)='~')
           aIn[nCo]:=UPPER(STRTRAN(aIn[nCo],"~"," "))
           AADD(aFilter,'['+aIn[nCo]+'] == UPPER('+aTHeads[2]+')')
         ELSEIF ValType(aIn[nCo])=='C'.AND.(LEN(aTHeads)<3.OR.aTHeads[3]='1')
           AADD(aFilter,LockStrF(ALLTRIM(aIn[nCo]),,aLastIn[nCo])+'$'+LockStrH(aTHeads[2],aIn[nCo],aLastIn[nCo]))
         ELSE
           IF ValType(aIn[nCo]) = "C".AND.RIGHT(TRIM(aIn[nCo]),1)='*'
              aIn[nCo]:=LEFT(aIn[nCo],LEN(TRIM(aIn[nCo]))-1)
           ENDIF
           AADD(aFilter,IF(lRotate,aTHeads[2],LockStrH(aTHeads[2],aIn[nCo],aLastIn[nCo]))+'='+LockStrF(aIn[nCo],IF(lRotate,.T.,NIL),aLastIn[nCo]))
         ENDIF
      ENDIF
      NEXT
      IF !EMPTY(aFilter)
        AEVAL(aFilter,{|x,n|x:=ALLTRIM(x),cFilter += IF(n = 1,"",'.AND.')+"("+x+")",aFilter[n] := &("{||"+x+"}") })

/*****************

        IF !IsAds() 
           IF LEN(cFilter)>400
              MemVar->_qSetFilter := {|| ASCAN(aFilter,{|x| !EVAL(x) }) = 0 }
              cFilter := "EVAL(_qSetFilter)"
           ELSE
              TRY
                ll:=ValType(&cFilter) != "L"
              CATCH
                MemVar->_qSetFilter := {|| ASCAN(aFilter,{|x| !EVAL(x) }) = 0 }
                cFilter := "EVAL(_qSetFilter)"
              END
           ENDIF
        ENDIF
**********************/

      ENDIF
   ENDIF
   altd()
   IF !EMPTY(cFilter)
      IF MySetFilter(cFilter,cFltr0,cScopeMacro,lSubIndex)
        IF sRest23 = NIL
          IF nRow = NIL
            sRest23:=IF(xRest23 != NIL,xRest23,BrSaveScreen(23,0,23,MAXCOL()))
            ScrTitul(23,'Фильтр установлен (Ctrl-F6:снятие фильтра)')
            xRest23 := BrSaveScreen(23,0,23,MAXCOL())
          ELSEIF nRow<=MAXROW()
            sRest23:=BrSaveScreen(nRow,nCol,nRow,nCol+36)
            SAYSCREEN(' Фильтр установлен (Ctrl-F6:снятие) ',nRow,nCol)
            xRest23 := BrSaveScreen(nRow,nCol,nRow,nCol+36)
          ENDIF
        ENDIF
      ELSE
         cFilter:=''
      ENDIF
   ENDIF
ENDIF
IF (EMPTY(cFilter))
   MyCloseFilter(nRow,nCol)
   GO nRecNo
ENDIF
WSELECT(nWi)
SETCOLOR(_cLastColor)

// Сбросим выражение для фильтра
MemVar->_qSetFilter := {|| .T. }

RETURN (2)
//--------------------------------------------------------------------------//
STATIC FUNCTION InsEl(cString)
//--------------------------------------------------------------------------//
PLOCAL xVal, cStr
cString := STRTRAN(cString,"aIn[","AIN[")
WHILE "AIN[" $ cString
  xVal := &("AIN["+BEFORATNUM("]",AFTERATNUM("AIN[",cString,1,0),1,0)+"]")
  IF ValType(xVal) = "L"
    cStr := IF(xVal,".T.",".F.")
  ELSEIF ValType(xVal) = "C"
    cStr := "'"+xVal+"'"
  ELSEIF ValType(xVal) = "N"
    cStr := ALLTRIM(STR(xVal,20,4))
  ELSEIF ValType(xVal) = "D"
    cStr := "CTOD('"+DTOC(xVal)+"')"
  ELSE
    cStr := ""
  ENDIF
  cString := BEFORATNUM("AIN[",cString,1,0)+cStr+AFTERATNUM("]",AFTERATNUM("AIN[",cString,1,0),1,0)
ENDDO
RETURN cString

FUNCTION PreFiltOrd()
PLOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
PLOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2])
RETURN IF(cTempIndex!=NIL,ORDNAME(sPre[nArea,4]),"")

FUNCTION MyCloseFilter(nRow,nCol,NoDelete,lNoPreRec,nTag,lNoDelKey,cTempKey)
PLOCAL nWi:=WSELECT()
PLOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
PLOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2])
PLOCAL cTemp:=cTempIndex,nPreOrder,cPreBag,nPreRec
PLOCAL cAliasKey
IF cTempIndex!=NIL
   cTempKey := sPre[nArea,6]
   cPreBag:=sPre[nArea,3]
   nPreOrder:= IF(nTag = NIL,sPre[nArea,4],nTag)
   nPreRec:=sPre[nArea,5]
   nPozSortSeek := sPre[nArea,7]
   ADEL(sPre,nArea)
   ASIZE(sPre,LEN(sPre)-1)
   //altd()
   IF NoDelete==NIL
      CLOSE INDEXES
      FERASE(cTempIndex)
      IF !(FILE(cPreBag).OR.FILE(TRIM(cPreBag)+".cdx"))
         cPreBag := TOKEN(cPreBag,"\")
      ENDIF
      IF FILE(cPreBag).OR.FILE(TRIM(cPreBag)+".cdx")
        SET INDEX TO (cPreBag)
        ORDSETFOCUS(nPreOrder)
        IF lNoPreRec = NIL
          GO nPreRec
        ENDIF
        IF !EMPTY(cTempKey) .AND. lNoDelKey = NIL
          cAliasKey := "_"+TOKEN(TOKEN(cTempKey,".",1),"\")
          (cAliasKey)->(dbCloseArea())
          FERASE(cTempKey+"DBF")
          FERASE(cTempKey+"CDX")
        ENDIF
      ENDIF
   ELSE
     MySetIndex(cPreBag) //спецобработка иначе валится
//      SET INDEX TO (cPreBag),(cTemp)
//      ORDSETFOCUS(nPreOrder)

/****************
      if IsAds()
         nPreRec:=sPre[nArea,5]
         GO nPreRec
      endif
********************/
   ENDIF
   cTempIndex:=NIL
ELSEIF NoDelete!=NIL.AND.!EMPTY(cPreBag).AND.!EMPTY(cTemp)
    MySetIndex(cPreBag) //спецобработка иначе валится
   //SET INDEX TO (cPreBag),(cTemp)
   //ORDSETFOCUS(nPreOrder)
/***************
   if IsAds()
      nPreRec:=sPre[nArea,5]
      GO nPreRec
   endif
******************/


ENDIF

IF lNoDelKey = NIL
  IF sRest23!=NIL
    WSELECT(0)
    BrRestScreen(sRest23)
    WSELECT(nWi)
  ENDIF
  sRest23:=NIL
ENDIF
RETURN(cTemp)


STATIC FUNCTION MySetIndex(c)
LOCAL i:=0,cBag,lYes:=.F.
//altd()
WHILE !EMPTY(cBag:=ORDBAGNAME(++i))
   IF UPPER(cBag)$UPPER(c)
      lYes:=.T.
      EXIT
   ENDIF
ENDDO
IF !lYes
   OrdListAdd(c)
ENDIF
RETURN






FUNCTION QDel(bYes,bPostBlock,nTag, lNoReq,bPostBlockPost)
//bYes-блок,выполняющийся перед запросом,если возвращает (.F.),
//то дальнейшие действия не производятся, в противном случае может возвратить
//наименование запроса на уничтожение ("Уничожить документ?" и т.п.)
//bPostBlock-блок,выполняющийся после запроса перед уничтожением тек.записи
// lNoReq - если не пусто, не задавать вопросов о удалении
LOCAL currFilter:=DBFILTER()
LOCAL aScope:=GetScope()
LOCAL nRet:=1
LOCAL nOrd:=ORDNUMBER()
LOCAL aBlockKey,xKey
LOCAL nRecNo:=RECNO()
LOCAL nArray:=SELECT(),nWi:=WSELECT(),x
LOCAL cRequest:=' Удалить текущую запись? '
LOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
LOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2])
LOCAL nRecOld,sF8,lWasDelete:=.F.

IF (EOF().OR.LASTREC()=0)
   RETURN (1)
ENDIF
IF !RecLock('не надо авторизации')
   Error_Lock()
   RETURN(1)
ENDIF
sF8:=SETKEY(K_F8,NIL)
ORDSETFOCUS(TOP_TAG(nTag))
SET FILTER TO
SetScope()
WSELECT(0)
GO nRecNo
aBlockKey:=SaveKey()
IF (bYes!=NIL)
   x:=EVAL(bYes)
   // Изменение 3.180]
   IF (ValType(x)=='C') .OR. ValType(x) = "A"
      cRequest:=x
      x:=.T.
   ENDIF
ENDIF
IF ((bYes==NIL .OR. (bYes!=NIL .AND. x)) .AND.;
   (EMPTY(cRequest).OR. !EMPTY(lNoReq) .OR. YesOrNo(cRequest,.T.,' Да ',' Нет ',10)))
   IF RecLock()
      nRecNo:=RECNO()
      IF (bPostBlock!=NIL)
         EVAL(bPostBlock)
         SELECT (nArray)
         nRecOld := RECNO()
         GO nRecNo
      ENDIF
      IF nOrd>0
         ORDSETFOCUS(nOrd)
      ENDIF
      SetScope(aScope)
      IF nRecOld != NIL .AND. (Delete().OR.(FieldPos("DELETE") != 0 .AND. FIELD->DELETE))
        dbGoTo(nRecOld)
      ELSE
        xDELETE()
        WHILE (DELETED() .AND. !EOF())
          SKIP
        ENDDO
        IF DELETED()
           GO TOP
           SKIP
        ENDIF
      ENDIF
      nRet:=2
      lWasDelete:=.T.
   ELSE
      Error_Lock()
   ENDIF
ELSE
  GO nRecNo
  UNLOCK
ENDIF
RestKey(aBlockKey)
IF nOrd>0
   ORDSETFOCUS(nOrd)
ENDIF
IF !EMPTY(currFilter)
  dbSetFilter(&("{||"+currFilter+"}"),currFilter)
ENDIF
SetScope(aScope)
COMMIT
WSELECT(nWi)
SETKEY(K_F8,sF8)
IF lWasDelete.AND.VALTYPE(bPostBlockPost)=="B"
   GO nRecNo
   EVAL(bPostBlockPost)
ENDIF
RETURN(nRet)

FUNCTION PostDel(aAlias,aKey,bBlock,cName)  //Типовая функция уничтожения связанных записей
LOCAL i,xKey, cAlias, bKey
LOCAL nArray:=SELECT()
Busy(.T.,'Удаление',,,'Не мигая')
AEVAL(aAlias,{|_cAlias,i|;
             cAlias := _cAlias,;
             xKey:=&(aKey[i]),;
             IF(SELECT(cAlias) != 0,;
                (cAlias)->(;
                       bKey := &("{||"+ORDKEY()+"}"),;
                       dbSeek(xKey),;
                       xDBEVAL({||;
                          IF(bBlock != NIL .AND. RecLock(),(EVAL(bBlock),dbUnLock()),NIL),;
                          IF(UPPER(cAlias) = "MAIN",DelMain(.F.,,,,cName),NIL),;
                          xDELETE();
                               },,{|| EVAL(bKey) = xKey },.F.);
                          ),;
                NIL;
                );
              })
Busy(.F.)
RETURN (NIL)
//--------------------------------------------------------------------------//
             FUNCTION xRECALL(xKey,cTag)
//--------------------------------------------------------------------------//
// Восстанавливает текущую запись с блокировкой
// Если указан xKey, то восстанавливает запись найденную по ключу тэга cTag
// Возвращает признак успешности восстановления
PLOCAL lRet := .T.
IF xKey != NIL
  cTag := ORDSETFOCUS(cTag)
  lRet := dbSeek(xKey)
  ORDSETFOCUS(cTag)
ENDIF
IF lRet .AND. (lRet := RecLock())
  IF FieldPos("DELETE") = 0
    dbRecall()
  ELSE
    FIELD->DELETE := .F.
  ENDIF
  dbUnLock()
ENDIF
RETURN lRet
//--------------------------------------------------------------------------//
             PROCEDURE xDELETE()
//--------------------------------------------------------------------------//
// Удаляет текущую запись с блокировкой и со смещением на следующую по ключу
PLOCAL nBakRec := RECNO(), nNewRec := 0
  dbSkip()
  nNewRec := RECNO()
  dbGoTo( nBakRec )
  IF RecLock()
    IF FieldPos("DELETE") = 0
      dbDelete()
    ELSE
      FIELD->DELETE := .T.
    ENDIF
    dbUnLock()
  ENDIF
  IF nNewRec <> 0
    dbGoTo(nNewRec)
  ELSE
    dbGoBottom()
  ENDIF
RETURN
//--------------------------------------------------------------------------//
             PROCEDURE xDBEVAL(_bRun,bFor,bWhile,lRecLock)
//--------------------------------------------------------------------------//
// DBEVAL с выполнением bRun с опозданием на один шаг
// Используется при удалении если в for условии ключа стоит !DELETE()
// и при переопределении ключевых полей текущего teg'а
// bRun     - блок кода выполняемый на найденых записях
// [bFor]     - for блок
// [bWhile]   - while блок
// lRecLock  - флаг блокировки, если .T., то блокировка
//             записи, перед выполнением bRun
// ВНИМАНИЕ !!
// При использовании переменных определяемых в bFor или bWhile
// в bRun следует иметь ввиду, что значения надо использовать
// через old переменные с опозданием на один шаг ! Т.к. выполнение bRun
// отстает от выполнения bFor,bWhile на одну интерацию.
PLOCAL bRun
PLOCAL nTekRec,nPreRec
bRun := IF(bFor != NIL,{|| IF(EVAL(bFor),EVAL(_bRun),NIL) },_bRun)
DBEVAL({|| nTekRec := RECNO(),IF(nPreRec != NIL .AND. (dbGoTo(nPreRec),!lRecLock .OR. RecLock()),(EVAL(bRun),IF(lRecLock,dbUnLock(),NIL)),NIL),dbGoTo(nTekRec),nPreRec := nTekRec },,bWhile)
nTekRec := RECNO()
IF(nPreRec != NIL .AND. (dbGoTo(nPreRec),!lRecLock .OR. RecLock()) ,(EVAL(bRun),IF(lRecLock,dbUnLock(),NIL)),NIL)
dbGoTo(nTekRec)
RETURN

//--------------------------------------------------------------------------//
FUNCTION QSeek(aSortSeek,_cColor,nTop,nLeft,Wide) //Wide- широкая рамка
//--------------------------------------------------------------------------//
#DEFINE N_REZ_SORT 16   // последний зарезервированнный элемент aSortSeek
//                       массив структуры :
//                      1. номер записи в дочерней базе на которой остановился поиск
//                      2. номер записи в связанной базе
//                      3. значение ключа
//                      4. признак .T. начать поиск с начала, .F. продолжить
LOCAL nBottom,nRight,nX,oGet
LOCAL _cLastColor:=SETCOLOR()
LOCAL nRet,nOrd:=ORDNUMBER(),lMore,numGet,_nLen,nOrd1, lNoNewSeek := .F.
LOCAL sRest:=SAVESCREEN(),lSeekOnly := .T.
LOCAL cPict,nCo,nRecNo:=RECNO(), lSeek := .F., cKey, cScope, bFilter
LOCAL aBlockKey,xKey,xMax:=0, cSel,nOrder,aScope,cFilter, nBakFocus, aBakScope, cBakFilter, nBakRec, nSeekRec, cSelFilter
LOCAL aBakKoord, nBakOrd
LOCAL nArea,lSetFilter:=IsSetFilter().AND.!EMPTY(ORDFOR()) //FARM-titov
PRIVATE bSet := {|| aSortSeek[nOrd1,N_REZ_SORT,1] := RECNO(),aSortSeek[nOrd1,N_REZ_SORT,2] := (cSel)->(RECNO()),aSortSeek[nOrd1,N_REZ_SORT,3] := cKey,lSeek := .T.,.F. }
IF (EOF().OR.LASTREC()=0)
   RETURN (1)
ENDIF
cSel := ALIAS()
nOrder := ORDNUMBER()
aScope := GetScope()
cScope := ScopeMacro()
IF !EMPTY((cSelFilter := dbFilter()))
  cFilter := cSelFilter
ENDIF
IF !EMPTY(ORDFOR())
  cFilter := IF(EMPTY(cFilter),"","("+cFilter+").AND.")+"("+ORDFOR()+")"
ENDIF
IF cFilter != NIl .AND. cScope $ cFilter
 cScope := ""
ENDIF

IF lSetFilter //FARM-titov
   nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
   nOrd1:=IF(EMPTY(nArea).OR.LEN(sPre[nArea])<7,NIL,sPre[nArea,7])
   IF EMPTY(nOrd1)
      QSort(aSortSeek,_cColor,nTop,nLeft,Wide,'Поиск',@nOrd1)
   ENDIF
ELSE
   QSort(aSortSeek,_cColor,nTop,nLeft,Wide,'Поиск',@nOrd1)
ENDIF


IF EMPTY(nOrd1)
  RETURN(1)
ENDIF

IF LEN(aSortSeek[nOrd1]) > 9 .AND. !EMPTY(aSortSeek[nOrd1,10])
  nStOrder := ORDNUMBER()
  ORDSETFOCUS(nOrder)
  SELECT (aSortSeek[nOrd1,10])
  lNoNewSeek := !EMPTY(aSortSeek[nOrd1,N_REZ_SORT,1])
ENDIF
lMore:=IF(VALTYPE(aSortSeek[nOrd1,3])=='A',.T.,.F.)
numGet:=IF(VALTYPE(aSortSeek[nOrd1,3])=='A',LEN(aSortSeek[nOrd1,3]),1)
_nLen:=IF(VALTYPE(aSortSeek[nOrd1,2])=='A',LEN(aSortSeek[nOrd1,2,1]),LEN(aSortSeek[nOrd1,2]))
aBlockKey:=SaveKey()
IF _cColor==NIL
   _cColor:=COL_INPUT
ENDIF
IF (nTop==NIL)
   nTop:=5
ENDIF
IF !lSetFilter //FARM-titov
   ScrTitul(24,'┘:Ввод')
ENDIF
nBottom:=nTop+NumGet+1
PRIVATE aIn:={},cRef,GetList:={},cValid, bFilter1, l1,bFilter2, bFilter3, bFilter4, l2,l3,l4
SETCOLOR(_cColor)
IF !lNoNewSeek
  FOR nCo:=1 TO numGet
  cPict:=IF(LEN(aSortSeek[nOrd1])>4,IF(lMore,aSortSeek[nOrd1][5,nCo],aSortSeek[nOrd1][5]),'')
  AADD(aIn,IF(lMore,&(aSortSeek[nOrd1,3,nCo]),&(aSortSeek[nOrd1,3])))
  cPict:=IF(cPict==NIL,'',cPict)
  DO CASE
     CASE (LEN(cPict)>0 .AND. !'@'$cPict)
     nX:=LEN(cPict)
     CASE LEN(cPict)>0 .AND. '@'$cPict
     IF  ' '$cPict
        nX:=LEN(cPict)-AT(' ',cPict)
     ELSEIF '@KS'$UPPER(cPict)
        nX:=VAL(SUBSTR(cPict,4))
     ELSEIF VALTYPE(aIn[nCo])=='C'
        nX:=LEN(aIn[nCo])
     ELSEIF VALTYPE(aIn[nCo])=='D'
        nX:=8
     ELSE
        nX := LEN(TRANSFORM(aIn[nCo],cPict))
     ENDIF
     CASE VALTYPE(aIn[nCo])=='C'
     nX:=LEN(aIn[nCo])
     CASE VALTYPE(aIn[nCo])=='D'
     nX:=8
     CASE VALTYPE(aIn[nCo])=='N'
     nX:=LEN(STR(aIn[nCo]))
  ENDCASE
  xMax:=MAX(xMax,nX)
  NEXT
  IF (nLeft!=NIL)
     // Изменение 3.150
     nRight := nLeft+_nLen+xMax+4
  ELSE
     nRight:=MAXCOL()-6
     nLeft:=nRight-_nLen-xMax-4
  ENDIF
  ShadowBox(' Поиск ',nTop,nLeft,nBottom,nRight,_cColor,,Wide)
  aBakKoord := SaveSeekPos({nTop,nLeft,nBottom,nRight})

  nX:=nLeft+_nLen+3
  FOR nCo:=1 TO numGet
  cPict:=IF(LEN(aSortSeek[nOrd1])>4,IF(lMore,aSortSeek[nOrd1][5,nCo],aSortSeek[nOrd1][5]),'')
  cPict:=IF(cPict==NIL,'',cPict)
  cValid:=IF(LEN(aSortSeek[nOrd1])>5,IF(lMore,aSortSeek[nOrd1][6,nCo],aSortSeek[nOrd1][6]),'(.T.)')

  IF (cValid==NIL)
     cValid:='(.T.)'
  ENDIF

  @ nTop+nCo,nLeft+2 SAY IF(lMore,aSortSeek[nOrd1,2,nCo],aSortSeek[nOrd1,2])
  IF (LEN(aSortSeek[nOrd1]) > 6)
     cRef:=IF(lMore.AND.ValType(aSortSeek[nOrd1][7])=='A',aSortSeek[nOrd1][7,nCo],aSortSeek[nOrd1][7])
     oGet := GetNew(nTop+nCo,nX,IF(LEN(aSortSeek[nOrd1])>8 .AND. IF(lMore,aSortSeek[nOrd1][9,nCo],aSortSeek[nOrd1][9]) != NIL ,IF(lMore,aSortSeek[nOrd1][9,nCo],aSortSeek[nOrd1][9]),&("{|x| IF(x != NIL,aIn["+NTOC(nCo)+"] := x,aIn["+NTOC(nCo)+"]) }")))
     InitCargo(oGet)
     oGet:picture := cPict
     oGet:postBlock := &("{||"+cValid+"}")
     IF !EMPTY(cRef)
       IF ValType(cRef) = "C"
         oGet:Reader := &("{|oGet| ReferGetReader(oGet,'"+cRef+"') }")
       ELSEIF ValType(cRef) = "B"
         oGet:Reader := cRef
       ENDIF
       oGet:preBlock := {||SayScreen(PADR(' F2:Справочник ',nRight-nLeft-2,'═'),nBottom,nLeft+2),.T.}
       IF 'RIGHTF'$ UPPER(cValid)
          DEF_CARGO(oGet):=.F.
       ELSEIF 'RIGHT'$ UPPER(cValid)
          DEF_CARGO(oGet):=.T.
       ENDIF
     ELSE
     	 oGet:preBlock := {||SayScreen(REPLICATE('═',nRight-nLeft-2),nBottom,nLeft+2),.T.}
     ENDIF
     AADD(MemVar->GetList,oGet:display())
  ELSE
     @ nTop+nCo,nX GET aIn[nCo] PICT cPict VALID &(cValid)
  ENDIF
  NEXT
  SETCURSOR(1)
  READ
  SETCURSOR(0)
  SaveSeekPos(aBakKoord)
ENDIF
IF (LASTKEY()==K_ESC) .AND. !lNoNewSeek
   nRet:=1
   SELECT (cSel)
   ORDSETFOCUS(nOrd)
ELSE
   IF LEN(aSortSeek[nOrd1]) > 9 .AND. !EMPTY(aSortSeek[nOrd1,10])

     Busy(.T.,"Поиск")
     nBakFocus := ORDNUMBER()
     aBakScope := SetScope()
     cBakFilter := dbFilter()
     dbClearFil()
     nBakRec := RECNO()
     nBakFocus := ORDNUMBER()
     ORDSETFOCUS(IF(EMPTY(aSortSeek[nOrd1,8]),nOrd1,aSortSeek[nOrd1,8]))
     IF lNoNewSeek
       cKey := aSortSeek[nOrd1,N_REZ_SORT,3]
       IF aSortSeek[nOrd1,N_REZ_SORT,4]
         dbGoTo(aSortSeek[nOrd1,N_REZ_SORT,1])
         dbSkip()
	 IF((lSeekOnly := &(ORDKEY()+" = "+LockStrF(cKey,'Полный'))),NIL,dbSkip(-1))
       ELSE
         DBSEEK(cKey,.T.)
       ENDIF
     ELSE
       aSortSeek[nOrd1,N_REZ_SORT,2] := NIL
       DBSEEK((cKey := TRIM(&(aSortSeek[nOrd1,4]))),.T.)
     ENDIF
     (cSel)->(SetScope(),ORDSETFOCUS(nStOrder))
     IF lSeekOnly
       bFilter := &("{|| "+ORDKEY()+" = "+LockStrF(cKey,'Полный')+".AND.(!"+cSel+"->(dbSeek("+aSortSeek[nOrd1,12]+").AND."+IF(!EMPTY(aSortSeek[nOrd1,N_REZ_SORT,2]),NTOC(aSortSeek[nOrd1,N_REZ_SORT,2])+"!= RECNO()","(.T.)")+".AND.("+IF(EMPTY(cScope),".T.",cScope)+")).OR.EVAL(bSet))}")
       nCo:=RECNO()
       DBEVAL({|| NIL },,{|lRet,nRec,cOrd| nRec := RECNO(),cOrd := ORDSETFOCUS(nBakFocus),lRet := EVAL(bFilter),ORDSETFOCUS(cOrd),dbGoTo(nRec),lRet })
       DbGoto(nCo)
     ELSE
       (cSel)->(dbSkip(),lSeek := &(ORDKEY()+"="+aSortSeek[nOrd1,12]),IF(lSeek,NIL,dbSkip(-1)))
     ENDIF
     (cSel)->(SetScope(aScope),IF(!EMPTY(cSelFilter),dbSetFilter(&("{||"+cSelFilter+"}"),cSelFilter),NIL),ORDSETFOCUS(nOrder))
     Busy(.F.)
     IF !lSeek
       aSortSeek[nOrd1,N_REZ_SORT,1] := aSortSeek[nOrd1,N_REZ_SORT,2] := aSortSeek[nOrd1,N_REZ_SORT,3] := NIL
       SayAndWait( 'Элемент не найден!',10)
     ENDIF
     ORDSETFOCUS(nBakFocus)
     SetScope(aBakScope)
     IF !EMPTY(cBakFilter)
       dbSetFilter(&("{||"+cBakFilter+"}"),cBakFilter)
     ENDIF
     dbGoTo(nBakRec)
   ELSE
     nPozSortSeek := nOrd1
     nBakOrd := ORDSETFOCUS()
     IF LEN(aSortSeek[nOrd1]) > 10.AND.!EMPTY(aSortSeek[nOrd1,11])
        ORDSETFOCUS(aSortSeek[nOrd1,11])
     ENDIF
     IF (cSel)->(!DBSEEK(&(aSortSeek[nOrd1,4]),.T.))
       SayAndWait( 'Элемент не найден!',10)
     ENDIF
     ORDSETFOCUS(nBakOrd)
   ENDIF
   nRet:=2
   IF (cSel)->(EOF())
      (cSel)->(dbGoTop())
   ENDIF
ENDIF
SETCOLOR(_cLastColor)
RestKey(aBlockKey)
SETLASTKEY(0)
RESTSCREEN(,,,,sRest)
SELECT (cSel)

if sRest23 != NIL.AND.!lSetFilter //FARM-titov
    BrRestScreen(sRest23)
    sRest23 := NIL
end
RETURN (nRet)

FUNCTION NewFilter(cKey, cFilter, cScope, nOrd1, cSel, aSortSeek )
    LOCAL cFilt := '',;
          cMyKey    := "ORDKEY()="+LockStrF(cKey,'Полный'),;
          cMyFilter :=  IF(!EMPTY(cFilter),".AND.("+cFilter+")",""),;
          cMyScope  :=  IF(!EMPTY(cScope), ".AND.("+cScope+")", ""),;
          cMySeek   :=  IF(!EMPTY(aSortSeek[nOrd1,N_REZ_SORT,2]),".AND."+NTOC(aSortSeek[nOrd1,N_REZ_SORT,2])+"!= RECNO()","")

    cFilt :=  cMyKey+;
              ".AND."+;
           "("+;
       "!"+cSel+"->(dbSeek("+aSortSeek[nOrd1,12]+")"+;
           cMySeek+;
           cMyScope +;
                   ").OR.EVAL(bSet)"+;
    ")"
    cFilt:=&("{||"+cFilt+"}")
RETURN cFilt

//--------------------------------------------------------------------------//
FUNCTION MySortSeek(aSort,nPreOrder,cPreFilter)
//--------------------------------------------------------------------------//
// Установка ручного индекса
// aSort - текущий элемент aSortSeek
SLOCAL cOrdKey
PLOCAL cTempIndex,cPreBag,nPreRec, cTempKey
PLOCAL nRec:=RECNO(), nLastKey
PLOCAL bFilter, cScope, cFilter, cSel, cSelSv := aSort[10], nOrderSv := IF(ValType(aSort[8])!="B",aSort[8],EVAL(aSort[8])), cSelFilter
PLOCAL nPStOrder := IF(ValType(aSort[11])!="B",aSort[11],EVAL(aSort[11]))
PLOCAL aBakScope,cBakFilter,nBakRec,nBakFocus, cScopeKey, aScope
PLOCAL cAliasKey, bWhile, bAddKey, bFor, bSkip, lOnlySort
aScope := GetScope()
cSelFilter := dbFilter()
IF(cPreFilter = NIL,cPreFilter := ORDFOR(),NIL)
cFilter := IF(EMPTY(cSelFilter),"","("+cSelFilter+").AND.")+IF(!EMPTY(cPreFilter),"("+cPreFilter+")","")
cScope := ScopeMacro()
IF cScope $ cFilter
  cScope := ".T."
ENDIF
IF GetScope() != NIL
  cScopeKey := GetScope()[1]
ENDIF

MyCloseFilter()

cTempKey := TEMPFILE(GlobalTmpPath)
FCLOSE(FCREATE(cTempKey+"DBF"))
FCLOSE(FCREATE(cTempKey+"CDX"))
FERASE(cTempKey)

cTempIndex:=TEMPFILE( GlobalTmpPath, "CDX" )
cPreBag := IF(!EMPTY(ORDBAGNAME()).AND.Bs_IsTmp(ORDBAGNAME()),_TMP_DIR+ORDBAGNAME(),Bs_PathName()+ORDBAGNAME(1))
cSel := ALIAS()
nPreRec:=RECNO()
AADD(sPre,{SELECT(),cTempIndex,cPreBag,nPreOrder,nPreRec,cTempKey,nPozSortSeek})
FERASE(cTempIndex)
Busy(.T.,"Построение индексного файла")

IF  (lOnlySort := LEN(aSort) > 13 .AND. ValType(aSort[14]) = "C")
  // Сортировка "сверху в низ"
  bFilter := &("{||"+IF(cSelSv != NIL,cSelSv+"->(dbSeek("+aSort[12]+")),","")+"("+cScope+").AND.("+IF(!EMPTY(cFilter),cFilter,".T.")+") }")
  bSkip := {||  (cAliasKey)->(dbAppend(),FIELD->NREC := (cSel)->(RECNO()),FIELD->KEY := (IF(cSelSv != NIL,cSelSv,cSel))->(EVAL(bMySort))),EVAL(bAddKey) }
  cOrdKey := IF(cSelSv != NIL,cSelSv,cSel)+"->("+aSort[14]+")"
ELSE
  // Сортировка "Снизу вверх"
  GO TOP
  SetScope()
  dbClearFil()
  ORDSETFOCUS(nPStOrder)
  bFilter := &("{||"+cSel+"->(dbSeek("+aSort[12]+").AND.("+cScope+").AND.("+IF(!EMPTY(cFilter),cFilter,".T.")+")) }")
  bWhile := &("{||"+(cSel)->(ORDKEY())+"="+aSort[12]+" }")
  bFor := &("{|| ("+cScope+").AND.("+IF(!EMPTY(cFilter),cFilter,".T.")+") }")
  bSkip := {|| (cSel)->(DBEVAL({|| (cAliasKey)->(dbAppend(),FIELD->NREC := (cSel)->(RECNO()),FIELD->KEY := (cSel)->(EVAL(bMySort))),EVAL(bAddKey) },bFor,bWhile)) }

  cOrdKey := cSelSv+"->("+(cSelSv)->(ORDKEY(nOrderSv))+")"

  IF !EMPTY(cScopeKey)
    IF TYPE(cOrdKey) = "C"
      cOrdKey := cScopeKey+"+"+cOrdKey
    ELSEIF TYPE(cOrdKey) = "D"
      cOrdKey := cScopeKey+"+DTOS("+cOrdKey+")"
    ELSEIF TYPE(cOrdKey) = "N"
      cOrdKey := cScopeKey+"+STR("+cOrdKey+",19,3)"
    ENDIF
  ENDIF
ENDIF
bMySort := &("{||"+cOrdKey+"}")
cOrdKey := "MyChar('_"+TOKEN(TOKEN(cTempKey,".",1),"\")+"',"+NTOC(LEN(EVAL(bMySort)))+")"

FERASE(cTempKey+"DBF")
DBCREATE(cTempKey+"DBF",{{"NREC","N",17,0},{"KEY","C",LEN(EVAL(bMySort)),0}})
cAliasKey := "_"+TOKEN(TOKEN(cTempKey,".",1),"\")
FERASE(cTempKey+"CDX")
NetUseExc(cAliasKey,cTempKey+"DBF",,.T.)
INDEX ON NREC TAG KEY TO (cTempKey+"CDX")
NetUseExc(cAliasKey,cTempKey+"DBF",cTempKey+"CDX",,.T.,,.T.)
SELECT (cSel)

IF cSelSv != NIL
  nBakFocus := (cSelSv)->(ORDNUMBER())
  aBakScope := (cSelSv)->(SetScope())
  cBakFilter := (cSelSv)->(dbFilter())
  (cSelSv)->(dbClearFil())
  nBakRec := (cSelSv)->(RECNO())
  nBakFocus := (cSelSv)->(ORDNUMBER())
  (cSelSv)->(ORDSETFOCUS(IF(lOnlySort,nPStOrder,nOrderSv)))
  (cSelSv)->(dbGoTop())
ENDIF

// Имена TEG'ов MY_INDEX и MY_FILTER жестко фиксированы
//if !IsAds()
    INDEX ON &(cOrdKey) TAG MY_INDEX TO (cTempIndex) CUSTOM ADDITIVE
//  else
//    INDEX ON &(cOrdKey) TAG MY_INDEX TO (cTempIndex) ADDITIVE
//endif

    ORDSETFOCUS(IF(!lOnlySort,nPStOrder,nOrderSv))
    bAddKey := {|| OrdKeyAdd("MY_INDEX") }

(IF(lOnlySort,cSel,cSelSv))->(DBEVAL(bSkip,bFilter))


IF cSelSv != NIL
  (cSelSv)->(ORDSETFOCUS(nBakFocus))
  (cSelSv)->(SetScope(aBakScope))
  IF !EMPTY(cBakFilter)
    (cSelSv)->(dbSetFilter(&("{||"+cBakFilter+"}"),cBakFilter))
  ENDIF
  (cSelSv)->(dbGoTo(nBakRec))
ENDIF

SetScope(aScope)
IF(!EMPTY(cSelFilter),dbSetFilter(&("{||"+cSelFilter+"}"),cSelFilter),NIL)

Busy(.F.)
ORDSETFOCUS("MY_INDEX")
GO nRec
RETURN NIL
//--------------------------------------------------------------------------//
FUNCTION MyChar(cAlias,_nLen)
//--------------------------------------------------------------------------//
// Возвращает значение ключа сортировки
PLOCAL nRec := RECNO()
RETURN (cAlias)->(dbSeek(nRec),FIELD->KEY)
//--------------------------------------------------------------------------//
FUNCTION IsSetFilter()
//--------------------------------------------------------------------------//
PLOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
PLOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2])
RETURN(cTempIndex!=NIL)
//--------------------------------------------------------------------------//
            FUNCTION MySetFilter(cFilter,cFltr0,cScope,lSubIndex,lNoIndFil)
//--------------------------------------------------------------------------//
// Установка ручного фильтра
// lNoIndFil - не устанавливать фильтр существующего индекса
SLOCAL cOrdKey:=ORDKEY()
SLOCAL cIndFilter := OrdFor()
SLOCAL cSumFilter := IF(!EMPTY(lNoIndFil),cFilter,IF( EMPTY(cIndFilter) , '', '('+cIndFilter+').AND.' )+;
                    IF( EMPTY(cFltr0) .OR. "("+cFltr0+").AND." $ cIndFilter,'', '('+ cFltr0 +  ').AND.' )+;
                    '('+ IF( EMPTY(cFilter), '.T.', cFilter  ) +')')
PLOCAL cTempIndex,nPreOrder,cPreBag,nPreRec,cTempKey
PLOCAL lYes,nRec:=RECNO(), nLastKey
PLOCAL LastHandler:=ERRORBLOCK({|| BREAK(1) })

BEGIN SEQUENCE

  IF LEN(cSumFilter) > 400
    BREAK
  ENDIF

  MyCloseFilter(,,,,,.T.,@cTempKey)
  IF(ValType(lSubIndex) = "L",,lSubIndex := .T.)
  cTempIndex:=TEMPFILE( GlobalTmpPath, "CDX" )
  cPreBag := IF(!EMPTY(ORDBAGNAME()).AND.Bs_IsTmp(ORDBAGNAME()),_TMP_DIR+ORDBAGNAME(),Bs_PathName()+ORDBAGNAME(1))
  nPreOrder:=ORDNUMBER()
  nPreRec:=RECNO()
  GO TOP
  AADD(sPre,{SELECT(),cTempIndex,cPreBag,nPreOrder,nPreRec,cTempKey,nPozSortSeek})
  FERASE(cTempIndex)
  Busy(.T.,"Установка фильтра")
  // Имена TEG'ов MY_INDEX и MY_FILTER жестко фиксированы

  IF EMPTY(cOrdKey)
      cOrdKey:='"9"'
  ENDIF

//if !IsAds()
  IF lSubIndex
//    __HARBOUR__
      ordCondSet(cSumFilter,&("{||"+cSumFilter+"}"), .T.,{||.T.} ) // дописать while условие
      OrdCreate( (cTempIndex) , ;
           'MY_FILTER'  , ;
           (cOrdKey)  , ;
           &("{||"+ cOrdKey+"}")  , ;
             ,.T. ;
             )
  ELSE
    if !IsAds()
        INDEX ON &(cOrdKey) TAG MY_FILTER TO (cTempIndex) CUSTOM ADDITIVE
      else
        INDEX ON &(cOrdKey) TAG MY_FILTER TO (cTempIndex) ADDITIVE
    endif

        ORDSETFOCUS(nPreOrder)
        dbGoTop()
        DBEVAL({|| OrdKeyAdd("MY_FILTER") },&("{||"+cSumFilter+"}"),{||.T.})
  ENDIF
  Busy(.F.)
  ORDSETFOCUS("MY_FILTER")
//else
//dbSetFilter({|| cSumFilter },cSumFilter)
//endif


  dbGoTop()

  IF EOF()
     nLastKey := LastKey()
     SayAndWait('Нет данных,удовлетворяющих условию!',10)
     SetLastKey(nLastKey)
     lYes:=.F.
  ELSEIF LASTKEY()==K_ESC
     lYes:=.F.
  ELSE
     lYes:=.T.
  ENDIF
  GO nRec

RECOVER
  lYes := SayError({" Слишком много фильтров ! "})
END SEQUENCE

ERRORBLOCK(LastHandler)


RETURN lYes
//--------------------------------------------------------------------------//
FUNCTION ShortSetFilter(cBag,nOrder,cTemp, aSortSeek)
//--------------------------------------------------------------------------//
LOCAL cPreBag:=ORDBAGNAME()
LOCAL nPreOrder:=ORDNUMBER()
LOCAL nPreRec:=RECNO()
LOCAL cTempIndex:=cTemp

//SET INDEX TO (cTemp),(cPreBag)

MySetIndex(cTemp)

ORDSETFOCUS(nOrder)

IF VALTYPE(aSortSeek) = 'A'                        //victor FARM 4 строки
   nPozSortSeek:=GetOrd(aSortSeek)
ENDIF
AADD(sPre,{SELECT(),cTempIndex,cPreBag,nPreOrder,nPreRec,NIL,nPozSortSeek})
GO TOP
RETURN NIL
//--------------------------------------------------------------------------//
FUNCTION QSort(aSortSeek,_cColor,nTop,nLeft,Wide,lSeek,nOrd)
//--------------------------------------------------------------------------//
// Выбор вариантов сортировки, поиска
LOCAL nBottom,nRight
LOCAL aMenu:={},aNum := {}
LOCAL _cLastColor:=SETCOLOR()
LOCAL sRest
LOCAL nRet:=1, i
LOCAL aBlockKey,xKey, nPreOrder, cPreFilter
LOCAL lSetFilter:=IsSetFilter().AND.!EMPTY(ORDFOR())

IF lSetFilter //FARM-titov
    MyCloseFilter()              
ENDIF                            

nPreOrder := ORDNUMBER()
cPreFilter := ORDFOR()



sRest:=SAVESCREEN()
nOrd := IF(nStOrder = NIL,GetOrd(aSortSeek),nStOrder)

AEVAL(aSortSeek,{|x| IF(LEN(x) > 9 .AND. LEN(x) < N_REZ_SORT,(ASIZE(x,N_REZ_SORT),x[N_REZ_SORT] := {NIL,NIL,NIL,.T.}),NIL) })
IF (LEN(aSortSeek)==1 .OR. EOF().OR.LASTREC()=0)
	 IF LEN(aSortSeek)==1
     ORDSETFOCUS(IF(LEN(aSortSeek[1])<8,1,IF(ValType(aSortSeek[1,8])!="B",aSortSeek[1,8],EVAL(aSortSeek[1,8]))))
	 ENDIF
   RETURN (1)
ENDIF

nStOrder := NIL

aBlockKey:=SaveKey()
IF _cColor==NIL
   _cColor:=COL_INPUT
ENDIF
IF (nTop==NIL)
   nTop:=5
   nLeft:=MAXCOL()-MAX(18,LEN(aSortSeek[1,1]))-8
ELSEIF (nLeft>MAXCOL()-4)
   nLeft:=MAXCOL()-MAX(18,LEN(aSortSeek[1,1]))-8
ENDIF
ScrTitul(24,'┘:Выбор')
AEVAL(aSortSeek,{|x,i|;
 IF(;
     IF(;
         lSeek != NIL,;
          (;
           ; // Поиск
           LEN(x) < 14.OR.;
           ValType(x[14]) != "C";
           ).AND.;
          (;
           LEN(x) < 15.OR.;
           EMPTY(x[15]);
           ),;
          ;  // Сортировка
          (;
           LEN(x) < 13 .OR.;
           x[13] = NIL .OR.;
           !EMPTY(x[13]);
           );
       ),;
     (;
      AADD(aNum,i),;
      AADD(aMenu,' '+x[1]+' ');
      ),;
     NIL;
    );
                })
nBottom:=nTop+LEN(aNum)+1
nRight := nLeft+MAX(IF(lSeek==NIL,18,13),LEN(aSortSeek[1,1]))+2
ShadowBox(IF(lSeek==NIL,' Сортировать по: ',' Искать по: '),;
nTop,nLeft,nBottom,nRight,_cColor,,Wide)
SETCOLOR(_cColor)
i:=ACHOICE(nTop+1,nLeft+1,nBottom-1,nRight-1,aMenu,,,ASCAN(aNum,nOrd))
IF i>0
  nOrd := aNum[i]
  IF lSeek != NIL .AND. LEN(aSortSeek[nOrd]) >= N_REZ_SORT .AND. !EMPTY(aSortSeek[nOrd,N_REZ_SORT,1])
    i := NoOrYes( {'Поиск'}, 2, {' 1. с начала    ',;
                                 ' 2. продолжить  ',;
                                 ' 3. новый поиск '},6 )
    IF i = 1
      aSortSeek[nOrd,N_REZ_SORT,4] := .F.
    ELSEIF i = 2
      aSortSeek[nOrd,N_REZ_SORT,4] := .T.
    ELSE
      aSortSeek[nOrd,N_REZ_SORT,1] := NIL
    ENDIF
    IF(aSortSeek[nOrd,11] != NIL,ORDSETFOCUS(IF(ValType(aSortSeek[nOrd,11])!="B",aSortSeek[nOrd,11],EVAL(aSortSeek[nOrd,11]))),NIL)
  ELSE
    IF (lSeek != NIL .AND. LEN(aSortSeek[nOrd])>9.AND.!EMPTY(aSortSeek[nOrd,10]))
      IF(aSortSeek[nOrd,11] != NIL,ORDSETFOCUS(IF(ValType(aSortSeek[nOrd,11])!="B",aSortSeek[nOrd,11],EVAL(aSortSeek[nOrd,11]))),NIL)
    ELSE
      ORDSETFOCUS(IF(LEN(aSortSeek[nOrd])<8.OR.EMPTY(aSortSeek[nOrd,8]),nOrd,IF(ValType(aSortSeek[nOrd,8])!="B",aSortSeek[nOrd,8],EVAL(aSortSeek[nOrd,8]))))
    ENDIF
  ENDIF

  IF EMPTY(ORDSETFOCUS())
     ORDSETFOCUS(nPozSortSeek)
  ENDIF



  IF lSeek = NIL .AND. ((LEN(aSortSeek[nOrd])>9.AND.!EMPTY(aSortSeek[nOrd,10])) .OR. (LEN(aSortSeek[nOrd]) > 13 .AND.!EMPTY(aSortSeek[nOrd,14])))
    MySortSeek(aSortSeek[nOrd],nPreOrder,cPreFilter)
  ENDIF
  nPozSortSeek := nOrd
  nRet:=2
ELSE
  nOrd := 0
ENDIF
SETCOLOR(_cLastColor)
RestKey(aBlockKey)
RESTSCREEN(,,,,sRest)
SETLASTKEY(0)
RETURN (nRet)

//--------------------------------------------------------------------------//
FUNCTION QPrint(aPHeads,block,bFooter,bSayHead,bKeyHead,aGroup)
//--------------------------------------------------------------------------//
PLOCAL nCo,cFi,cAlias,cFile:=TEMPFILE( GlobalTmpPath )
PLOCAL nRecNo:=RECNO()
PLOCAL aFields:={}
PLOCAL cFormat:='│'
PLOCAL cHead,cField,cPict,cPict0,nField
PLOCAL cHead0:='┌',cHead1:='│',cHead2:='├'
PLOCAL aBlockKey:=SaveKey()
PLOCAL aTot:={}
IF (EOF().OR.LASTREC()=0)
 RestKey(aBlockKey)
 RETURN (1)
ENDIF
FOR nCo:=2 TO LEN(aPHeads)
cField:=IF(VALTYPE(aPHeads[nCo])=='A',aPHeads[nCo,2],Field(nCo-1))
//AADD(aFields,FiName(cField))
AADD(aFields,cField)
nField:=FiNum(cField)
cAlias:=FiAlias(cField)
IF ((cAlias)->(FIELDTYPE(nField))=='N')
   cPict0:=REPLICATE('9',(cAlias)->(FIELDSIZE(nField)))
   cPict0:=STUFF(cPict0,LEN(cPict0)-(cAlias)->(FIELDDECI(nField)),1,'.')
ELSE
   cPict0:=REPLICATE('X',(cAlias)->(FIELDSIZE(nField)))
ENDIF
cPict:=IF((VALTYPE(aPHeads[nCo])=='A'.AND.LEN(aPHeads[nCo])>2).AND.aPHeads[nCo,3]!=NIL,;
aPHeads[nCo,3],cPict0)
cFormat+=cPict+'│'
IF VALTYPE(aPHeads[nCo])=='A'.AND.LEN(aPHeads[nCo])>3.AND.aPHeads[nCo,4]!=NIL;
.AND.aPHeads[nCo,4]
   AADD(aTot,nCo-1)
ENDIF
cHead:=IF(VALTYPE(aPHeads[nCo])=='A',IF(ValType(aPHeads[nCo,1]) = "C",aPHeads[nCo,1],EVAL(aPHeads[nCo,1])),aPHeads[nCo])
cHead0+=REPLICATE('─',LEN(cPict))+'┬'
cHead1+=CENTER(cHead,LEN(cPict),.T.)+'│'
cHead2+=REPLICATE('─',LEN(cPict))+'┼'
NEXT
cHead0:=LEFT(cHead0,LEN(cHead0)-1)+'┐'
cHead2:=LEFT(cHead2,LEN(cHead2)-1)+'┤'
GO TOP
IF TotRep({PADC(IF(ValType(aPHeads[1])=="B", EVAL(aPHeads[1]), aPHeads[1]),LEN(cFormat))},aFields,{cHead0,cHead1,cHead2},;
   cFormat,aTot,aGroup,bFooter,cFile,,.T.,.T.,LASTREC(),,,,block,;
   ,,,,,,,bSayHead,bKeyHead)>0
   View(cFile,LASTREC(),LEN(cFormat))
ENDIF
GO nRecNo
RestKey(aBlockKey)
RETURN (1)

// --------------1------2-----3----4-----5-----6----7-----8-----9-------10-----------11-----12-----13--     14          15        16
FUNCTION QHelp(cMess,cMess1,nGet,xKey,cField,nTop,nLeft,bPost,nOrd0,lNoClearScope,lNoHand,lNoGen,lNoAddRec, cPrefiks,lAddRec,lNoClearFilt)
//Процедура должна использоваться только в среде InitList(), т.к. она
//для работы в сети резервирует запись (если nGet указан), а потом
// если был отказ, то стирает в qInput()
//cMess-помощь на 24 строке ('...'-стандартное сообщение)
//cMess1-подсказка на 22 строке
//nGet - номер Get, который увеличивается
//xKey - значение индекса для поиска первого превышающего значения (по xKey++)
//cField-имя поля для инициализации aIn[nGet],
//по умолчанию номер поля==номеру Get
//nTop,nLeft-координаты для сообщения о справочнике
//bPost - блок дозаписи в базу (он нужен для дозаписи полного ключа при
//резервировании записи,если ключ включает в себя еще поля,кроме cField,
//т.к. иначе не проверить правильно уникальность)
//NoClearScope - если присутствует, то Scope() перед поиском последней строки
//не убирается
//lNoHand - для группового ввода (не ручками) (Обязательно: cField, nOrd0)
//lNoGen - не генерить новый код НЕОБХОДИМО ОБЕСПЕЧИТЬ ОДНОКРАТНОСТЬ ВЫЗОВА
// lNoAddRec - не добавлять новую запись
// lAddRec - добавлять вне зависимости от того, сформировался ли новый номер
PLOCAL nRec:=RECNO(),xNext,c
PLOCAL currFilter:=DBFILTER(),aScope:=GetScope()
PLOCAL nOrd:=ORDNUMBER()
PLOCAL nField:=IF(cField==NIL,nGet,FIELDNUM(cField))
PLOCAL nWindow:=WSELECT()
PLOCAL nArea:=ASCAN(sPre,{|x|x[1]==SELECT()})
PLOCAL cTempIndex:=IF(EMPTY(nArea),NIL,sPre[nArea,2])
PLOCAL cNext
IF(EMPTY(lNoHand),lNoHand:=.F.,)
IF(EMPTY(lNoGen),lNoGen:=.F.,lNoGen:=.T.)
lNoAddRec = !Empty(lNoAddRec)

IF lNoClearFilt==NIL
   SET FILTER TO
ENDIF

IF lNoClearScope==NIL
   SetScope()
ENDIF
ORDSETFOCUS(TOP_TAG(nOrd0))

  //  Обработка префиксов
  // работает только для символьных ключей
  IF !EMPTY( cPrefiks )
    cPrefiks := UPPER(cPrefiks)
    IF     xKey == NIL          ; xKey := cPrefiks
    ELSEIF ValType(xKey) == 'C' ; xKey += cPrefiks
    ENDIF
  ENDIF

IF (statCod==NIL .AND. cMess!=NIL)
   IF cMess=='...'
      DO CASE
         CASE nApp==0
         cMess:='Пустое поле:безразличный фактор'
         CASE nApp==1
         cMess:='┘:Ввод  PgDn/PgUp:Вперед/Назад'
         CASE nApp==2
         cMess:='┘:Ввод  PgDn:Досрочный ввод'
      ENDCASE
   ENDIF
   WSELECT(0)
   ScrTitul(24,cMess)
   WSELECT(nWindow)
ENDIF
IF (nGet!=NIL .AND. nApp==2 .AND. (LASTKEY()!=K_UP)).OR.lNoHand
   IF !lNoGen
      IF (xKey!=NIL.AND.!EMPTY(xKey))
         IF (VALTYPE(xKey)=='N')
            xNext:=++xKey
         ELSE  //символьная строка
            c:=ASC(SUBSTR(xKey,-1))
            c++
            xNext:=SUBSTR(xKey,1,LEN(xKey)-1)+CHR(c)
         ENDIF
         DBSEEK(xNext,.T.)
         SKIP -1
         IF (!(xKey=LEFT(&(INDEXKEY()),LEN(xKey))))
            GO LASTREC()+1
         ENDIF
      ELSE
         GO BOTTOM
      ENDIF
      xKey:=FIELDGET(nField)

      IF !EMPTY(cPrefiks)  // добавление префикса //ALEX
         IF EMPTY( xKey ) ;  CHARREPL( ' ', @xKey, '0', .T.) ;   ENDIF
         xKey := STUFF(xKey, 1, LEN(cPrefiks), cPrefiks)
      ENDIF

      IF lNoHand
         cNext:= Next(xKey)
      ELSE
      aIn[nGet]:=aLastIn[nGet]:=Next(xKey)
      IF !lNoInt // Для импорта в инитлист!!! 18 января 2005 Вася
                GetList[nGet]:display()
      ENDIF
      ENDIF
   ENDIF
   IF (lNoHand.OR.xKey!=aIn[nGet].OR.!EMPTY(lAddRec) )
      IF (lNoAddRec.AND.(dbGoto(nRec),.T.)) .OR. AddRec()
         nRec:=RECNO()
         If RecLock()
            FIELDPUT(nField,IF(lNoHand, cNext, aIn[nGet]))
            IF (bPost!=NIL)
               EVAL(bPost)
            ENDIF
         ENDIF
      IF(!lNoHand,lWasApp:=.T.,) //STATIC!!!
//      UNLOCK  !!!! Это правильно закомментировано (из-за наворотов в сети) !!!!!
         COMMIT
      ELSE
         Error_Lock()
         KEYBOARD CHR(K_ESC)
      ENDIF
   ENDIF
ENDIF
ORDSETFOCUS(nOrd)
IF !EMPTY(currFilter)
  dbSetFilter(&("{||"+currFilter+"}"),currFilter)
ENDIF
SetScope(aScope)
GO nRec
RETURN (.T.)
//--------------------------------------------------------------------------//
                              FUNCTION Next(xKey)
//--------------------------------------------------------------------------//
// Возвращает следующее значение номера (числового или cтрингового)
PLOCAL cRet:=xKey,_nLen,_nLen1,x,y:='',z:='',i,j,lYes:=.T.,nPosSpace,nPoz, nLenStr, nLenDec, nPozZero, cInc, lNext := .F., aPoz:={}, nTmp, cTmp:=""
PRIVATE _nLen2
IF (VALTYPE(xKey)=='N'.OR.VALTYPE(xKey)=='D')
   cRet:=++xKey
ELSEIF (VALTYPE(xKey)=='C')
  IF (nPoz := POSRANGE(48,57,CHARMIRR(xKey),.F.)) > 0
    nPoz := LEN(xKey)-nPoz+1
    IF((nLenStr := POSRANGE(32,32,CHARMIRR(LEFT(xKey,nPoz-1)),.T.)-1) < 0,nLenStr := 0,NIL)
    IF((nLenDec := POSRANGE(48,57,SUBSTR(xKey,nPoz),.T.)-1) < 0,nLenDec := LEN(xKey)-nPoz+1,NIL)
    cRet := IF(nPoz-nLenStr-1 > 0,SUBSTR(xKey,1,nPoz-nLenStr-1),"")
    nPozZero := POSRANGE(48,48,SUBSTR(xKey,nPoz,nLenDec),.T.)-1
    cRet := IF((lNext := (cInc := STR(VAL(SUBSTR(xKey,nPoz,nLenDec))+1,nLenStr+nLenDec,0)) != "*"),IF(nPoz-nLenStr-1 > 0,SUBSTR(xKey,1,nPoz-nLenStr-1),"")+PADL(LTRIM(cInc),nLenStr+nLenDec,IF(nPozZero > 0,"0"," "))+SUBSTR(xKey,nPoz+nLenDec),xKey)
  ENDIF
  IF !lNext
    _nLen:=LEN(xKey)
    _nLen2:=_nLen
    IF EMPTY(xKey)
       cRet:=xKey:=STRTRAN(SPACE(_nLen),' ','0')
    ENDIF
    x:=TRIM(xKey)
    _nLen1:=LEN(x)
    IF POSRANGE('0','9',x,.T.)>0
       FOR i:=LEN(x) TO 1 STEP -1
       IF !SUBSTR(x,i,1)$' 0123456789'
          EXIT
       ENDIF
       NEXT
       IF i<LEN(x)
          y:=LEFT(x,i)
          x:=SUBSTR(x,i+1)
          _nLen1:=LEN(x)
       ELSE
          FOR i:=1 TO LEN(x)
          IF !SUBSTR(x,i,1)$' 0123456789'
             EXIT
          ENDIF
          NEXT
          IF i>1
             _nLen1:=i-1
             z:=SUBSTR(x,_nLen1+1)
             x:=LEFT(x,i-1)
          ELSE
             lYes:=.F.
          ENDIF
       ENDIF
    ENDIF
    IF lYes
       IF LEFT((cRet:=STR(VAL(x)+1,_nLen1,0)),1)='*'
          cRet:=STR(VAL(x)+1,_nLen1+1,0)
       ENDIF
       FOR i:=1 TO LEN(x)
       IF SUBSTR(x,i,1)!=' '
          EXIT
       ENDIF
       NEXT
       IF SUBSTR(x,i,1)=='0'
          cRet:= SPACE(i-1)+SUBSTR(STRTRAN(cRet,' ','0'),i)
       ENDIF
       IF EMPTY(z).AND.LEN(y+cRet+z)>_nLen
          cRet:=SUBSTR(cRet,2)
       ENDIF
       cRet:=PADR(y+cRet+z,_nLen)
    ELSE
       //sos
       FOR i:=1 TO LEN(x)
        IF SUBSTR(x,i,1)$' 0123456789'
          aAdd(aPoz,i)
        ENDIF
       NEXT
       FOR i:=1 TO LEN(aPoz)
         cTmp+=SUBSTR(x,aPoz[i],1)
       NEXT
       nTmp:=Val(cTmp)+1
       cTmp:=if(len(aPoz)<>len(alltrim(str(nTmp))),SUBSTR(alltrim(str(nTmp)),2),alltrim(str(nTmp)))
       cRet:=""
       FOR i:=1 TO LEN(x)
        IF ASCAN(aPoz,{|y| y==i})>0
         cRet+=SUBSTR(cTmp,ASCAN(aPoz,{|y| y==i}),1)
        ELSE
         cRet+=SUBSTR(x,i,1)
        ENDIF
       NEXT
       IF TYPE('_nLen2')='N'
         cRet:=PADR(cRet,_nLen2)
       ENDIF
    ENDIF
    /*
   c:=ASC(SUBSTR(xKey,-1))
   c++
   cRet:=SUBSTR(xKey,1,LEN(xKey)-1)+CHR(c)
   */

  ENDIF
ENDIF
RETURN (cRet)


//----------------------------------------------------------------------------//
FUNCTION ToRight(nGet,lDopoln,Filter)
//----------------------------------------------------------------------------//
//lDopoln - .T. до дополнение номера
//lFilter - если есть,то реакция на звездочку
PLOCAL i,j
PLOCAL get:=GETLIST[nGet]

IF (get:hasFocus)
   IF Filter=NIL.OR.RIGHT(ALLTRIM(get:buffer),1)='*'
      Filter:=0
   ELSEIF Filter!=NIL
      Filter:=1
   ENDIF
   IF EMPTY(lDopoln)
     i:=LEN(get:buffer)
     j:=LEN(TRIM(get:buffer))
     get:buffer:=SPACE(i-j-Filter)+TRIM(get:buffer)+SPACE(Filter)
   ELSE
     get:buffer:=ObrabotkaNom(get:buffer)
   ENDIF
   get:assign()
ENDIF
RETURN(.T.)

FUNCTION ToRightF(nGet,lDopoln,_nLen)
RETURN ToRight(nGet,lDopoln,'Filter')

//----------------------------------------------------------------------------//
                   FUNCTION ObrabotkaNom(cNomer)
//----------------------------------------------------------------------------//
// Дополнение номера и сдвиг вправо
PLOCAL _nLenCode := LEN(cNomer)
cNomer := REMRIGHT(cNomer," ")
IF _FILL_YES .AND. !EMPTY(cNomer) .AND. cNomer != "*" .AND. IF(TYPE("nApp") = "N",MemVar->nApp != 0,.T.)
   cNomer := REMLEFT(cNomer," ")
   cNomer := REMLEFT(cNomer,"0")
   cNomer := PADLEFT(cNomer,_nLenCode,_FILL_DOC)
ELSE
   cNomer := PADLEFT(cNomer,_nLenCode)
ENDIF
RETURN cNomer

FUNCTION Error_Use()
SayError("Таблица не открыта или заблокирована!")
RETURN (NIL)

FUNCTION Error_Lock()
IF _REC_YES
   SayError("Запись редактируется другим пользователем!")
ENDIF
RETURN (NIL)


FUNCTION Keyb(Cod,Cod1)
IF (Cod1==NIL)
   KEYBOARD CHR(Cod)
ELSE
   KEYBOARD CHR(Cod)+CHR(Cod1)
ENDIF
RETURN (1)

FUNCTION InitScreen(cHead,cHead1,cColHead,lAllScreen,cHelp,lNoDouble,nTop,nBottom,lRet) //Стандартная подготовка экрана для InitList()
// если lRet не NIL вернуть координаты рамки в массиве
PLOCAL x1:=0,x2:=MAXCOL(),y1:=2,y2:=22
IF (lAllScreen == NIL)
   IF (VALTYPE(cColHead)='A')
      cColHead:=cColHead[1]
   ENDIF
   y1:=IF(EMPTY(nTop),3,nTop);y2:=IF(EMPTY(nBottom),21,nBottom)// Serg
   y1:=3;y2:=21
   x1:=INT((80-LEN(cColHead))/2)-1
   x2:=x1+LEN(cColHead)+1
   ScrMain()
ENDIF
IF EMPTY(lNoDouble)   //Serg
   ShadowBox('',y1,x1,y2,x2,COL_BROWSE)
ELSE
  // !! Dimon
  x1 := &("Frame(,"+NTOC(y1)+","+NTOC(x1)+","+NTOC(y2)+","+NTOC(x2)+",'"+COL_BROWSE+"', 1, 1)")
ENDIF
IF !EMPTY(cHead1)
   SAYSCREEN(CENTER(TRIM(cHead1),x2-x1-1),y1+1,x1+1)
   SAYSCREEN('╟'+REPLICATE('─',x2-x1-1)+'╢',y1+2,x1)
ENDIF
ScrTitul(1,cHead)
Help0(cHelp)
RETURN IF(lRet=NIL,(NIL),{y1,x1,y2,x2})

FUNCTION Help0(cHelp)  //Отображение стандартной помощи для InitList()
IF cHelp=NIL
  IF _REC_YES
     ScrTitul(24,CHR(17)+"┘:Правка F4:Ввод F3:Сорт F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F8:Удал F9:Печать")
  ELSE
    ScrTitul(24,"F3:Сорт F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F9:Печать")
  ENDIF
ELSE
   ScrTitul(24,cHelp)
ENDIF
RETURN (NIL)

FUNCTION StrS(n,_nLen,nDec) //Если 0, то выдает пробелы, иначе преобразовывает в стринг
PLOCAL cRet
//Если _nLen -  двумерный массив, то ищет значение n по левому столбцу массива
//выдает соответствующее значение правого столбца
IF nDec=NIL
   nDec:=0
ENDIF
DO CASE
   CASE VALTYPE(n)=='D'
   RETURN IF(EMPTY(n),SPACE(8),DTOC(n))
   CASE (_nLen==NIL)
   RETURN IF(n==0,SPACE(LEN(STR(n))),STR(n))
   CASE VALTYPE(_nLen)='A'
   RETURN IF((nDec:=ASCAN(_nLen,{|x|x[1]==n}))==0,SPACE(LEN(_nLen[1,2])),_nLen[nDec,2])
ENDCASE
WHILE (cRet:=IF(n==0,SPACE(_nLen),STR(n,_nLen,nDec)))='*'.AND.nDec>0;nDec--;ENDDO
RETURN cRet


FUNCTION LockStrH(Name,Var,Old,lAllTrim)
IF (ValType(Var) == "C".AND.VALTYPE(Old)!='L')
   IF lAllTrim==NIL
      RETURN 'TRIM(UPPER('+Name+'))'
   ELSE
      RETURN 'ALLTRIM(UPPER('+Name+'))'
   ENDIF
ENDIF
RETURN(Name)

FUNCTION LockStrF(Var,lFull,Old)
DO CASE
   CASE ValType(Var) == "C"
   IF (lFull==NIL)
      IF (VALTYPE(Old)=='L')
        RETURN IF(Var=='0','.F.','.T.')
      ELSE
        RETURN IIf(']' $ Var,"'","[") + TRIM(UPPER(Var)) + IIf(']' $ Var,"'","]")
      ENDIF
   ELSE
      RETURN IF('"' $ Var,'[' + Var + ']',;
                          '"' + Var + '"'  )
   ENDIF
   CASE ValType(Var) == "N"   ;      RETURN AllTrim(Str(Var))
   CASE ValType(Var) == "D"   ;      RETURN 'Ctod("'+ Dtoc(Var) + '")'
   CASE ValType(Var) == "L"   ;      RETURN If(Var,'.T.','.F.')
ENDCASE
RETURN NIL

STATIC FUNCTION FiIn(cString,aHeads)
  //Заменяет в стринге имена полей на элементы массива 'aIn[...]'
  PLOCAL nCo,cTok,nTok,iFi
  PLOCAL cSep:=',(){}"'+"'[]/*+% "+Chr(13)+Chr(10)
//  PLOCAL cSep:=',(){}"'+"'[]/*-+% "+Chr(13)+Chr(10) Изменил Богданов
  FOR nCo = 1 TO NUMTOKEN( cString, cSep )
    cTok := UPPER(TRIM(TOKEN(cString,cSep,nCo)))
    iFi := ASCAN(aHeads,{|x|UPPER(TRIM(x[2])) == cTok})
    IF (iFi > 0)
      nTok := ATTOKEN(cString,cSep,nCo)
      cString:=STUFF(cString,nTok,LEN(cTok),'aIn['+STR(iFi,IF(iFi>9,2,1),0)+']')
    ENDIF
  NEXT
RETURN (cString)

STATIC FUNCTION SaveKey()
RETURN {SaveSetKey(),nTopi,nLefti,nBottomi,nRighti,sResti}

STATIC FUNCTION RestKey(aBlockKey)
RestSetKey(aBlockKey[1])
nTopi:=aBlockKey[2]
nLefti:=aBlockKey[3]
nBottomi:=aBlockKey[4]
nRighti:=aBlockKey[5]
sResti:=aBlockKey[6]
RETURN(NIL)
//--------------------------------------------------------------------------//
STATIC FUNCTION MyInputFrame(aPos,aReader,aGetBlock,aPict,aWhen,aValid,aHeads,lSpec, bPreGet,lGetBlock,bRestSave,aSave)
//--------------------------------------------------------------------------//
PLOCAL nFi,nY1,nX1,cPict,lenPict
PLOCAL lUpdated:=.F.
PLOCAL lRefer:=IF(lSpec!=NIL .AND. lSpec=="REFER",.T.,.F.)
PLOCAL lReadExit:=READEXIT(.F.)
PLOCAL oGet, bWhen,nProces,nApp0:=nApp
PLOCAL lArrayFil := .F.

aSave := {aGetBlock,aValid,aIn,IF(bRestSave = NIL,{|| NIL },bRestSave),IF(bRestSave = NIL,NIL,EVAL(bRestSave)),GetList,NIL,NIL}

PRIVATE cParam,cWhen



lPlugGetBlock := IsRunPlugIns("ДОКУМЕНТ","ИЗМЕНЕНИЕ_ПОЛЯ")
lPlugValid := IsRunPlugIns("ДОКУМЕНТ","ВЫХОД_ИЗ_ПОЛЯ")

IF( VALTYPE( bPreGet  ) <> 'B', bPreGet := {||NIL}, )

IF LEN(aHeads)>40.AND.nApp>=0.AND.!lNoInt // <--- добавлено для импорта! Вася 18 января 2005
   nProces := Proces_Ini(LEN(aHeads),,,"Подготовка формата")
ENDIF
FOR nFi:=1 TO LEN(aHeads)
IF nApp>=0
  IF (LEN(aHeads)>40).AND.!lNoInt // <--- добавлено для импорта! Вася 18 января 2005
       Proces_Update(nProces)
  ENDIF

  IF (lArrayFil := (VALTYPE(aIn[nFi])=='A'.AND.nApp==0) .AND.;
      !(aReader!=NIL .AND. LEN(aReader) >=nFi .AND. aReader[nFi]!=NIL))
     oGet := GETNEW(aPos[nFi,1],;
                    aPos[nFi,2],;
                    _bGetaInij(nFi,1),;
                    {"aIn[" + NToC(nFi) + ",1]",aSave,nFi,1,NIL,{},NIL,aHeads[nFi,2]})
     IF (aPict!=NIL .AND. LEN(aPict) >=nFi .AND. ;
            aPict[nFi]!=NIL .AND. ValType(aPict[nFi])=="C")
           oGet:Picture :=  aPict[nFi]
     ENDIF
     IF (aWhen!=NIL .AND. LEN(aWhen) >=nFi .AND. aWhen[nFi]!=NIL)
         IF(ValType(aWhen[nFi])=="B")
           oGet:PreBlock :=   aWhen[nFi]
         ELSE
           cParam := aWhen[nFi]
           oGet:PreBlock :=    _Compile(cParam)
        ENDIF
     ELSEIF (lRefer .AND. nFi==1)
          if OnRefer != NIL.and.SetOnRefer()
             oGet:PreBlock := &("{||QHelp(,,1)}")
          end
     ENDIF
     IF LEN(aIn[nFi]) > 0
       IF ValType(aIn[nFi,1]) = "N"
         oGet:postBlock := _Compile("MaxNumber(aIn["+NTOC(nFi)+",1])")
       ELSEIF ValType(aIn[nFi,1]) = "D"
         oGet:postBlock := _Compile("MaxData(aIn["+NTOC(nFi)+",1])")
       ENDIF
     ENDIF

   if Len(aHeads[nFi]) < 8 .OR. ( aHeads[nFi,8] <> 0 ) // сказал не выводи - значит не выводим azat 25.11.2004 попросил Вася
     AADD(GetList, oGet)
   endif
    // Было так:  AADD(GetList, oGet)
     IF lGetBlock
      IF (aGetBlock!=NIL .AND. LEN(aGetBlock) >=nFi .AND. ;
         aGetBlock[nFi]!=NIL .AND. ValType(aGetBlock[nFi])=="B")
         oGet:Block := &("{|x| _RunGetBlock(x,"+NTOC(LEN(GetList))+") }")
      ENDIF
     ENDIF


     lenPict := IF((lenPict := IF(aPict==NIL .OR. LEN(aPict)<nFi .OR. aPict[nFi]==NIL,0,LEN(TRANSFORM(SPACE(100),aPict[nFi])))) = 100,0,lenPict)

     lenPict:=MAX(lenPict,IF(lenPict==0 .AND. (FiAlias(aHeads[nFi,2]))->(FieldPos(FiName(aHeads[nFi,2]))) != 0,;
     (FiAlias(aHeads[nFi,2]))->(FIELDSIZE(FiNum(aHeads[nFi,2]))),lenPict))
 	        if Len(aHeads[nFi]) < 8 .OR. ( aHeads[nFi,8] <> 0 ) // сказал не выводи - значит не выводим azat 25.11.2004 попросил Вася
		     SAYSCREEN('-',aPos[nFi,1],aPos[nFi,2]+lenPict+1)
        	endif
		//Было так:    SAYSCREEN('-',aPos[nFi,1],aPos[nFi,2]+lenPict+1)

     oGet := GETNEW(aPos[nFi,1],;
                    aPos[nFi,2]+lenPict+3,;
                    _bGetaInij(nFi,2),;
                    {"aIn[" + NToC(nFi) + ",2]",aSave,nFi,2,NIL,{},NIL,aHeads[nFi,2]})

     IF lGetBlock
      IF (aGetBlock!=NIL .AND. LEN(aGetBlock) >=nFi .AND. ;
         aGetBlock[nFi]!=NIL .AND. ValType(aGetBlock[nFi])=="B")
         oGet:Block := &("{|x| _RunGetBlock(x,"+NTOC(LEN(GetList)+1)+") }")
      ENDIF
     ENDIF

  ELSE
    oGet := GETNEW(aPos[nFi,1],;
                   aPos[nFi,2],;
                   &("{|x|IF(x!=NIL,aIn[" +NTOC(nFi)+ "]:=x,aIn[" +NTOC(nFi)+ "])}"),;
                   {"aIn[" + NToC(nFi) + "]",aSave,nFi,0,NIL,{},NIL,aHeads[nFi,2]})

  ENDIF
   IF (aPict!=NIL .AND. LEN(aPict) >=nFi .AND. ;
         aPict[nFi]!=NIL .AND. ValType(aPict[nFi])=="C")
        oGet:Picture :=  aPict[nFi]
   ENDIF
   IF lArrayFil
      cParam := "_preFilterFunc("+STR(nFi)+")"
      oGet:preBlock :=    _Compile(cParam)
      IF LEN(aIn[nFi]) > 0
        IF ValType(aIn[nFi,2]) = "N"
          oGet:postBlock := _Compile("MaxNumber(aIn["+NTOC(nFi)+",2])")
        ELSEIF ValType(aIn[nFi,2]) = "D"
          oGet:postBlock := _Compile("MaxData(aIn["+NTOC(nFi)+",2])")
        ENDIF
      ENDIF
   ELSE
      IF (aReader!=NIL .AND. LEN(aReader) >=nFi .AND. aReader[nFi]!=NIL)
         IF (ValType(aReader[nFi])=="B")
            oGet:Reader :=  aReader[nFi]
         ELSE
            cParam := aReader[nFi]
            oGet:Reader := _ReferReader(cParam)
         ENDIF
      ENDIF
      IF (aValid!=NIL .AND. LEN(aValid) >=nFi .AND. aValid[nFi]!=NIL)
         IF (ValType(aValid[nFi])=="B")
            oGet:PostBlock := &("{|| _RunValidBlock("+NTOC(LEN(GetList)+1)+") }")
         ELSE
            cParam := aValid[nFi]
            IF ValType(aIn[nFi]) = "N"
               cParam := "MaxNumber(aIn["+NTOC(nFi)+"]) .AND. "+cParam
            ELSEIF ValType(aIn[nFi]) = "D"
               cParam := "MaxData(aIn["+NTOC(nFi)+"]) .AND. "+cParam
            ENDIF
            oGet:PostBlock :=    _Compile(cParam)
            IF 'RIGHTF'$UPPER(cParam)
               DEF_CARGO(oGet):=.F.
            ELSEIF 'RIGHT'$UPPER(cParam)
               DEF_CARGO(oGet):=.T.
            ENDIF
         ENDIF
      ELSEIF ValType(aIn[nFi]) = "N"
         oGet:postBlock := _Compile("MaxNumber(aIn["+NTOC(nFi)+"])")
      ELSEIF ValType(aIn[nFi]) = "D"
         oGet:postBlock := _Compile("MaxData(aIn["+NTOC(nFi)+"])")
      ENDIF
      cWhen:=''
      IF (aWhen!=NIL .AND. LEN(aWhen) >=nFi .AND. aWhen[nFi]!=NIL)
         IF(ValType(aWhen[nFi])=="B")
           oGet:PreBlock :=   aWhen[nFi]
         ELSE
           cParam := aWhen[nFi]
           cWhen:=cParam
           oGet:PreBlock :=    _Compile(cParam)
         ENDIF
      ELSEIF (lRefer .AND. nFi==1)
      if OnRefer != NIL.and.SetOnRefer()
          oGet:PreBlock := &("{||QHelp(,,1)}")
      end
      ENDIF
      IF (aGetBlock!=NIL .AND. LEN(aGetBlock) >=nFi .AND. ;
         aGetBlock[nFi]!=NIL .AND. ValType(aGetBlock[nFi])=="B")
         oGet:Block := &("{|x| _RunGetBlock(x,"+NTOC(LEN(GetList)+1)+") }")
      ENDIF
   ENDIF
   if Len(aHeads[nFi]) < 8 .OR. ( aHeads[nFi,8] <> 0 ) // сказал не выводи - значит не выводим azat 25.11.2004 попросил Вася
     AADD(GetList, oGet)
   endif

  // Было так: AADD(GetList, oGet)
ENDIF
NEXT
IF nApp>=0.AND.LEN(aHeads)>40.AND.!lNoInt // <--- добавлено для импорта! Вася 18 января 2005
  Proces_End(nProces)
ENDIF

RETURN NIL

FUNCTION _preFilterFunc(nFi)
IF !EMPTY(aIn[nFi,1]).AND.(EMPTY(aIn[nFi,2]).OR.aIn[nFi,2]<aIn[nFi,1])
   aIn[nFi,2]:=aIn[nFi,1]
ENDIF
RETURN .T.
//--------------------------------------------------------------------------//
                    FUNCTION _RunGetBlock(x,nPoz)
//--------------------------------------------------------------------------//
PLOCAL oGet := GetList[nPoz]
PLOCAL aOldIn,aOldData,aInfo
aInfo := oGet:name
aOldIn := aIn
aOldData := EVAL(aInfo[2,4],aInfo[2,5])
aIn := aInfo[2,3]
IF lPlugGetBlock
  x := RunPlugIns("ДОКУМЕНТ","ИЗМЕНЕНИЕ_ПОЛЯ",{|| EVAL(aInfo[2,1,aInfo[3]],x,oGet,aInfo[4],lDisplay) },x,oGet,aInfo[4],lDisplay)
ELSE
  x := EVAL(aInfo[2,1,aInfo[3]],x,oGet,aInfo[4],lDisplay)
ENDIF

aInfo[5] := IF(aInfo[4] = 0,aIn[aInfo[3]],aIn[aInfo[3],aInfo[4]])
aIn := aOldIn
EVAL(aInfo[2,4],aOldData)
RETURN x
//--------------------------------------------------------------------------//
                    FUNCTION _RunValidBlock(nPoz)
//--------------------------------------------------------------------------//
PLOCAL x := .T., oGet := GetList[nPoz]
PLOCAL aOldIn,aOldData,aInfo
aInfo := oGet:name
aOldIn := aIn
aOldData := EVAL(aInfo[2,4],aInfo[2,5])
aIn := aInfo[2,3]
IF oGet:type = "N"
 x := MaxNumber(IF(aInfo[4] = 0,aIn[aInfo[3]],aIn[aInfo[3],aInfo[4]]))
ELSEIF oGet:type = "D"
 x := MaxData(IF(aInfo[4] = 0,aIn[aInfo[3]],aIn[aInfo[3],aInfo[4]]))
ENDIF

IF x
  IF lPlugValid
    x := RunPlugIns("ДОКУМЕНТ","ВЫХОД_ИЗ_ПОЛЯ",{|| EVAL(aInfo[2,2,aInfo[3]],oGet,aInfo[4]) },oGet,aInfo[4])
  ELSE
    x := EVAL(aInfo[2,2,aInfo[3]],oGet,aInfo[4])
  ENDIF
ENDIF

aIn := aOldIn
EVAL(aInfo[2,4],aOldData)
IF VALTYPE(x)="U"
   x:=.T.
ENDIF
RETURN x
// 3.800

/******************************************************
STATIC FUNCTION fBlock()
// Блокировка ввода в текущую Get-переменную
PLOCAL nGet:=CURRENTGET(),oGet:=GETACTIVE()
PLOCAL nCo:=0
IF (nGet > 0)
   AEVAL(m->GetList,{|x|IF(x:preblock==NIL.OR.EVAL(x:preblock),++nCo,NIL)})  //Если не последний,то блокируем
   IF (nCo > 1)
      oGet:preBlock:={||(.F.)}
      aEd[nGet] := .f.
      oGet:colorDisp(COL_INPUTB)
      KEYBOARD CHR(K_DOWN)
   ENDIF
ENDIF
RETURN (NIL)
*********************************************/

STATIC FUNCTION FiNum(cField)
RETURN FiNumAlias(cField,1)

STATIC FUNCTION FiAlias(cField)
RETURN FiNumAlias(cField,2)

FUNCTION FiName(cField)
RETURN FiNumAlias(cField,3)

FUNCTION FiArea(cField)
RETURN FiNumAlias(cField,4)


STATIC FUNCTION FiNumAlias(cField,nMode)
PLOCAL cAlias,cFi
// __HARBOUR__
IF LEFT(UPPER(cField),8)='MEMVAR->'
   cField:=SUBSTR(cField,9)
ELSEIF LEFT(UPPER(cField),3)='M->'
   cField:=SUBSTR(cField,4)
ENDIF

IF ('->'$cField)
   cAlias:=LEFT(cField,AT('->',cField)-1)
   IF(")->" $ cField,cAlias := &cAlias,NIL)
   cFi:=SUBSTR(cField,AT('->',cField)+2)

   IF SELECT(cAlias)=0 //поправил для HARBOUR, но для всех пригодится == titov
      cAlias:=ALIAS()
      cFi:=cField
   ENDIF
ELSE
   cAlias:=ALIAS()
   cFi:=cField
ENDIF
DO CASE
   CASE (nMode==1)
   RETURN (cAlias)->(FIELDPOS(cFi))
   CASE (nMode==2)
   RETURN (cAlias)
   CASE (nMode==3)
   RETURN (cFi)
ENDCASE
RETURN (SELECT(cAlias))

STATIC FUNCTION GetOrd(aSort)
PLOCAL nRet
IF LEN(aSort[1])<8
   RETURN ORDNUMBER()
ENDIF
nRet:=ASCAN(aSort,{|x|;
 IF(LEN(x) > 9 .AND. !EMPTY(x[10]),;
 ( VALTYPE(x[11])=='C'.AND.UPPER(x[11])==ORDSETFOCUS() ) ;
  .OR.;
 ( VALTYPE(x[11])=='N'.AND.x[11]==ORDNUMBER() ) ;
  .OR.;
 ( VALTYPE(x[11])=='B'.AND.UPPER(EVAL(x[11]))==ORDSETFOCUS() ) ,;
 ( VALTYPE(x[8])=='C'.AND.UPPER(x[8])==ORDSETFOCUS() ) ;
  .OR.;
 ( VALTYPE(x[8])=='N'.AND.x[8]==ORDNUMBER() ) ;
  .OR.;
 ( VALTYPE(x[8])=='B'.AND.UPPER(EVAL(x[8]))==ORDSETFOCUS() );
  );
                  })
RETURN IF(nRet==0,IF(!EMPTY(nPozSortSeek),nPozSortSeek,1),nRet)

FUNCTION IniString(cFindMacro,cFltr0) //cFind - макро для поиска и фильтрации,cFltr0-исходный фильтр
PLOCAL cSumFilter,bOldFindBlock:=bFindBlock
IF EMPTY(cFltr0)
   cFltr0:='.T.'
ENDIF
cFind:=SPACE(50)
cSumFilter:= ScopeMacro()+'.AND.('+ cFltr0 +')'+'.AND.('+ cFindMacro +')'
bFindBlock:=&('{||'+cSumFilter+'}')
RETURN(bOldFindBlock)

FUNCTION SetFindBlock(bOldFindBlock)
bFindBlock:=bOldFindBlock
RETURN(NIL)

FUNCTION FindName()
PLOCAL nWin:=WSELECT(),nWin1
PLOCAL lYes,sRest
PLOCAL aSetKey:=SaveSetKey(),;
      nRec:=0, bScope,;
      nCursor:=SETCURSOR(0)
WSELECT(0)
sRest:=SAVESCREEN()
IF !EMPTY(cFind).AND.!EMPTY(bFindBlock)
   nRec := NoOrYes( {'Фpагментный поиск'}, 2, {' 1.С начала ',;
                                               ' 2.Продолжить ',;
                                               ' 3.Новый текст ',;
                                               ' 4.Новый с начала ';
                                               },6 )
   IF     nRec == 1.OR.nRec==4
      GO TOP
   ELSEIF nRec == 2
      SKIP
   ENDIF
ENDIF
IF LASTKEY()!=K_ESC.AND.!EMPTY(bFindBlock)
   IF EMPTY(cFind).OR.nRec==3.OR.nRec==4
      cFind := PADR(cFind,30)
      lYes:=GetAnyThing(@cFind,'@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',;
      'Фpагмент текста для поиска:',10,10,COL_REF1)
   ELSE
      lYes:=.T.
   ENDIF
   IF lYes
      cFind:= ALLTRIM(UPPER(cFind))
      nRec := RecNo()
      bScope := ScopeBlock()
      nWin1:=NoOrYes( {'','Поиск... [ ]',''},,,10,35,COL_REFER )
      ScrTitul( 24, 'Esc:Прервать' )
      lYes := INDIK_NEW( 13, 49 )
      dbEVAL( {||NIL},,;
              {|| EVAL(bScope).AND.INDIK_UPDATE(lYes).AND.;
                  INKEY()<>K_ESC .AND. ;
                  !EVAL(bFindBlock,cFind) },;
              ,, .T. )
      INDIK_END(lYes)
      IF LASTKEY() == K_ESC
        SKIP -1
      ELSEIF !EVAL(bFindBlock,cFind)
        SayAndWait( 'Текст не найден!',10)
        dbGoTo( nRec )
      ENDIF
      WSELECT(nWin1)
      WCLOSE()
   ENDIF
ENDIF
RestSetKey(aSetKey)
WSELECT(0)
RESTSCREEN(,,,,sRest)
WSELECT(nWin)
SETCURSOR( nCursor )
RETURN(2)
//--------------------------------------------------------------------------//
STATIC FUNCTION ReplFind(cFilter,cRepl)
//--------------------------------------------------------------------------//
PLOCAL nPoz
   IF (nPoz := AT('CFIND',UPPER(cFilter))) != 0
     cFilter := ReplFind(SUBSTR(cFilter,1,nPoz-1)+cRepl+SUBSTR(cFilter,nPoz+5),cRepl)
   ENDIF
RETURN cFilter

//--------------------------------------------------------------------------//
FUNCTION FiltName(cFindMacro,cFltr0,cScopeMacro,nRow,nCol,cFilter,lSubIndex,lNoRestScr)
//--------------------------------------------------------------------------//
// lSubIndex - .T. построение субиндекса иначе ручного индекса
//cFilter - результирующее выражение фильтра (по ссылке возвращается)
PLOCAL lYes,sRest1:=SAVESCREEN(10,10,20,60),sRest2:=SAVESCREEN(24,0,24,79)
PLOCAL aSetKey:=SaveSetKey()
PLOCAL LastHandler
cFind:= PADR(cFind,30)
lYes:=GetAnyThing(@cFind,'@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',;
'Фpагмент текста для фильтрации:',10,10,COL_REF1)
IF lYes
  cFind:= ALLTRIM(UPPER(cFind))
  cFilter := ReplFind(cFindMacro,"'"+cFind+"'")
  IF MySetFilter(cFilter,cFltr0,cScopeMacro,lSubIndex)
    IF sRest23 = NIL
      IF nRow==NIL
        sRest23:=BrSaveScreen(23,0,23,MAXCOL())
        ScrTitul(23,'Фильтр установлен (Ctrl-F6:снятие фильтра)')
      ELSEIF nRow<=MAXROW()
        sRest23:=BrSaveScreen(nRow,nCol,nRow,nCol+36)
        SAYSCREEN(' Фильтр установлен (Ctrl-F6:снятие) ',nRow,nCol)
      ENDIF
    ENDIF
  ELSE
    MyCloseFilter()
    cFilter:=''
  ENDIF
ENDIF
RestSetKey(aSetKey)
IF EMPTY(lNoRestScr)
  RESTSCREEN(10,10,20,60,sRest1)
  RESTSCREEN(24,0,24,79,sRest2)
ENDIF
RETURN(2)

//----------------------------------------------------------------------------//
                       FUNCTION qInitPush(lFlag)
//----------------------------------------------------------------------------//
// Сохраняет окружение  InitList() при lFlag = .T. или NIL
//                      qInput()   при lFlag = .F.
IF (ValType(lFlag) = "L" .AND. lFlag) .OR. ValType(lFlag) != "L"
  qInitPush(.F.)
  AADD(aSaveInit,{ sRest23,statCod,aArea,lWasApp,bFindBlock,nStOrder,nPozSortSeek})
  nStOrder := nTopi := nLefti := nBottomi := nRighti := sResti := sRest23 := statCod := aArea := bFindBlock := NIL
  nPozSortSeek := 0
  lWasApp :=.F.
ELSE
  AADD(aSaveInit,{nTopi,nLefti,nBottomi,nRighti,sResti,lDisplay,lPlugGetBlock,lPlugValid,lWasApp})
  lDisplay := .F.
  lPlugGetBlock := .F.
  lPlugValid := .F.
ENDIF
RETURN(NIL)

//----------------------------------------------------------------------------//
                       FUNCTION qInitPop()
//----------------------------------------------------------------------------//
// Восстанавливает окружение InitList(),qInput()
PLOCAL aSave := ATAIL(aSaveInit)
ADEL(aSaveInit,LEN(aSaveInit))
ASIZE(aSaveInit,LEN(aSaveInit)-1)
IF LEN(aSave) < 8
 sRest23 := aSave[1]
 statCod := aSave[2]
 aArea := aSave[3]
 lWasApp := aSave[4]
 bFindBlock := aSave[5]
 nStOrder := aSave[6]
 nPozSortSeek := aSave[7]
 qInitPop()
ELSE
 nTopi := aSave[1]
 nLefti := aSave[2]
 nBottomi := aSave[3]
 nRighti := aSave[4]
 sResti := aSave[5]
 lDisplay := aSave[6]
 lPlugGetBlock := aSave[7]
 lPlugValid := aSave[8]
 lWasApp := aSave[9]
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
     FUNCTION MaxNumber(nNumber)
//----------------------------------------------------------------------------//
IF (ValType(nNumber) = "N" .AND. nNumber > MAX_NUMBER .AND. (nNumber := 0,.T.)) .OR. (ValType(nNumber) = "A" .AND. ((nNumber[1] > MAX_NUMBER .AND.(nNumber[1] := 0,.T.)) .OR. (nNumber[2] > MAX_NUMBER .AND.(nNumber[2] := 0,.T.))))
  SayError(" Слишком большое число !")
  RETURN .F.
ENDIF
RETURN .T.
//----------------------------------------------------------------------------//
     FUNCTION MaxData(dData)
//----------------------------------------------------------------------------//
 // Ограничение работы БЭСТа
  #ifdef _TRIAL_DATE
    IF DTOS(dData) > _TRIAL_DATE
      ERRORLEVEL(2)
      QUIT
    ENDIF
  #endif
//altd()
RETURN .T.
IF !EMPTY(CURR_MDATA) .AND. (ValType(dData) = "D" .AND. ;
    dData > CURR_MDATA .AND. (dData := 0,.T.)) .OR. ;
    (ValType(dData) = "A" .AND. ;
      ((dData[1] > CURR_MDATA .AND.(dData[1] := 0,.T.)) .OR.;
       (dData[2] > CURR_MDATA .AND.(dData[2] := 0,.T.))))
  SayError(" Слишком большая дата !")
  RETURN .F.
ENDIF
RETURN .T.
//--------------------------------------------------------------------------//
STATIC FUNCTION GetArray(aArray,cnI,xVal)
//--------------------------------------------------------------------------//
// Рекурсивное чтение или запись элемента массива с дополнением размерностями
PLOCAL nI
IF "," $ cnI
  nI := VAL(BEFORATNUM(",",cnI,1))
  cnI := AFTERATNUM(",",cnI,1)
ELSE
  nI := VAL(cnI)
  cnI := ""
ENDIF
IF(ValType(aArray) != "A",aArray := ARRAY(nI),IF(LEN(aArray) < nI,ASIZE(aArray,nI),NIL))
IF !EMPTY(cnI)
  aArray[nI] := GetArray(aArray[nI],cnI,@xVal)
ELSEIF xVal != NIL
  aArray[nI] := xVal
ELSE
  xVal := aArray[nI]
ENDIF
RETURN aArray
//--------------------------------------------------------------------------//
STATIC FUNCTION RetValue(cHeads,xVal)
//--------------------------------------------------------------------------//
PLOCAL nArea := FiArea(cHeads)
PLOCAL cName := FiName(cHeads)
PLOCAL nPoz := (nArea)->(FieldPos(cName))
PLOCAL aArray, cnI, lSave := xVal != NIL, nPozArray
IF EMPTY(nPoz)
 IF EMPTY(cName)
   RETURN ""
 ELSEIF !("[" $ cName)
   cName:=STRTRAN(UPPER(cName),"MEMVAR->","")


   RETURN IF(lSave,EVAL(MEMVARBLOCK(cName),xVal),EVAL(MEMVARBLOCK(cName)))
 ELSE
   cName:=STRTRAN(UPPER(cName),"MEMVAR->","")
   cnI := STRTRAN(CHARREM(" ",BEFORATNUM("]",AFTERATNUM("[",cName,1))),"][",",")
   cName := UPPER(BEFORATNUM("[",cName,1))
   aArray := IF((nPoz := (nArea)->(FieldPos(cName))) = 0,EVAL(MEMVARBLOCK(cName)),(nArea)->(FieldGet(nPoz)))
   IF (nPozArray := ASCAN(aNameArray,{|x| x[1] == cName })) = 0
     AADD(aNameArray,{cName,aArray})
     nPozArray := LEN(aNameArray)
   ENDIF
   aArray := aNameArray[nPozArray,2] := GetArray(aNameArray[nPozArray,2],cnI,@xVal)
   IF lSave
     IF nPoz = 0
       EVAL(MEMVARBLOCK(cName),aArray)
     ELSEIF (nArea)->(ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0 .OR. RecLock())
       (nArea)->(FieldPut(nPoz,aArray))
     ENDIF
   ENDIF
   RETURN xVal
 ENDIF
ENDIF
IF lSave
 #ifdef _TRIAL_DATE
   IF ValType(xVal) == 'D'.AND.DTOS(xVal) > _TRIAL_DATE
     ERRORLEVEL(2)
     QUIT
   ENDIF
 #endif
// Аккуратнее! Вася - 18 января 2005. Нужно ето дело подточить для нужд экспорта.
 IF (Type("lRec_IMPORT") $ "L".AND. ValType(lRec_IMPORT) == "L".AND. lRec_IMPORT).OR.Type("lRec_IMPORT")$"U"
    IF (nArea)->(ASCAN(dbRLockList(),{|nRec| nRec = RECNO() }) != 0 .OR. RecLock());
     .AND.(nArea)->(FieldType(nPoz) != "N" .OR. LEN(ALLTRIM(STR(xVal,25,0))) <= FieldSize(nPoz)-FieldDeci(nPoz)-IF(!EMPTY(FieldDeci(nPoz)),1,0) )
      (nArea)->(FieldPut(nPoz,xVal))
    ENDIF
 ENDIF


 RETURN xVal
ENDIF
RETURN (nArea)->(FieldGet(nPoz))
//--------------------------------------------------------------------------//
                FUNCTION BrSaveScreen(nTop,nLeft,nBottom,nRight,cScr)
//--------------------------------------------------------------------------//
IF cScr != NIL
 nTop := MIN(nTop,ASC(RIGHT(cScr,4)))
 nLeft := MIN(nLeft,ASC(RIGHT(cScr,3)))
 nBottom := MAX(nBottom,ASC(RIGHT(cScr,2)))
 nRight := MAX(nRight,ASC(RIGHT(cScr,1)))
ELSEIF nTop = NIL
  nTop :=0
  nLeft := 0
  nBottom := MaxRow()
  nRight := MaxCol()
ENDIF
RETURN SaveScreen(nTop,nLeft,nBottom,nRight)+CHR(nTop)+CHR(nLeft)+CHR(nBottom)+CHR(nRight)
//--------------------------------------------------------------------------//
               FUNCTION BrRestScreen(cScr)
//--------------------------------------------------------------------------//
RETURN RestScreen(ASC(RIGHT(cScr,4)),ASC(RIGHT(cScr,3)),ASC(RIGHT(cScr,2)),ASC(RIGHT(cScr,1)),LEFT(cScr,LEN(cScr)-4))
//--------------------------------------------------------------------------//
        FUNCTION GetUpdateIn(aIn,aLastIn,nUpdate,nI)
//--------------------------------------------------------------------------//
// nUpdate номер первого найденного измененного элемента (по ссылке)
// nI с какого элемента начинать
PLOCAL lUpdated, nFi
nUpdate := 0
IF( ValType(nI)<>'N',nI:=1,)

IF !(lUpdated := LEN(aIn) != LEN(aLastIn))
  AEval(aIn,;
        {;
           |x, i|;
           nFi := i,;
           If(ValType(x) == "A",;
            If(ValType(aLastIn[i]) == "A" .And. Len(x) == Len(aLastIn[i]),;
               IF( GetUpdateIn(x,aLastIn[i],,1),lUpdated:=.T.,),;
             lUpdated:=.T.),;
            If(ValType(x) == ValType(aLastIn[i]);
               .And.;
               x == aLastIn[i],,;
             lUpdated:=.T.)),;
           IF(nUpdate = 0 .AND. lUpdated,nUpdate := nFi,NIL);
        },nI)
ENDIF
RETURN lUpdated
//---------------------------------------------------------------------------//
                     FUNCTION SaveSeekPos(xKoord)
//---------------------------------------------------------------------------//
// Возвращает массив координат окна ввода
// значений поиска
STATIC aKoord := {0,0,0,0}
PLOCAL aBakKoord := aKoord
IF !EMPTY(xKoord)
  aKoord := xKoord
ENDIF
RETURN aBakKoord
//--------------------------------------------------------------------------//
                      FUNCTION GetSortSeek()
//--------------------------------------------------------------------------//
// Возвращает текущий актуальный номер aSortSeek
RETURN nPozSortSeek
//--------------------------------------------------------------------------//
                  PROCEDURE SetSortSeek(aSortSeek)
//--------------------------------------------------------------------------//
// Приводит массив aSortSeek к стандартному виду
   AEVAL(aSortSeek,{|x,nPoz| ASIZE(x,MAX(LEN(x),8)),;
                             IF(x[8] = NIL,x[8] := ORDNAME(nPoz),NIL),;
                             IF(ValType(x[8]) = "N",x[8] := ORDNAME(x[8]),NIL),;
                             IF(ValType(x[2])=='A',(;
                                IF( ValType(x[5])<>'A', x[5]:={x[5]},),;
                                IF( ValType(x[6])<>'A', x[6]:={x[6]},),;
                                IF( ValType(x[7])<>'A', x[7]:={x[7]},),;
                                ASIZE(x[5],LEN(x[2])),;
                                ASIZE(x[6],LEN(x[2])),;
                                ASIZE(x[7],LEN(x[2])) ;
                                                   ),;
                                );
                    };
        )
RETURN
//--------------------------------------------------------------------------//
                  PROCEDURE ViewSortSeek(aSortSeek,lSet,bSeek,bSort)
//--------------------------------------------------------------------------//
// Установка начальных значений сортировки
// lSet - если .T., то переустановка teg'а в случае
//        отсутствия текущего order'а в aSortSeek
nPozSortSeek := 0
IF aSortSeek != NIL
  SetSortSeek(aSortSeek)
  nPozSortSeek := ASCAN(aSortSeek,{|xTag| nPozSortSeek++,IF(LEN(xTag) >= 8 .AND. xTag[8] != NIL,IF(ValType(xTag[8]) = "C", UPPER(xTag[8]), IF(ValType(xTag[8]) = "B", UPPER(EVAL(xTag[8])), ORDNAME(xTag[8]))), ORDNAME(nPozSortSeek)) == ORDNAME() })
  IF lSet .AND. nPozSortSeek = 0 .AND. LEN(aSortSeek) > 0
    nPozSortSeek := 1
    ORDSETFOCUS(aSortSeek[nPozSortSeek,8])
    IF EMPTY(ORDSETFOCUS())
       ORDSETFOCUS(nPozSortSeek)
    ENDIF

    dbSkip()
    dbSkip(-1)
  ENDIF
  IF SETKEY(K_F7) = NIL
    SETKEY(K_F7,bSeek)
  ENDIF
  IF SETKEY(K_F3) = NIL .AND. LEN(aSortSeek) > 1
    SETKEY(K_F3,bSort)
  ENDIF
ENDIF
RETURN
FUNCTION RestRec(cAlias,nRec)
(cAlias)->(dbGoTo(nRec))
RETURN .T.

FUNC RunFilter(cFil)
ALTD()
cFil:=&cFil
RETURN cFil

/*******************************
*   A3DateView () --> NIL
*
*/
FUNCTION  A3DateView()
    LOCAL cDate,cTime,cUserCode,cUncrypt,cReestr:=Jrn_Reestr()
    IF !EMPTY(cReestr)
       Jrn_Say(cReestr)
    ELSEIF  FIELDPOS("CRYPT_CODE") != 0 .AND. !EMPTY(Global_Set[2])
        IF  !EMPTY(FIELD->CRYPT_CODE)
            cUncrypt:=CRYPT(FIELD->CRYPT_CODE,"Crypt_A3")
            cUserCode:=SUBSTR(cUncrypt,6,6)

            cDate:=CTOD(ALLTRIM(STR(ASC(SUBSTR(cUncrypt,1,1))))+"/"+ALLTRIM(STR(ASC(SUBSTR(cUncrypt,2,1))))+"/"+ALLTRIM(STR(ASC(SUBSTR(cUncrypt,3,1)))))
            cDate:=PADL(ALLTRIM(STR(DAY(cDate))),2,"0")+"/"+PADL(ALLTRIM(STR(MONTH(cDate))),2,"0")+"/"+ALLTRIM(STR(YEAR(cDate)))
            cTime:=PADL(ALLTRIM(STR(ASC(SUBSTR(cUncrypt,4,1)))),2,"0")+":"+PADL(ALLTRIM(STR(ASC(SUBSTR(cUncrypt,5,1)))),2,"0")

            SayAndWait({"Последняя модификация",REPLICATE("─",25),"Пользователь: "+cUserCode,"Дата: "+cDate,"Время: "+cTime})
        ELSE
            SayAndWait({"Последняя модификация",REPLICATE("─",25),"Пользователь:","Дата:","Время: "})
        ENDIF
    ENDIF
RETURN NIL  // from  func A3DateView

/*
* Запрещение ввода данных для дат не входящих в заданный диапазон
*
*/
FUNCTION A3MaxDate(dDate,lNoSay)
    LOCAL lRet:=.T.
    IF  TYPE("CURR_LDATA")<>"D"
        PRIVATE CURR_LDATA:=CTOD("")
    ENDIF
    IF  TYPE("CURR_MDATA")<>"D"
        PRIVATE CURR_MDATA:=CTOD("")
    ENDIF
    IF  dDate==NIL
        dDate:=CURR_LDATA
    ENDIF
    IF  !(IIF(EMPTY(CURR_LDATA),.T.,dDate>=CURR_LDATA).AND.IIF(EMPTY(CURR_MDATA),.T.,dDate<=CURR_MDATA))
        IF  TYPE("cA3MaxErr")=="C"
            m->cA3MaxErr:="Дата проводки не входит в допустимый период с "+DTOC(CURR_LDATA)//+" по "+DTOC(CURR_MDATA)
        ENDIF
        IF  EMPTY(lNoSay)
            lRet:=SayError({"Дата проводки не входит в допустимый","период с "+DTOC(CURR_LDATA)/*+" по "+DTOC(CURR_MDATA)*/})
        ELSE
            lRet:=.F.
        ENDIF
    ENDIF
RETURN lRet

******************
FUNCTION qGet(aHeads)
******************
// Вася 17 января 2005 - для экспорта в инитлист.

PRIVATE lNoInt:=.F. // - это для импорта строк в инитлист. Эта переменная определена всегда.
If TYPE("lNoInteractiv")$"L" //z0ne 28.05.2004
  If ValType(lNoInteractiv)=="L"
	lNoInt := lNoInteractiv
  ENDIF
ENDIF
   AEVAL(aIn,{|x,nCo|aIn[nCo]:= IIF(lNoInt,RetValue_ForImport(nCo),RetValue(aHeads[nCo,2]))})
RETURN .T.



Function SetOnRefer(x)
if OnRefer == NIL
   OnRefer := .T.
end
if x != NIL
   OnRefer := x
end
Return (OnRefer)

****************
FUNCTION xaltd(q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11,q12,q13,q14,q15,x1,x2)
****************
If (ValType(q1)=="N").AND.((q1==666).OR.(q1==999))
  If (q1==999) .AND.(TRAPSHIFT(z0ne_1312[1]), SaveSetKey(z0ne_1312[2]), .T.)
    RELEASE z0ne_1312
  else // 666
    x1:=TRAPSHIFT("")
    x2:=SaveSetKey()
    If !(TYPE("z0ne_1312<>NIL")=="L")
      PUBLIC z0ne_1312:={x1,x2}
    endif
    altd()
  endif
else
  altd()
endif
RETURN .T.




// Вася - 17 января 2005 года.
// Цель - сделать функцию экспорта в стандартный инитлист.
// Идея такая: вызвать то, что висит на F4 или Enter, сделать нужные приватные переменные и подправить qInput
// так, чтобы вся логика отрабатывалась, в aIn сидели нужные значения а вывода на экран не было

// Импортировать буду по одной строке!

FUNCTION Import_To_InitList(Import_aIn,lAdd,lRec_Or_Try)
// lAdd = .F. - делать как по Enter
// lAdd = все остальное - добавляются новые строчки

// lRec_Or_Try - делать запись в случае выполнения всех блоков, условий и прочей логики, или не делать.
// Если .F. - не пишем, все остальное - пишем

// Import_aIn-- строка которая импортируется. Она должна соответствовать массиву aHeads и, следовательно, aIn!!

Local bAction
PRIVATE lNoInteractiv := .T.
PRIVATE __HiddenError := {} // Сюда накапливается ошибка.
PRIVATE AIN_FOR_IMPORT := Import_aIn
PRIVATE lRec_IMPORT

lAdd := IIF(lAdd = Nil.OR.ValType(lAdd)!="L",.T.,lAdd)
lRec_Or_Try := IIF(lRec_Or_Try = Nil.OR.ValType(lRec_Or_Try)!="L",.T.,lRec_Or_Try)
lRec_IMPORT := lRec_Or_Try
IF lAdd
	bAction := SetKey(K_F4)
ELSE
	bAction := SetKey(K_ENTER)
ENDIF
IF bAction != Nil
	EVAL(bAction) // чего только не придумаешь чтобы все работало и ничего при этом не делать!
	CLEAR TYPEAHEAD
ENDIF
RETURN __HiddenError



// Это вместо SayError. Здесь происходит добавление в __HiddenError.
// Это урезанный Пашин SayError
FUNCTION AddToHiddenError(cString)
If TYPE("__HiddenError")$"C,A" //z0ne 28.05.2004
  If ValType(__HiddenError)=="C"
    __HiddenError:={__HiddenError}
  endif
  If ValType(cString)=="C"
    cString:={cString}
  endif
  AEVAL(cString,{|e| AADD(__HiddenError,e) })
endif
RETURN .F.



// Аналог retValue но для импорта в initlist
Static FUNCTION RetValue_ForImport(nCo)
Local Res
Res := IIF(LEN(aIn_FOR_IMPORT) >= nCo,aIn_FOR_IMPORT[nCo],Nil)
IF (Res == Nil)
	SayError("Импортируемая строка не соответствует формату!")
ENDIF
RETURN Res


// инициализирует справочник - взято от Паши
FUNCTION InitRef__(cName,oGet)
  If ValType(oGet)=="O"
  elseIf ValType(oGet:=GetActive())=="O"
  else
    oGet:=GetNew(-100,-100,{|| ""},"")
  endif
  KeySend(K_ENTER)
  DoRefer(oGet,cName,.F.)
  CLEAR TYPEAHEAD
RETURN


// Как будто делаем READ

PROCEDURE EmulateRead(aGetList,aRef)
Local i,cRef
Local oGet,lRes
FOR i := 1 to LEN(aGetList)
oGet := aGetList[i]
lRes := .T.
IF !EMPTY(oGet:Preblock)
	lRes := Eval(oGet:Preblock)
ENDIF

IF ValType(lRes)="L".AND.lRes
    IF LEN(aRef)>=i.AND.!EMPTY(aRef[i])
	cRef := aRef[i]
	InitRef__(cRef,oGet)
    ENDIF
    IF !EMPTY(oGet:Postblock)
	Eval(oGet:Postblock)
    ENDIF
ENDIF
ENDFOR
RETURN








