***************************************************************************
*   Программа  : S_Refer.prg-система справочников                         *
*   Автор      : А. Титов  (адаптированная для нужд Best)                 *
*   Примечание : компилировать с опциями /n /w /a /m                      *
***************************************************************************
// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.


/****** Прототипы *********

@ row,col REFER cRefer GET ...
@ row,col REFRIGHT cRefer GET ... - то же самое, но только перед поиском
                                  в справочнике символьное значение прижимает-
                                  ся к правому краю
@ row,col REFRIGHTF cRefer GET ... - то же самое, но только перед поиском
                                  в справочнике символьное значение прижимает-
                                  ся к правому краю, оставляя один символ пробе-
                                  ла для ввода '*' в фильтре
PROCEDURE ClearRefer(cRefer)   - очищение массива справочников (без закрытия
                                 баз), если указан параметр, то стирание дан-
                                 ных по конктретному справочнику cRefer

GetList() и Get-переменные, имена которых приводятся в массиве приемников
aDest[] должны быть PRIVATE или PUBLIC.
     Система содержит функции, позволяющие программисту строить и использо-
вать в GET-READ состояниии справочники,обеспечивающие отображение, поиск и
выбор из заранее подготовленной базы данных (справочника) одного или нескольких
заданных полей и запись их в заданные GET-переменные.
     Имеются следующие типы справочников:
     1 - с постпроверкой - находясь в GETе можно вызвать справочник по
горячей клавише и ввести из него значение;
при непосредственном вводе значения,отсутствующего в справочника производится
его принудительное отображение,и оператору предлагается выбрать правильное
значение;ввод значения,отсутствующего в справочнике при этом невозможен;
     2 - то же самое, что тип 1, только с разрешением ввода: пустых значений и
         значений со звездочкой "*" (если не задан bYesValue),
         или если bYesValue вернет .T.;
     3 - без постпроверки - отличается от типа 1 тем,что по завершении
GETа постпроверка не производится (можно ввести значение,отсутствующее в спра-
вочнике);
     4 - с сигнальной постпроверкой - отличается от типа 1 тем,что возможен
ввод значения,отсутствующего в справочнике, если после принудительного отобра-
жения справочника нажать клавишу <ESC>
     5 - то же , что тип 2 только с разрешением ввода числового значения -1
          (для уникальной привязки по счетчику)

     Пользовательский интерфейс включает в себя следующие процедуры и коман-
ды:

     MakeRefer(...) - создание справочника, необходимо выполнить один раз
                      перед использованием справочника при нахождении в
                      базе данных, на основе которой формируется справочник,
                      описание интерфейса приведено ниже;

     @ <row>,<col> REFER <имя справочника> GET ...
                      - модифицированная команда GET, обеспечивающая работу
                      с соответствующим справочником в процессе READ-ожидания,
                      <имя справочника> задается при его создании;

     ClearRefer([cRefer])   - освобождение памяти, захваченной под глобальную
                      информацию о справочниках без закрытия соответствующих
                      баз, если указан cRefer,то - стирание данных о конкрет-
                      ном справочнике cRefer.


    *************
     Примечания:
    *************

     - перед созданием справочника необходимо открыть базу данных, на основе
которой формируется справочник и в соответствующей рабочей области выполнить
процедуру MakeRefer(), при дальнейшем использовании справочника выбор рабочей
области не имеет значения;

     - поскольку модификация команды GET осуществляется на предпроцессорном
уровне в пользовательской программе необходимо указать включаемый файл:
     #INCLUDE "s_refer.ch";

     - определены следующие клавиши выполнения операций со справочниками:

     F2 - вызов справочника;
     F7 - поиск информации в справочнике;
     F4 - дополнение справочника;
     F3 - смена главного индекса и сортировка по нему.

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

MakeRefer(
  сRefer      - имя справочника для дальнейшего использования, если такое имя
                уже есть,то спpавочник замещается;
  cHead       - наименование справочника (однострочное),может быть блоком кода,
                который выполняется в млмент рисования справочника;
  nTypRefer   - тип справочника (0,1,2,3,4 - см выше);
  aHeads/cKey - массив наименований столбцов для Refer или значение ключа для
                текстов Help;
  aYXN        - массив координат {Y,X,N} , где:
                X,Y - левая верхняя позиция справочника,
                N   - количество отображаемых строк;
  cColor    - строка цвета (два цвета - обычный и выделенный);
  aSource   - массив имен полей справочника для занесения в GET-переменные;
  aDest     - массив имен GET-переменных, в которые заносятся значения
                полей справочника (их имена должны быть PRIVATE или PUBLIC);
  cKeyVal   - выражение в виде символьной строки для вычисления (путем
                макроподстановки) ключа при поиске записи в справочнике,
                если был произведен прямой ввод в Get-переменную;
  abFields  - массив блоков кода для считывания содержимого полей спра-
            вочника, по умолчанию считываются все поля целиком;
  aSortSeek - массив сортировок и характеристик поиска - как в S_LIB.
              Если присутствует, то по клавише F7 будет осуществляться поиск,
              а по клавише F3 (если длина массива больше 1) - выбор вида
              сортировки с соответствующей сменой главного индекса.
              Пример:
             aSortSeek:={;
             {'- по кодам        ','Введите искомый код','Cod',UPPER(aIn[1])},;
             {'- по наименованиям','Введите пеpвые символы наименования',;
                       'LEFT(Name,5)',TRIM(UPPER(aIn[1]))}}
             Если длина ==1, то выбор сортировки (F3) не работает, только поиск
             по главному индексу (F7).
             Структура элемента:
             1.наименование в сортировочном меню,
             2.указание (строка) в кадре поиска,
             3.выражение инициализации aIn[1],
             4.Seek-выражение после ввода aIn[1];
             5.Picture для ввода aIn[1],
             6.Valid для ввода aIn[1],
             7.cRef - справочник,
             8.nOrd - номер индекса, по которому осуществлять поиск или сортировку,
             если не указан, то берется индекс в соответствии с порядковым номером
             элемента массива

aInputHeads - Массив описания области ввода ({Строка,имя поля}) - как в S_LIB.
             Если он присутствует (не равен NIL), то предполагается, что будет
             использоваться функция дополнения F4-ввод.
             Если не предполагается использование дополнения, то массив не
             указывается.
             Пример:
             aInputHeads:={;
             {'Группа.................... ','Grup'},;
             {'Н/номер................... ','NNum'},;
             {'Кол-во на начало периода.. ','Kol0'},;
             {'Цена   на начало периода.. ','Cena0'},;
             {'Склад..................... ','Sklad'},;
             {'Место хранения............ ','Mesto'};
              }
  aPict     - массив шаблонов (в символьном виде, как в S_LIB) для
            ввода новых значений в справочник;
  aWhen     - массив предусловий (в символьном виде, как в S_LIB) для
            ввода новых значений в справочник;
  aValid    - массив постусловий (в символьном виде, как в S_LIB) для
            ввода новых значений в справочник;
  bPost     - постблок, выполняющийся при дополнении справочника (как в S_LIB)
  bPreDisp  - блок, выполняющийся перед отображениием справочника (например,
            для установки фильтра)
            Может возвращать массив {...} :
              [1] - номер ордера для отображения справочника
              [2] - массив aSortSeek
              [3] - номер(имя) ордера для поиска при дополнении справочника

           Выполняется перед ключевым поиском !

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

   cKeyValDisp - выражение в виде символьной строки для вычисления (путем
                 макроподстановки) ключа при поиске первой записи для отображе-
                 ния справочника (если не указано,то исп-ся cKeyVal)

   aRef        - массив имен справочников (недополняемых) для
            ввода новых значений в справочник;
   cHelp       - строка помощи, которая высвечивается при активизации
            соответствующего Get-объекта, по умолчанию: "F2:Справочник"
                 или массив {Row,Col,cHelp или bHelp}

   bCoProc     - блок кода или имя сопроцедуры для Browse
   nRowHelp,nColHelp - координаты строки помощи (по умолчанию 24,0)
   aGetBlock   - массив Get-блоков (как в S_Lib) для ввода
   cFindMacro - выражение поиска в символьном виде для функций Find(),FindFilter()
              искомая строка - PRIVATE cFind - вводится пользователем
   nTag   - номер тега, по которому производится Seek по cKeyVal
   bDispSpr - блок кода для прорисовки картинки или установки фильтра,
              может (но необязательно) возвратить массив :
              1 - nTop
              2 - nLeft
              3 - nBottom
              4 - nRight
              5 - смещение начала окна qBrowse относительно nTop
              6 - смещение конца окна qBrowse относительно nBottom
              7 - SaveScreen(nTop,nLeft,nBottom+1,nRight+2)

           Выполняется после ключевого поиска !

   bYesArray - Блок кода доступа к массиву, куда вернем значения,если помечены несколько записей
              Пример: {|x| IF(ValType(x)=='A', aArray:=x, aArray ) }
   nTagSeek - номер(имя) ордера для поиска при дополнении справочника
   aHotKey - массив навешенных клавиш (см.описание InitList)
   aOtherKey - массив остальных навешанных клавиш в формате
              {{код клавиши,блок кода}....}
   bYesReplArray - блок кода для заполнения массива значений, если вернет
                   NIL, то заполнения не присходит
   bYesNoRepl    - блок кода разрешения выбора или удаления выбранного элемента
                   ему передается .T. если добавление
                                  .F. если удаление
                   Блок кода должен возвращаеть признак возможности удаления
                   или добавления текущего элемента (всегда выполняется
                   на записи соответствующей текущему элементу).
   nOrdSeek  - в какой тег перевести базу для поиска непосредственно по вводу букв
   cLeftKey  - старшая часть ключа для непосредственного поиска по буквам
   nPosKey   -


   При применении ключевой фильтрации следует следить, чтобы при любом индекс-
ном файле,который может выбрать пользователь, выражение cScope являлось
старшей частью ключа.

   SaveRefPos(cRefer) - возвращает массив координат окна ввода cRefer
   ReferPush(),ReferPop() - закидывает в стек информацию о навешанных справочниках
   ReferGetReader() - reader со справочником
*/

