MakeRefer

 /****** Прототипы *********
 @ 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 /* V@ 6 августа 2001 г EVAL( {|i| nPos:=GetAnalize( GlobalTask ), ; EVAL({||IF(nPos[1]<>0,lArm:=nPos[2],),; IF(!lArm,ERRORLEVEL(3), ) }) } ) */ 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() //V@ 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)= 8.AND. V_aHead[8]!=NIL.AND.V_aHead[8] == 0) V_LEN := V_LEN+1 ENDIF ENDFOR // 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