//Включаемые файлы
#INCLUDE "inkey.ch"
#INCLUDE "setcurs.ch"
#INCLUDE "getexit.ch"
#INCLUDE "s_refer.ch"
#INCLUDE "s_public.ch"


//Позиции в элементе aRefer[nRefer]
#DEFINE P_ALIAS    1 //Alias-имя базы данных справочника
#DEFINE P_HEAD     2 //наименование справочника
// Изменение 3.110
#DEFINE P_TYP      3 //тип (0 - Help,1,2,3,4,5-Refer);
#DEFINE P_KEYHEADS 4 //заголовки столбцов или ключ для текстов HELP
#DEFINE P_RECT     5 //массив координат окна и кол-во строк шапки
#DEFINE P_BLOCKCOL 6 //массив блоков кода и колонок полей
#DEFINE P_COLOR    7 //строка цвета
#DEFINE P_SOURCE   8 //массив имен полей справочника для занесения в GET-переменные;
#DEFINE P_DEST     9 //массив имен GET-переменных, в которые заносятся значения
                    //полей справочника;
#DEFINE P_KEYVAL  10 //выражение для вычисления значения ключа
#DEFINE P_SORT    11 //массив сортировок
#DEFINE P_INPUT   12 //массив характеристик ввода
#DEFINE P_PICT    13 //массив характеристик ввода
#DEFINE P_WHEN    14 //массив характеристик ввода
#DEFINE P_VALID   15 //массив характеристик ввода
#DEFINE P_HELP    16 //массив Help-строк
#DEFINE P_POST    17 //пост-блок
#DEFINE P_PREDISP 18
#DEFINE P_POSTDISP 19
#DEFINE P_BCOLOR  20
#DEFINE P_KEYVALDISP 21
#DEFINE P_REF 22
#DEFINE P_HELP0 23 //Помощь на 24 строке
#DEFINE P_COPROC 24 //Сопроцедура
#DEFINE P_ROWHELP 25 //Строка помощи
#DEFINE P_COLHELP 26 //Колонка помощи
#DEFINE P_GETBLOCK 27 //Get-блоки для ввода
#DEFINE P_FIND 28 //Макро для поиска
#DEFINE P_CHOICE 29 //Указатель в меню
#DEFINE P_TAG    30 //Номер тега
#DEFINE P_SCRINIT  31 //Перед вводом
#DEFINE P_SCRPOST  32 //После ввода
#DEFINE P_DISPSPR  33 //После ввода

#DEFINE P_YES_ARRAY    34 //Масив нужен ненужен
#DEFINE P_BLOCK_ARRAY  35 //Блок кода для считывания, заполнения массива
#DEFINE P_VAR_ARRAY    36 //Значения Масив

#DEFINE P_TAG_SEEK     37 //Номер тега при добавлении для поиска
#DEFINE P_HOTKEY       38 //Массив aHotKey
#DEFINE P_OTHERKEY     39 //Массив остальных навешаемых клавиш

#DEFINE P_PREBLOCK     40 // Блок кода выполняемый перед редактированием
#DEFINE P_POSTBLOCK    41 // Блок кода выполняемый после редактированием
#DEFINE P_POSTREAD     42 // Блок кода выполняемый после READ
#DEFINE P_REPL         43 // Блок кода выполняемый при добавлении элемента
                          // в массив выбора (bYesArray)
#DEFINE P_YESNOREPL    44 // Блок кода разрешения выбора или удаления выбранного элемента
#DEFINE P_SAY_PTICA    45 // Блок кода должен веруть птицу или еще чего ? длиной не более 1

#DEFINE P_BSAYHEAD     46 // Блок Say мнимого заголовка
#DEFINE P_BKEYHEAD     47 // Блок ключа мнимого заголовка
#DEFINE P_EDIT         48 // Нужно ли редактировать
#DEFINE P_YESVALUE     49 // Если вернет .T. то поиск по справочнику проводится не будет (для типа справочника 2)

#DEFINE P_ORDSEEK    50 //Номер тега для непосредственного поиска
#DEFINE P_LEFTKEY    51 //Старшая часть ключа для непосредственного поиска
#DEFINE P_POSKEY     52



STATIC aRefer:={}, acRefer:={}, aSaveRefer := {}
Static xKeySeek := ''
Static xUniRef := 2
*MakeRefer()
* Функция построения справочника
*/
PROCEDURE MakeRefer(;
 cRefer,    cHead,       nTypRefer, cKeyaHeads,    aYXN,;          //  5
 cColor,    aSource,     aDest,     cKeyVal,       abFields,;      // 10
 aSortSeek, aInputHeads, aPict,     aWhen,         aValid,;        // 15
 bPost,     bPreDisp,    bPostDisp, bColor,        cKeyValDisp,;   // 20
 aRef,      cHelp0,      bCoProc,   nRowHelp,      nColHelp,;      // 25
 aGetBlock, cFindMacro,  nTag,      bScrInit,      bScrPost,;      // 30
 bDispSpr,  bYesArray,   nTagSeek,  aHotKey,       aOtherKey,;     // 35
 bPreGet,   bPostGet,    bPostRead, bYesReplArray, bYesNoRepl,;    // 40
 bSayPtica, cHeadPtica,  bSayHead,  bKeyHead,      lEditRefer,;    // 45
 bYesValue, nOrdSeek,    cLeftKey,  nPosKey,       lHFilter ;
)

LOCAL V_i,V_aHead,V_LEN // Вася 7 декабря 2004
PLOCAL nMaxSize,nCount,nLastRec:=aYXN[3],nHeadsRow:=0
PLOCAL lenPict:=0,nMaxFiSize:=0
PLOCAL nX:=1,aHelp:={},cHelp:=''
PLOCAL nHeadSize:=0,nFiSize:=0,nFootSize:=0
PLOCAL Y1:=aYXN[1],X1:=aYXN[2],nNumRec:=aYXN[3],Y2
PLOCAL aBlockCols,lArm:=.T., aKoord
PLOCAL nTopi,nLefti,nBottomi,nRighti
PLOCAL nPos:=1,nRefer
nPos := 1
IF (cColor==NIL)
   cColor := SETCOLOR()
ENDIF
xKeySeek := ''
xUniRef  := 2
SetOnRefer(.t.)
//Формирование aHelp
AADD(aHelp,{CHR(17)+'┘:Выбор',X1+nPos})
//nPos+=LEN(ATAIL(aHelp)[1])+1
//altd()

if lHFilter != NIL
   AADD(aHelp,{lHFilter,0})
end

IF (aSortSeek!=NIL)
   IF EMPTY(cFindMacro)
//      AADD(aHelp,{'F7:Поиск',0})
      AADD(aHelp,{'F7:Пск',0})
   ELSE
//      AADD(aHelp,{'F7,Alt-F7:Поиск',0})
      AADD(aHelp,{'F7,Alt-F7:Пск',0})
   ENDIF
ENDIF
IF (cFindMacro!=NIL.AND.aSortSeek==NIL)
//   AADD(aHelp,{'Alt-F7:Поиск',0})
   AADD(aHelp,{'Alt-F7:Пск',0})
ENDIF

IF (aSortSeek!=NIL .AND. LEN(aSortSeek)>1)
//   AADD(aHelp,{'F3:Сорт',0})
   AADD(aHelp,{'F3:Срт',0})
ENDIF
IF (aInputHeads!=NIL)
   AADD(aHelp,{'F4:Ввод',0})
   IF !EMPTY( lEditRefer )
//     AADD( aHelp, {'Ctrl-Enter:Правка',0} )
     AADD( aHelp, {'Ctrl-'+CHR(17)+'┘:Прав.',0} )
   ENDIF
ENDIF
IF !EMPTY( bYesArray )
//   AADD(aHelp,{'Ins:Отметка',0})
   AADD(aHelp,{'Ins:Отм.',0})
ENDIF
AEVAL(aHelp,{|x,xi|cHelp+=x[1]+' ',;
                   aHelp[xi,2] := X1+nPos,;
                   nPos += LEN(x[1])+1;
            })
nFootSize:=LEN(TRIM(cHelp))+2
nHeadSize:= IF(VALTYPE(cHead)='C'.AND.LEN(cHead)>0,LEN(cHead)+4,0)
IF (abFields == NIL)
   abFields := {}
   FOR nCount:=1 TO LEN(cKeyaHeads)
   AADD(abFields,FIELDBLOCK(FIELDNAME(nCount)))
   NEXT
ENDIF

// Если есть проверки то колонки нет
//  делай сам
IF !EMPTY(bYesArray)   // Добавим колонку для пометок
  ASIZE( cKeyaHeads, LEN(cKeyaHeads)+1 )
  AINS( cKeyaHeads, 1)
  ASIZE( abFields, LEN(abFields)+1 )
  AINS( abFields, 1 )
  IF VALTYPE( bSayPtica ) == 'B'
    cKeyaHeads[1] := IF( ValType(cHeadPtica) == 'C', ;
                         cHeadPtica,;
                         BLANK( EVAL(bSayPtica,{}), .T. ) )
   abFields[1] := {|| IF( EMPTY(nRefer),;
                      ' ',;
                      EVAL( aRefer[ nRefer, P_SAY_PTICA], aRefer[ nRefer, P_VAR_ARRAY] )) }
  ELSE
    cKeyaHeads[1] := ' '
    abFields[1] := {|| IF( EMPTY(nRefer).OR.;
                         ASCAN( aRefer[ nRefer, P_VAR_ARRAY],RECNO())==0, ' ', '√') }
  ENDIF
ENDIF

aBlockCols:=ARRAY(LEN(abFields))
FOR nCount:=1 TO LEN(abFields)
  cKeyaHeads[nCount] := LineToArray(cKeyaHeads[nCount],';')
  nPos:=0
  AEVAL(cKeyaHeads[nCount],{|x|IF(LEN(x)>nPos,nPos:=LEN(x),NIL)})
  nFiSize := LEN(TRANSFORM(EVAL(abFields[nCount]),"@!"))
  aBlockCols[nCount] := {abFields[nCount],nX+X1}
  nX += MAX(nPos,nFiSize)+1
  nHeadsRow := MAX(LEN(cKeyaHeads[nCount]),nHeadsRow)
NEXT

IF !lArm
   QUIT
ENDIF

nMaxSize:=MAX(MAX(nFootSize,nHeadSize),nX)
nNumRec:=IF(nNumRec <= nLastRec,nNumRec,nLastRec)
IF ((nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)}))==0)
   AADD(acRefer,cRefer)
   AADD(aRefer,{})
   nRefer:=LEN(acRefer)
ENDIF
nTypRefer:=IF(nTypRefer=NIL,1,nTypRefer)

aKoord := {Y1,X1,Y1+nNumRec+IF(nHeadsRow>0,nHeadsRow+1,0)+IF(nTypRefer>0,3,1),X1+nMaxSize-1,nHeadsRow,{0,0,0,0}}

IF aInputHeads != NIL
 nBottomi := aKoord[1]+2
 nRighti  := aKoord[4]-2
 AEVAL(aInputHeads,;
 {|aHeads,nCo|;
  lenPict := IF((lenPict := IF(aPict==NIL .OR. LEN(aPict)<nCo .OR. aPict[nCo]==NIL,0,LEN(TRANSFORM(SPACE(100),aPict[nCo])))) = 100,0,lenPict),;
  nMaxFiSize:=MAX(nMaxFiSize,IF(lenPict==0,FIELDSIZE(FIELDNUM(aHeads[2])),lenPict));
  };
       )

// Надо посчитать сколько показывать aInputHeads .
// Вася 7 декабря 2004
  V_LEN := 0
  FOR V_i := 1 to LEN(aInputheads)
	V_aHead := aInputHeads[V_i]
	IF !(LEN(V_aHead) >= 8.AND. V_aHead[8]!=Nil.AND.V_aHead[8] == 0)
	   V_LEN := V_LEN+1
	ENDIF
  ENDFOR

// Вася 7 декабря 2004
//  nTopi:=nBottomi-LEN(aInputHeads)-1
  nTopi:=nBottomi-V_LEN-1
  IF (nTopi<2)
//nTopi:=2;nBottomi:=nTopi+LEN(aInputHeads)+1
// Вася 7 декабря 2004
	nTopi:=2;nBottomi:=nTopi+V_LEN+1	
  ENDIF
  nLefti := nRighti-LEN(aInputHeads[1,1])-nMaxFiSize-4
  IF (nLefti < 1)
    nLefti:=1;nRighti:=nLefti+LEN(aInputHeads[1,1])+nMaxFiSize+4
  ENDIF
  aKoord[6] := {nTopi,nLefti,nBottomi,nRighti}
ENDIF

aRefer[nRefer]:={;
    Alias(),cHead,nTypRefer,cKeyaHeads,;
    aKoord,;
    aBlockCols,LineToArray(cColor,','),aSource,aDest,cKeyVal,aSortSeek,aInputHeads,;
    aPict,aWhen,aValid,aHelp,bPost,bPreDisp,bPostDisp,;
    IF( !EMPTY(bYesArray) .AND. !EMPTY(bColor), {|nCol| EVAL(bColor,nCol--)}, bColor),;
    cKeyValDisp,;
    aRef,cHelp0,bCoProc,nRowHelp,nColHelp,aGetBlock,cFindMacro,1,nTag,bScrInit,bScrPost,;
    bDispSpr,;
    !EMPTY(bYesArray), bYesArray, {},IF(nTagSeek = NIL,nTag,nTagSeek),aHotKey,aOtherKey,bPreGet,bPostGet,;
    bPostRead,;
    bYesReplArray,;
    bYesNoRepl,;
    bSayPtica,;
    bSayHead,;
    bKeyHead,;
    lEditRefer,;
    bYesValue,;
    nOrdSeek,;
    cLeftKey,;
    nPosKey;
                }
RETURN

*ReferGetReader()
* Функция чтения для одиночного GET-объекта со справочником
*/
FUNCTION ReferGetReader(get,cRefer,lSpec,lReturnGet)
  // чтение GET-объекта при выполнении WHEN-условия
  // lReturnGet - если .T. и по умолчанию выход после выбора значения из тек. oGet
  //                   .F. после выбора остаемся в тек. oGet
PLOCAL lRefer,nRow:=ROW(),nCol:=COL(),nRefer:=0,sHelp
PLOCAL nRowHelp,nColHelp,cMess, nLenHelp
PLOCAL lastCursor := SETCURSOR(),nWin:=WSELECT(), lUpdate := .F.
PLOCAL aSymb:=' 1234567890!@#$%^&*()_-+QWERTYUIOP{}[]ASDFGHJKL:"ZXCVBNM<>?ЙЦУКЕНГШЩЩЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮЁ'

IF(ValType(lReturnGet) = "L",,lReturnGet := .T.)
#ifdef __HARBOUR__
if get:ExitState == GE_SHORTCUT .OR.;
   get:ExitState == GE_MOUSEHIT .OR.;
   GetPreValidate(Get)

#else
if GetPreValidate(get)
#endif
    // Активизация GET-объекта для чтения
   get:SetFocus()
   SETCURSOR(1)
   while ( get:exitState == GE_NOEXIT )
      // прием и анализ нажатия клавиш до выхода из чтения
      nRow:=ROW();nCol:=COL()
      nRowHelp := NIL
      IF !EMPTY(cRefer).AND.(nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)}))>0
         cMess:=IF(EMPTY(aRefer[nRefer,P_HELP0])," F2:Справочник ",IF(ValType(aRefer[nRefer,P_HELP0]) = "A",(nRowHelp := aRefer[nRefer,P_HELP0,1],nColHelp := aRefer[nRefer,P_HELP0,2],IF(ValType(aRefer[nRefer,P_HELP0,3]) = "B",EVAL(aRefer[nRefer,P_HELP0,3]),aRefer[nRefer,P_HELP0,3])),aRefer[nRefer,P_HELP0]))
         IF TYPE("nApp")="N".AND.nApp==0
            cMess:=ALLTRIM(cMess)+' Пустое поле:безразличный фактор <+>:Поле не пусто <->:Поле пусто'
         ENDIF


         IF nRowHelp = NIL
           nRowHelp:=IF(aRefer[nRefer,P_ROWHELP]==NIL,MAXROW(),aRefer[nRefer,P_ROWHELP])
           nColHelp := IF(aRefer[nRefer,P_COLHELP] = NIL,IF(nWin = 0,0,1),aRefer[nRefer,P_COLHELP])
           cMess := IF(aRefer[nRefer,P_COLHELP] != NIL .OR. nWin != 0,cMess,PADC(cMess,80))
         ENDIF
         nLenHelp := LEN(cMess)
         sHelp:=BrSaveScreen(nRowHelp,nColHelp,nRowHelp,nColHelp+nLenHelp-1)
         IF nRowHelp > 22
           SCRTITUL(nRowHelp,ALLTRIM(cMess))
         ELSEIF nRowHelp>0
           SAYSCREEN(cMess,nRowHelp,nColHelp)
         ENDIF
      ENDIF
      SETRC(nRow,nCol)
      WHILE ( get:exitState == GE_NOEXIT )
         IF lSpec!=NIL.AND.get:pos=1.AND.TYPE('Pre_')='C'.AND.!EMPTY(m->Pre_)
            get:right()
         ENDIF
         lRefer := .F.
         SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
         GetApplyKey( get, Inkey(0,INKEY_KEYBOARD+INKEY_LDOWN+INKEY_LUP+INKEY_RDOWN+INKEY_RUP+INKEY_MWHEEL))
         IF (LastKey() == KL_REFER)
            DoRefer(get,cRefer,.T.,@lUpdate,,,aSymb)
            IF (LASTKEY() != K_ESC)
               lRefer :=.T.
            ENDIF
         ENDIF
      END
      IF sHelp!=NIL
         BrRestScreen(sHelp)
      ENDIF
   if !(get:ExitState == GE_SHORTCUT .OR. get:ExitState == GE_MOUSEHIT)

      IF (!lRefer .and. LASTKEY() != K_ESC)
         DoRefer(get,cRefer,.F.,@lUpdate,,,aSymb)
      ENDIF
      IF ( (!lReturnGet .AND. lUpdate) .OR. ;
           get:exitState == GE_NOEXIT  .OR. ;
           !GetPostValidate(get) )
         get:exitState := GE_NOEXIT
      ENDIF
    #ifdef __HARBOUR__
    endif
    #endif

      lUpdate := .F.
   END
    // деактивизация GET
   get:KillFocus()
END
SETCURSOR(lastCursor)
SETRC(nRow,nCol)
RETURN (NIL)

PROCEDURE ClearRefer(cRefer)
PLOCAL nRefer,len:=LEN(aRefer)
IF (cRefer!=NIL)
   IF (nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)}))>0
      ADEL(acRefer,nRefer)
      ADEL(aRefer,nRefer)
      ASIZE(acRefer,len-1)
      ASIZE(aRefer,len-1)
   ENDIF
ELSE
   aRefer:={}
   acRefer:={}
ENDIF
RETURN

Function ReferPush()
  AAdd(aSaveRefer, {AClone(aRefer), AClone(acRefer)})
Return (NIL)

Function ReferPop()
  PLOCAL nLen := Len(aSaveRefer)
  ASize(aRefer, 0)
  ASize(acRefer, 0)
  aRefer  := aSaveRefer[nLen][1]
  acRefer := aSaveRefer[nLen][2]
  ASize(aSaveRefer, --nLen)
Return (NIL)

PROCEDURE DoRefer(get,cRefer,lEndInput,lUpdated,lNoGoTo,nDispRow,aSymb)
// lNoGoTo - не делать GO TOP, если get = NIL
// nDispRow - строка позиционирования в qBrowse  (возвращается по ссылке)
LOCAL n, nRefer0
PLOCAL nLastArea,nLastRecNo,nArea,LastColor,nCount,nCo:=0
PLOCAL lDisplay:=.T.,nAscan,nRec,xKey
PLOCAL X1,Y1,Y2,X2,nHeadsRow,cLine,sRest,cHelp:=''
PLOCAL nCursor,nOrd0
PLOCAL nRow:=ROW(),nCol:=COL()
PLOCAL nWi:=WSELECT(),lBlink,nOrd,aSetKey, nOrderDisp, xRet
PLOCAL bPreDisp,bPostDisp,bColor,bColor2,bOldBlock,lExecPost:=.F.
PLOCAL nRefer:=IF(EMPTY(cRefer),0,ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)}))
PLOCAL nHeadsBottom := 0
PLOCAL bDispSpr, aRetKey := {}, aOtherKey
PLOCAL aHotKey, cKeyVal, aRetArray
PLOCAL nMyRecNo
lUpdated:=.F.

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

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

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



aSymb := if(aSymb == NIL,' 1234567890!@#$%^&*()_+QWERTYUIOP{}[]ASDFGHJKL:"ZXCVBNM<>?ЙЦУКЕНГШЩЩЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮЁ',aSymb)

IF (get!=NIL.AND.!lEndInput .AND. LASTKEY()==K_UP)
   RETURN
ENDIF
IF nRefer>0
   xKeySeek := '' 
   aSetKey:=SaveSetKey()
   IF (get!=NIL)
      InitCargo(get)
      IF (DEF_CARGO(get)!=NIL.AND.VALTYPE(DEF_CARGO(get))='L')
         nCo:=LEN(get:buffer)
         nCount:=LEN(TRIM(get:buffer))
         IF DEF_CARGO(get).OR.RIGHT(ALLTRIM(get:buffer),1)='*'
            get:buffer:=SPACE(nCo-nCount)+trim(get:buffer)
         ELSEIF !DEF_CARGO(get)
            get:buffer:=SPACE(nCo-nCount-1)+trim(get:buffer)+' '
         ENDIF

	IF !lNoInt	// Вася 26 января
         get:display()
        ENDIF

      ENDIF
      get:assign()
      IF (IF(Empty(aRefer[nRefer,P_YESVALUE]),;
           (EMPTY(TypeGetBuffer(get)).OR.'*'$get:buffer),;
           Eval(aRefer[nRefer,P_YESVALUE],get));
           .AND. aRefer[nRefer,P_TYP]==2 .AND. !lEndInput)
       RestSetKey(aSetKey)
       RETURN
      ENDIF
      IF (!lEndInput .AND. (aRefer[nRefer,P_TYP]==3.OR.;
      TYPE('nApp')=='N'.AND.nApp==0))
         IF (LASTKEY() == K_ESC)
            get:exitState := GE_NOEXIT
         ENDIF
         RestSetKey(aSetKey)
         RETURN
      ENDIF
   ENDIF
   nLastArea:=SELECT()
   nLastRecNo:=RECNO()
   DBSELECTAREA(aRefer[nRefer,P_ALIAS])
   nArea:=SELECT()
   bPreDisp:=aRefer[nRefer][P_PREDISP]
   bPostDisp:=aRefer[nRefer][P_POSTDISP]
   bDispSpr:=aRefer[nRefer][P_DISPSPR]
   aHotKey:=aRefer[nRefer][P_HOTKEY]
   aOtherKey := aRefer[nRefer][P_OTHERKEY]
   IF (bPreDisp!=NIL)
      xRet := EVAL(bPreDisp,lEndInput, aRefer[nRefer,P_RECT] )
      SELECT(nArea)
      SKIP;SKIP-1
      IF(ValType(xRet) = "A" .AND. LEN(xRet) >= 1 .AND. (ValType(xRet[1]) = "C" .OR. ValType(xRet[1]) = "N"),nOrderDisp := xRet[1],NIL)
      nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)})  // !!!!
      IF(ValType(xRet) = "A" .AND. LEN(xRet) >= 2 .AND. ValType(xRet[2]) = "A",aRefer[nRefer,P_SORT] := xRet[2],NIL)
      IF(ValType(xRet) = "A" .AND. LEN(xRet) >= 3 .AND.(ValType(xRet[3]) = "C" .OR. ValType(xRet[3]) = "N"),aRefer[nRefer,P_TAG_SEEK] := xRet[3],NIL)
   ENDIF

   IF (get!=NIL)
      //Проверка после ввода Get-переменной при изменении буфера редактирования
      nRec := RECNO()
      // Ключевой поиск
      nOrd0:=ORDNUMBER()
      IF aRefer[nRefer,P_TAG]!=NIL
         IF VALTYPE(aRefer[nRefer,P_TAG]) = 'B'
            ORDSETFOCUS(EVAL(aRefer[nRefer,P_TAG]))
         ELSE
            ORDSETFOCUS(aRefer[nRefer,P_TAG])
         ENDIF
      ENDIF
   cKeyVal := aRefer[nRefer,P_KEYVAL]
   if cKeyVal != NIL.AND.!EMPTY(ORDSETFOCUS()) //Для справочников без индексов. := NIL
        IF (;
           ((aRefer[nRefer,P_TYP]=2 .AND.;
           VALTYPE(&cKeyVal)='C'.AND.;
           DBSEEK(TRIM(&cKeyVal),.T.)) .OR.;
           (DBSEEK(&cKeyVal,.T.)));
          ).OR.;
          (;
            aRefer[nRefer,P_TYP]=5 .AND.;
            VALTYPE(&cKeyVal)='N'.AND.;
            &cKeyVal = -1;
          )
         lDisplay := lEndInput
      ENDIF

      ORDSETFOCUS(nOrd0)
      IF (!FOUND())
         IF (lDisplay)
            IF (get!=NIL .AND. aRefer[nRefer,P_KEYVALDISP]!=NIL)
               DBSEEK(&(aRefer[nRefer,P_KEYVALDISP]))
            ENDIF
            IF EOF()
               SKIP-1
               IF ((BOF().OR.EOF()).AND.aRefer[nRefer,P_INPUT]==NIL)
                  nCursor:=SETCURSOR(0)
                  SayError('Справочник пуст!',,'LastKeyON')
                  SETCURSOR(nCursor)
                  IF LASTKEY()!=K_ESC
                     KEYBOARD CHR(K_UP)
                  ELSE
                     KEYBOARD CHR(K_UP)+CHR(K_UP)
                  ENDIF
                  IF (bPostDisp!=NIL)
                     EVAL(bPostDisp,lEndInput,nOrderDisp)
                  ENDIF
                  SELECT(nLastArea)
                  RestSetKey(aSetKey)
                  RETURN
               ENDIF
            ENDIF
         ELSE
            GO LastRec()+1
         ENDIF
      end 
      ELSEIF (lDisplay.AND.bPreDisp!=NIL).AND.EOF()
         SKIP-1
         IF ((BOF().OR.EOF()).AND.aRefer[nRefer,P_INPUT]==NIL)
            nCursor:=SETCURSOR(0)
            SayError('Справочник пуст!',,'LastKeyON')
            SETCURSOR(nCursor)
            IF LASTKEY()!=K_ESC
               KEYBOARD CHR(K_UP)
            ELSE
               KEYBOARD CHR(K_UP)+CHR(K_UP)
            ENDIF
            IF (bPostDisp!=NIL)
               EVAL(bPostDisp,lEndInput,nOrderDisp)
            ENDIF
            SELECT(nLastArea)
            RestSetKey(aSetKey)
            RETURN
         ENDIF
      ENDIF
   ELSE
      lDisplay:=.T.
      IF EMPTY(lNoGoTo)
        GO TOP
      ENDIF
   ENDIF

   IF lNoInt
        lDisplay := .F. // Вася - для импорта в инитлист 26 января 2005
   ENDIF



   IF lDisplay
      nOrd:=ORDNUMBER()
      IF nOrderDisp != NIL .AND.;
         (;
           ValType(nOrderDisp) = "N" .OR.;
           (;
             ValType(nOrderDisp) = "C".AND.;
             ASCAN(Bs_Tags(),{|cTag| cTag == UPPER(ALLTRIM(nOrderDisp)) }) != 0;
            );
          )
        ORDSETFOCUS(nOrderDisp)
      ENDIF
      nWi:=WSELECT()
      WSELECT(0)
      lBlink:=SETBLINK(.F.)
      nCursor:=SETCURSOR(0)
      IF bDispSpr = NIL .OR. ValType((xRet := EVAL(bDispSpr))) != "A"
        Y1 := aRefer[nRefer,P_RECT][1]
        X1 := aRefer[nRefer,P_RECT][2]
        Y2 := aRefer[nRefer,P_RECT][3]
        X2 := aRefer[nRefer,P_RECT][4]
        nHeadsRow := aRefer[nRefer,P_RECT][5]
        nHeadsBottom := 1
        sRest:=SAVESCREEN(Y1,X1,Y2+1,X2+2)
        LastColor:=SETCOLOR(aRefer[nRefer,P_COLOR,1]+','+aRefer[nRefer,P_COLOR,2])
        ShadowBox(' '+IF(VALTYPE(aRefer[nRefer,P_HEAD])='C',aRefer[nRefer,P_HEAD],;
        EVAL(aRefer[nRefer,P_HEAD]))+' ',Y1,X1,Y2,X2)
        @ Y2-2,X1 SAY '╟'+REPLICATE('─',X2-X1-1)+'╢'
        @ nHeadsRow+Y1+1,X1+1 SAY REPLICATE('─',X2-X1-1)

        FOR nCount:=1 TO LEN(aRefer[nRefer,P_BLOCKCOL])
          nCo:=Y1
          AEVAL(aRefer[nRefer,P_KEYHEADS,nCount],;
          {|x|SETPOS(++nCo,aRefer[nRefer,P_BLOCKCOL,nCount,2]),DISPOUT(x)})
        NEXT
        AEVAL(aRefer[nRefer,P_HELP],{|x|cHelp+=x[1]+' '})
        @ Y2-1,X1+1 SAY TRIM(cHelp)
        SETCOLOR(aRefer[nRefer,P_COLOR,2])
        @ Y2-1,X1+1+3 SAY 'Выбор'
      ELSE
        Y1 := xRet[1]
        X1 := xRet[2]
        Y2 := xRet[3]
        X2 := xRet[4]
        nHeadsRow := xRet[5]
        nHeadsBottom := xRet[6]
        sRest := xRet[7]
      ENDIF
      
      if !Empty(aRefer[nRefer,P_ORDSEEK])
         SayKey(nRefer)
      end

      SETCOLOR(aRefer[nRefer,P_COLOR,2])
      SETCOLOR(aRefer[nRefer,P_COLOR,1])
      bColor:=aRefer[nRefer][P_BCOLOR]
      SETKEY(K_RETURN,{||MenuProc(nRefer)})
      SETKEY(K_LEFT,{||MenuProc(nRefer)})
      SETKEY(K_RIGHT,{||MenuProc(nRefer)})
      SETKEY(K_F4,IF(aRefer[nRefer,P_INPUT] !=NIL,{||RefInput(nRefer,2)},NIL))
      SETKEY(K_CTRL_ENTER,IF(aRefer[nRefer,P_EDIT] !=NIL,{||RefInput(nRefer,1)},NIL))
      IF aRefer[ nRefer, P_YES_ARRAY ]
        SETKEY( K_INS, {|xi|;
          xi := ASCAN( aRefer[ nRefer, P_VAR_ARRAY],RECNO()),;
          IF(aRefer[ nRefer, P_YESNOREPL] = NIL .OR. EVAL(aRefer[ nRefer, P_YESNOREPL],xi == 0, xi,aRefer[ nRefer, P_VAR_ARRAY]),;
             IF( xi == 0,;
                 AADD(aRefer[ nRefer, P_VAR_ARRAY],RECNO()),;
                 (;
                  ADEL(aRefer[ nRefer, P_VAR_ARRAY], xi ),;
                  ASIZE( aRefer[ nRefer, P_VAR_ARRAY], LEN(aRefer[ nRefer, P_VAR_ARRAY])-1);
                 );
              ),;
             NIL;
            ),2;
           };
          )

        SETKEY( ASC('-'), {|| GrayPlusMinus( @nRefer, '-' ),2  } )
        SETKEY( ASC('+'), {|| GrayPlusMinus( @nRefer, '+' ),2  } )

        IF aRefer[ nRefer, P_REPL] != NIL
			    aRetArray := ACLONE( EVAL( aRefer[ nRefer, P_BLOCK_ARRAY] ) )
			    aRefer[ nRefer, P_VAR_ARRAY] := {}
			    DBEVAL({|| AADD(aRefer[ nRefer, P_VAR_ARRAY],RECNO()) },{|| ASCAN(aRetArray,EVAL(aRefer[ nRefer, P_REPL])) != 0 })
          dbGoTop()
			  ELSE
          aRefer[ nRefer, P_VAR_ARRAY] := ACLONE( EVAL( aRefer[ nRefer, P_BLOCK_ARRAY] ) )
        ENDIF

        bColor2 := {|nCol| IF(nCol==1, 'N/W', 'W+/N' ) }
      ENDIF
      qInitPush()  // для сохранения установок qHelp'а
      IF !EMPTY(aRefer[nRefer,P_FIND])
         PRIVATE cFind:=SPACE(30)
         bOldBlock:=IniString(aRefer[nRefer,P_FIND],DBFILTER())
         SETKEY(K_ALT_F7,{||FindName()})
         SETKEY(K_ALT_F6,{||FiltName(aRefer[nRefer,P_FIND],DBFILTER(),ScopeMacro())})
         SETKEY(K_ALT_F12,{||FiltName(aRefer[nRefer,P_FIND],DBFILTER(),ScopeMacro())})
         SETKEY(K_CTRL_F6,{||QSetFilter(,,"Снять")})
      ENDIF

      IF ValType(aOtherKey) = "A"
        AEVAL(aOtherKey,{|x| SetKey(x[1],x[2]) })
      ENDIF

      ViewSortSeek(aRefer[nRefer,P_SORT],.T.,{||QSeek(aRefer[nRefer,P_SORT],COL_REF1,aRefer[nRefer,P_RECT,1]+2,aRefer[nRefer,P_RECT,2]+2)},{||QSort(aRefer[nRefer,P_SORT],COL_REF1,aRefer[nRefer,P_RECT,1]+2,aRefer[nRefer,P_RECT,2]+2)})

      WHILE .T.
//        Qbrowse(Y1+nHeadsRow+2,X1+1,Y2-2-nHeadsBottom,X2-1,aRefer[nRefer,P_BLOCKCOL],,aRefer[nRefer,P_COPROC],bColor,,bColor2,nDispRow,aHotKey,@aRetKey,aRefer[nRefer,P_BSAYHEAD],aRefer[nRefer,P_BKEYHEAD])

// Во время отработки блоков на клавишах изменяется acRefer и aRefer, а nRefer остается каким был. Поэтому нужно его
// еще разок вычислить. Вася
          nRefer0 := IF(EMPTY(cRefer),0,ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)}))
          If nRefer0 > 0
             nRefer := nRefer0
          Endif
 


          Qbrowse(Y1+nHeadsRow+2,X1+1,Y2-2-nHeadsBottom,X2-1,aRefer[nRefer,P_BLOCKCOL],,{||CoProc(aSymb,nRefer)},bColor,,bColor2,nDispRow,aHotKey,@aRetKey,aRefer[nRefer,P_BSAYHEAD],aRefer[nRefer,P_BKEYHEAD])
        IF aRetKey != NIL
          aRetKey[1] := EVAL(aRetKey[3],ProcName(1), ProcLine(1), "")
        ELSE
          EXIT
        ENDIF
      END
      nDispRow := ROW()
      IF LastKey() == K_ENTER .AND. aRefer[ nRefer, P_YES_ARRAY ]
        // Передадим назад массив, если его выбрали
        IF aRefer[ nRefer, P_REPL] != NIL
          aRetArray := ARRAY(LEN(aRefer[ nRefer, P_VAR_ARRAY]))
          AEVAL(aRefer[ nRefer, P_VAR_ARRAY],{|x,xi| dbGoto(x),aRetArray[xi] := EVAL(aRefer[ nRefer, P_REPL]) })
        ENDIF
        EVAL( aRefer[ nRefer, P_BLOCK_ARRAY],IF(ValType(aRefer[ nRefer, P_REPL]) = "B",aRetArray,aRefer[ nRefer, P_VAR_ARRAY]))
        IF !EMPTY( aRefer[ nRefer, P_VAR_ARRAY] )
          dbGoTo( aRefer[ nRefer, P_VAR_ARRAY][1] )
        ENDIF
      ENDIF
      IF !EMPTY(aRefer[nRefer,P_FIND])
         SetFindBlock(bOldBlock)
      ENDIF
      qInitPop()
      nOrderDisp := ORDNUMBER()
      RestSetKey(aSetKey)
      // Lexx Принудительное снятие фильтра из-за странностей XMOD
      IF ORDNAME() = "MY_"
         nMyRecNo:=RECNO()
         MyCloseFilter()
         DBGOTO(nMyRecNo)
      ENDIF
      ORDSETFOCUS(nOrd)
      IF (bPostDisp!=NIL)
         EVAL(bPostDisp,lEndInput,nOrderDisp)
         nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)})
         lExecPost:=.T.
      ENDIF
      RESTSCREEN(Y1,X1,Y2+1,X2+2,sRest)
      SETCOLOR(LastColor)
      SETPOS(nRow,nCol)
      SETCURSOR(nCursor)
      SETBLINK(lBlink)
      WSELECT(nWi)
   ENDIF
   IF Recno() = LastRec()+1 .AND. LastKey() = K_ENTER .AND. lDisplay
     SetLastKey(K_ESC)
   ENDIF
   IF (get!=NIL.AND.LASTKEY()!= K_ESC.AND.nRefer>0.AND.aRefer[nRefer,P_TYP] > 0 .AND.;
      aRefer[nRefer,P_DEST] != NIL .AND. aRefer[nRefer,P_SOURCE] != NIL)
      PRIVATE acMems   := aRefer[nRefer,P_DEST]
      // PRIVATE acFields := aRefer[nRefer,P_SOURCE]  PVP (Поляков В.П.) - B_SOURCE разрешение блоков кода
      n:=LEN(aRefer[nRefer,P_SOURCE])
      FOR nCount := 1 TO n // Len(acFields) //Проход по входным массивам
        xRet:=aRefer[nRefer,P_SOURCE][nCount]  // выражение для записи в место назначения
        Do Case
          Case VALTYPE(xRet)=='C'
            xRet:=&xRet
          Case VALTYPE(xRet)=='B'
            xRet:=EVAL(xRet)
        EndCase
        IF !(&(acMems[nCount]) == /*&(acFields[nCount])*/ xRet)
          &(acMems[nCount]) := xRet // &(acFields[nCount])
          IF TYPE(acMems[nCount])=='C'.AND.VALTYPE(DEF_CARGO(get))='L'.AND.!DEF_CARGO(get)
            &(acMems[nCount])+=' '
          ENDIF
          lUpdated := .T.
        ENDIF
      NEXT
   ENDIF
   IF !lExecPost.AND.(bPostDisp!=NIL)
      EVAL(bPostDisp,lEndInput,nOrderDisp)
      nRefer:=ASCAN(acRefer,{|x|UPPER(x)==UPPER(cRefer)})
   ENDIF
   SELECT (nLastArea)
   IF (nArea==nLastArea)
      GO nLastRecNo
   ENDIF
   IF lUpdated
      IF (Len(aRefer[nRefer,P_SOURCE]/*acFields*/) > 1) //  PVP  - B_SOURCE
	IF !lNoInt // Вася 26 января
             AEVAL(GetList,{|oGet| oGet:display() })
        ENDIF
      ENDIF
      get:updateBuffer()
   ENDIF
   IF (get!=NIL.AND.nRefer>0)
      IF (LASTKEY()==K_ESC)
         IF (aRefer[nRefer,P_TYP] != 4)
            get:exitState := GE_NOEXIT
         ENDIF
      ELSEIF (aRefer[nRefer,P_TYP] > 0 .AND. (LASTKEY()==K_RETURN .OR. LASTKEY()==K_DOWN))
         get:exitState := GE_ENTER
      ENDIF
   ENDIF
   RestSetKey(aSetKey)
ENDIF
RETURN

STATIC PROCEDURE GrayPlusMinus( nRefer, cKey )
  PLOCAL xRec:=RECNO(), i, nMax := LEN(aRefer[ nRefer, P_VAR_ARRAY]),;
        aVAR_ARRAY

  IF cKey == '-'
    aVAR_ARRAY := ACLONE( aRefer[ nRefer, P_VAR_ARRAY] )
    ASIZE( aRefer[ nRefer, P_VAR_ARRAY], 0 )
    IF aRefer[ nRefer, P_YESNOREPL] <> NIL
      FOR i := 1 TO nMax
        dbGoTo( aVAR_ARRAY[ i ] )
        IF !EVAL(aRefer[ nRefer, P_YESNOREPL],.F., i,aVAR_ARRAY)
          AADD( aRefer[ nRefer, P_VAR_ARRAY], aVAR_ARRAY[ i ] )
        ENDIF
      NEXT
    ENDIF
    aVAR_ARRAY := NIL

  ELSEIF cKey == '+'
    dbEVAL( {|| AADD(aRefer[ nRefer, P_VAR_ARRAY],RECNO()) },;
            {|| (aRefer[ nRefer, P_YESNOREPL] = NIL .OR. ;
                 EVAL(aRefer[ nRefer, P_YESNOREPL],.T., 0,aRefer[ nRefer, P_VAR_ARRAY])  ;
                ).AND.;
                 LEN(aRefer[ nRefer, P_VAR_ARRAY])<4000 };
          )
  ENDIF
  dbGoTo(xRec)
RETURN

FUNCTION MenuProc(nRefer)
PLOCAL nMaxChoice:=LEN(aRefer[nRefer,P_HELP])
PLOCAL nRet:=1  //,aGetList:=GetList,aLastIn:=aIn
PLOCAL bF3:=SETKEY(K_F3)
PLOCAL bF4:=SETKEY(K_F4)
PLOCAL bF6:=SETKEY(K_F6)
PLOCAL bF7:=SETKEY(K_F7)
PLOCAL bAltF7:=SETKEY(K_ALT_F7)
PLOCAL bAltF6:=SETKEY(K_ALT_F6)
PLOCAL aSetKey:=SaveSetKey()
PLOCAL nChoice:=aRefer[nRefer,P_CHOICE]
// Измеение 3.150
PLOCAL xi
DO CASE
   CASE LASTKEY()==K_RIGHT
   RefPos(nChoice,1,nRefer)
   nChoice++
   IF nChoice>nMaxChoice
      nChoice:=1
   ENDIF
   RefPos(nChoice,2,nRefer)
   CASE LASTKEY()==K_LEFT
   RefPos(nChoice,1,nRefer)
   nChoice--
   IF (nChoice<1)
      nChoice:=nMaxChoice
   ENDIF
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN .AND. nChoice==1)
   nRet:=0
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],9)=='F7,Alt-F7')
   nRet:=BoxMenu('',aRefer[nRefer,P_RECT,1]+2,aRefer[nRefer,P_RECT,2]+2,;
   {'Быстрый поиск  ','Поиск фрагмента'},,,,COL_REFER,COL_REFER)
   IF nRet=1
      nRet:=EVAL(bF7)
   ELSEIF nRet=2
      nRet:=EVAL(bAltF7)
   ELSE
      nRet:=1
   ENDIF
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],2)=='F7')
   nRet:=EVAL(bF7)
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],6)=='Alt-F7')
   nRet:=EVAL(bAltF7)
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],2)=='F3')  .AND. VALTYPE(bF3)='B'
   nRet:=EVAL(bF3)
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],2)=='F4')
   nRet:= IF(bF4 != NIL,EVAL(bF4),RefInput(nRefer,2))
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE LASTKEY()==K_RETURN .AND. ;
        LEFT(aRefer[nRefer,P_HELP,nChoice,1],3)=='Ins'
     IF (xi := ASCAN( aRefer[ nRefer, P_VAR_ARRAY],RECNO()) ) == 0
       AADD(aRefer[ nRefer, P_VAR_ARRAY],RECNO())
     ELSE
       ADEL(aRefer[ nRefer, P_VAR_ARRAY], xi )
       ASIZE( aRefer[ nRefer, P_VAR_ARRAY], LEN(aRefer[ nRefer, P_VAR_ARRAY])-1)
     ENDIF
     nRet := 2
   CASE (LASTKEY()==K_RETURN .AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],10)=='Ctrl-Enter')
   nRet:=RefInput(nRefer,1)
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
   CASE (LASTKEY()==K_RETURN.AND. ;
       LEFT(aRefer[nRefer,P_HELP,nChoice,1],2)=='F6').AND.TYPE('bF6')='B'
   nRet:=EVAL(bF6)
   RefPos(nChoice,1,nRefer)
   nChoice:=1
   RefPos(nChoice,2,nRefer)
ENDCASE
aRefer[nRefer,P_CHOICE]:=nChoice
RestSetKey(aSetKey)
RETURN (nRet)

STATIC FUNCTION RefPos(nPos,nColor,nRefer)
PLOCAL cLastColor:=SETCOLOR(aRefer[nRefer,P_COLOR,nColor])
PLOCAL nY:=aRefer[nRefer,P_RECT][3]-1
PLOCAL nPos1:=AT(':',aRefer[nRefer,P_HELP][nPos][1])
PLOCAL nX:=aRefer[nRefer,P_HELP][nPos][2]+nPos1
@ nY,nX SAY SUBSTR(aRefer[nRefer,P_HELP][nPos][1],nPos1+1)
RETURN (NIL)

STATIC FUNCTION RefInput(nRefer, nReferApp)
PLOCAL aKoord:=aRefer[nRefer,P_RECT,6]
PLOCAL aHeads:=aRefer[nRefer,P_INPUT]
PLOCAL aPict:=aRefer[nRefer,P_PICT]
PLOCAL aWhen:=aRefer[nRefer,P_WHEN]
PLOCAL aValid:=aRefer[nRefer,P_VALID]
PLOCAL aRef:=aRefer[nRefer,P_REF]
PLOCAL aGetBlock:=aRefer[nRefer,P_GETBLOCK]
PLOCAL bPost:=aRefer[nRefer,P_POST]
PLOCAL nTag:=aRefer[nRefer,P_TAG_SEEK]
PLOCAL bScrInit := aRefer[nRefer,P_SCRINIT]
PLOCAL bScrPost := aRefer[nRefer,P_SCRPOST]
PLOCAL bPreGet := aRefer[nRefer][P_PREBLOCK]
PLOCAL bPostGet := aRefer[nRefer][P_POSTBLOCK],lRez
PLOCAL bPostRead  := aRefer[nRefer][P_POSTREAD]
PLOCAL lRet
   xKeySeek := '' 
   if !Empty(aRefer[nRefer,P_ORDSEEK]) 
      SayKey(nRefer)
   end
   lRet := QInput(aKoord[1],aKoord[2],aKoord[3],;
      aKoord[4],aRefer[nRefer,P_INPUT],nReferApp,aRef,;
      aPict,aWhen,aValid,xUniRef,bScrInit,bPost,,;
      "REFER",aGetBlock,bScrPost,,bPreGet,;
      bPostGet,nTag,,,,,,bPostRead)
Return (lRet)

//---------------------------------------------------------------------------//
                     FUNCTION SaveRefPos(cRefer)
//---------------------------------------------------------------------------//
// Возвращает массив координат окна ввода для рефера с именем cRefer
PLOCAL aKoord := {0,0,0,0}
PLOCAL nRefer := ASCAN(acRefer,{|x| UPPER(x)==UPPER(cRefer)})
IF !EMPTY(nRefer)
  aKoord := aRefer[nRefer,P_RECT,6]
ENDIF
RETURN aKoord
//--------------------------------------------------------------------------//
                        FUNCTION TypeGetBuffer(oGet)
//--------------------------------------------------------------------------//
// Возвращает буфер в реальном типе данных
  IF oGet:buffer <> NIL
    IF oGet:Type = "N"
      RETURN VAL(oGet:buffer)
    ELSEIF oGet:Type = "D"
      RETURN CTOD(oGet:buffer)
    ELSEIF oGet:Type = "L"
      RETURN "T" $ oGet:buffer
    ENDIF
  ENDIF
RETURN oGet:buffer

STATIC FUNCTION SeekProc(aSymb,nRefer) //Сопроцедура справочника для непосредственного поиска
LOCAL nRet:=1
Local nRec := RecNo()
LOCAL ll := IF(IsSetFilter(),MyCloseFilter(),NIL)
LOCAL nOrd
LOCAL cKey := if( aRefer[nRefer,P_LEFTKEY] == NIL,'',aRefer[nRefer,P_LEFTKEY])

/*
if ValType(aRefer[nRefer,P_ORDSEEK]) == 'B'
   nOrd := ORDSETFOCUS(Eval(aRefer[nRefer,P_ORDSEEK]))
  else
   nOrd := ORDSETFOCUS(aRefer[nRefer,P_ORDSEEK])
end
*/
nOrd := OrdSetFocus(if(ValType(aRefer[nRefer,P_ORDSEEK]) == 'B',;
                    Eval(aRefer[nRefer,P_ORDSEEK]),;
                         aRefer[nRefer,P_ORDSEEK]  ) )




if ValType( aRefer[nRefer,P_LEFTKEY] ) == 'B' 
   cKey := Eval(aRefer[nRefer,P_LEFTKEY])
end
//altd()
IF UPPER(CHR(LASTKEY()))$aSymb.OR.(LASTKEY()==K_BS.AND.LEN(xKeySeek)>0)
   IF LASTKEY()==K_BS
      xKeySeek := LEFT(xKeySeek,LEN(xKeySeek)-1)
   ELSE
      xKeySeek += CHR(LASTKEY())
   ENDIF
      if(!Empty(cKey),cKey+xKeySeek,xKeySeek)
   if !dbSeek(UPPER(TRIM(cKey+xKeySeek)),.F.)
      xKeySeek := LEFT(xKeySeek,LEN(xKeySeek)-1)
      OrdSetFocus(nOrd)
      dbGoto(nRec)
   end
   SayKey(nRefer)
   nRet:=2
ENDIF
RETURN(nRet)
// pVp
STATIC FUNCTION CoProc(aSymb,nRefer)
LOCAL nRet:=1, nLastKey := LASTKEY()

IF !EMPTY(aRefer[nRefer,P_ORDSEEK]).AND.(nLastKey>0).AND.(nLastKey<256).AND.;       //<256 для исключения мышинных событий victor
(UPPER(CHR(nLastKey))$aSymb.OR.nLastKey==K_BS)
   nRet:=SeekProc(aSymb,nRefer)
ENDIF

IF !EMPTY(aRefer[nRefer,P_COPROC])
    EVAL(aRefer[nRefer,P_COPROC])
ENDIF

RETURN nRet

//
Static Function SayKey(nRefer,nTop,nLeft,nLen)
nTop  := if(nTop  == NIL,aRefer[nRefer,P_RECT][5]+aRefer[nRefer,P_RECT][1]+1,nTop)

if !Empty(aRefer[nRefer,P_POSKEY])
   nTop := aRefer[nRefer,P_POSKEY]
end

nLeft := if(nLeft == NIL,aRefer[nRefer,P_RECT][2]+3,nLeft)
nLen  := if(nLen  == NIL,aRefer[nRefer,P_RECT][4]-aRefer[nRefer,P_RECT][2]-6,nLen)

@ nTop,nLeft SAY '['+PADR(xKeySeek,nLen,'.')+']' COLOR aRefer[nRefer,P_COLOR,1]
Return (1)

Function RefActive(cRef)
if cRef != NIL
   Return (!Empty(aScan(acRefer,{|x| Upper(x) == Upper(cRef) })))
end
Return(acRefer)
//Уникальность для QInput , при дополнении справочников
Function SetUniRef(x)
if x == NIL
   Return (xUniRef)
  else
   xUniRef := x
end
Return (xUniRef)
//
