// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.
#include "getexit.ch"
#include "s_public.ch"
#include "inkey.ch"
#include "setcurs.ch"
#ifndef __HARBOUR__
   #include "ctscan.ch"
#else
    #include "ctscan_h.ch"
#endif
#include "box.ch"

// Параметры Get объекта передаваемого в GetBlock
#DEFINE HEAD_POZ       oGet:name[3]   // позиция в aIn
#DEFINE HEAD_BAK       oGet:name[5]   // предыдущее значение aIn
#DEFINE HEAD_LOOP      oGet:name[2,7] // флаг повторного запуска ReadModal()
                                      // без выполнения bPostRead,bPostGet
#DEFINE HEAD_SET_GET   oGet:name[2,8] // позиция начального позиционирования
                                      // при прорисовке GetList

#define TRUE 'Да '
#define FALSE 'Нет'

STATIC bLine

#ifdef __HARBOUR__
  //в базе прописано укороченное имя
  FUNCTION RotateAndRead(oGet, aSim, nRow, nCol, lRotate, cPrompt, cColor1, cColor2, aExt,bCurr)
  RETURN RotateAndReader(oGet, aSim, nRow, nCol, lRotate, cPrompt, cColor1, cColor2, aExt,bCurr)
#endif


/***********************************************************
 * CondReader()
 *           Редактор модифицированного GET-объекта
 *   Параметры: GET-объект
 *              lPrompt -если .F. не выдавать подсказку (default .T.) !!!!
 */
PROCEDURE CondReader( oGet, lPrompt , aPrompt)
   // Редактирование очень упрощенное, большинство
   // специфических клавиш игнорируются. Поэтому,
   // чтобы упростить себе формирование статуса выхода,
   // запомним предыдущий статус:
   LOCAL LastExit := oGet:ExitState
   LOCAL nKey, bKeyBlock
   LOCAL cOldScreen := SAVESCREEN(MAXROW(),0,MAXROW(),MAXCOL())
   lPrompt:=IF(lPrompt==NIL, .T., lPrompt)
   aPrompt:= IF(aPrompt==NIL, {TRUE,FALSE},aPrompt)

   IF ( GetPreValidate( oGet ) )
      If lPrompt
        SayMess( oGet, "Пробел: Выбор значения" )
      EndIf
      // Чтение GET-объекта только при выполнении WHEN-условия

      oGet:SetFocus()          // Активизация GET-объекта
      #ifdef __HARBOUR__
      SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
      #else
      SETCURSOR(1)
      #endif



      WHILE ( oGet:exitState == GE_NOEXIT )
         // Прием и анализ нажатия клавиш
         WHILE ( oGet:exitState == GE_NOEXIT )
            // Сначала проверка на SET KEY
            IF ( ( bKeyBlock := SetKey( nKey := InKey( 0 ) ) ) ;
               ) != NIL
               // Необходимо имитировать состояние ожидания
               GetDoSetKey( bKeyBlock, oGet )
               LOOP
            ENDIF

            DO CASE
            CASE ( nKey == 32 )// Space
               oGet:VarPut(  IF( !( oGet:VarGet() == aPrompt[1] ),;
                                    aPrompt[1], aPrompt[2] ) )

            CASE ( CHR( nKey ) $ "YyTtДд" )
               oGet:VarPut( aPrompt[1] )

            CASE ( CHR( nKey ) $ "NnFfНн" )
               oGet:VarPut( aPrompt[2] )

            OTHERWISE
               IF ( nKey < 32 .OR. nKey > 255 )
                  GetApplyKey( oGet, nKey )
               ELSE
                  LOOP
               ENDIF

            ENDCASE

            oGet:UpdateBuffer()
         ENDDO

         IF ( !GetPostValidate( oGet ) )
            // Запрет выхода, если условие VALID не выполнено
            oGet:exitState := GE_NOEXIT
         END

      ENDDO

      // деактивизация GET
      oGet:KillFocus()

   END
   RESTSCREEN(MAXROW(),0,MAXROW(),MAXCOL(),cOldScreen)

   RETURN


//--------------------------------------------------------------------------
 Function RotateAndReader(oGet, aSim, nRow, nCol, lRotate, cPrompt, cColor1, cColor2, aExt,bCurr)
//--------------------------------------------------------------------------

   LOCAL LastExit := oGet:ExitState
   LOCAL nKey     := 0
   LOCAL lFilter  := (Type( 'nApp' ) <> "U" .And. nApp == 0)
   LOCAL iOld     := 1

   LOCAL cScreen, bKeyBlock, i, nLen, nWide, lView, ii
   If(ValType(aExt) == "A",, aExt := {})

   If(ValType(lRotate) == 'L',, lRotate := .T.)

   IF(ValType(cPrompt) == 'C',,;
    cPrompt:= If(lRotate,;
               "Пробел: Выбор значения  ",;
               "Редактиpование запpещено"))

   If lFilter
    AAdd(aSim, NIL)
    AIns(aSim, 1)

    IF AScan(aSim, {|x| x[1] = Blank(x[1])}, 2) == 0 .Or.;
       !(ValType(aSim[2][1]) $ "CN")

     aSim[1] := {Blank(aSim[2][1], .T.), Blank(aSim[2][2], .T.)}

    ElseIf ValType(aSim[2][1]) = "N"

     AEval(aSim, {|x| nKey += Abs(x[1]) + 1}, 2)
     aSim[1] := {nKey, Blank(aSim[2][2], .T.)}

    ElseIf ValType(aSim[2][1]) = "C"

     aSim[1] := {"@@@", Blank(aSim[2][2], .T.)}

    EndIf

   EndIf

   nLen  := Len(aSim)
   nWide := Len(aSim[1][2])

   If(AScan(aSim, {|x| AScan(aExt, x[1]) == 0}) > 0,, lRotate := .F.)

   lView := ValType(nRow)=="N" .And. ValType(nCol)=="N"

   If lView
     SetColor(cColor1)
     cScreen := SaveScreen(nRow, nCol, nRow + nLen + 2, nCol + nWide + 3)
     ShadowBox("", nRow, nCol, nRow + nLen + 1, nCol + nWide + 1)
     AEval(aSim, {|x, i| DevPos(nRow + i, nCol + 1), DevOut(x[2])})
   EndIf

   SayMess(oGet, cPrompt )

   // Чтение GET-объекта только при выполнении WHEN-условия
   If GetPreValidate(oGet)

    oGet:SetFocus() // Активизация GET-объекта
    #ifdef __HARBOUR__
    SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
    #else
    SETCURSOR(1)
    #endif
    While (oGet:exitState == GE_NOEXIT)
     // Прием и анализ нажатия клавиш
     While (oGet:exitState == GE_NOEXIT)
      // в xарборе почему-то иногда x получается NIL, xотя aSim правильный
      i := xAScan(aSim, {|x| x[2] == oGet:VarGet()})
/******* перенес в функцию -- titov
      i:=0
      For ii:= 1 TO LEN(aSim)
         IF aSim[ii,2] == oGet:VarGet()
            i:=ii
            EXIT
         ENDIF
      Next
************/
      If i == 0
       i := 1
       oGet:VarPut(aSim[i][1])
       oGet:UpdateBuffer()
      EndIf

      If lView
       COLORWIN(nRow+iOld, nCol+1, nRow+iOld, nCol+nWide, cColor1 )
       COLORWIN(nRow+i,    nCol+1, nRow+i,    nCol+nWide, cColor2 )
       iOld := i
      EndIf

      If ((bKeyBlock := SetKey(nKey := InKey(0)))) != NIL
       // Необходимо имитировать состояние ожидания
       GetDoSetKey(bKeyBlock, oGet)
       Loop
      EndIf

      Do Case
         Case (nKey == 32 .And. lRotate )// Space
          i := xAScan(aSim, {|x| x[2] == oGet:VarGet()})
          While .T.
           If(++i <= nLen,, i := 1)
           If AScan(aExt, aSim[i][1]) == 0
            Exit
           EndIf
          EndDo
          oGet:Changed := .T.
          oGet:VarPut(aSim[i][1])
          //Curr Block
          if bCurr != NIL.and.ValType(bCurr) == 'B'
             Eval(bCurr)
          end

          Otherwise
           If (nKey < 32 .Or. nKey > 255)
            GetApplyKey(oGet, nKey)
           Else
            Loop
           EndIf

      EndCase

      oGet:UpdateBuffer()
     EndDo
     oGet:VarPut(aSim[i,1])
     #ifdef __HARBOUR__
     oGet:UpdateBuffer()
     #endif

     If (!GetPostValidate(oGet))
      // Запрет выхода, если условие VALID не выполнено
      oGet:exitState := GE_NOEXIT
     ELSEIF nKey == K_ENTER
       oGet:exitState := GE_ENTER
     EndIf

    EndDo

    // деактивизация GET
    oGet:KillFocus()

   EndIf

   ClearMess(oGet)
   If lView
     RestScreen(nRow, nCol, nRow + nLen + 2, nCol + nWide + 3, cScreen)
   EndIf

   SetPos(oGet:Row, oGet:Col)
   If lFilter
    ADel(aSim, 1)
    ASize(aSim, --nLen)
   EndIf

 Return (NIL)

FUNCTION CondBlock(x,aSim,cDest) //Исп-ся в Get-блоке совместно с CondReader
 IF( ValType(aSim)<> 'A', aSim := { TRUE, FALSE }, )
 IF( x<>NIL, &(cDest) := (x==aSim[1]), )
RETURN (aSim[IF(&(cDest),1,2)])


FUNCTION RotateBlock(x,aSim,cDest) //Исп-ся в Get-блоке совместно с RotateAndReader
LOCAL n,lFilter:=TYPE('nApp')=='N'.AND.m->nApp==0, nPoz, nKey := 0
LOCAL cRet
IF lFilter
   AADD(aSim,NIL)
   AINS(aSim,1)
   IF ASCAN(aSim,{|x| x[1] = BLANK(x[1]) },2) = 0 .OR.  !(ValType(aSim[2][1]) $ "CN")
      aSim[1]:={BLANK(aSim[2][1],.T.),BLANK(aSim[2][2],.T.)}
   ELSEIF  ValType(aSim[2][1]) = "N"
      AEVAL(aSim,{|x| nKey += ABS(x[1])+1 },2)
      aSim[1]:={nKey,BLANK(aSim[2][2],.T.)}
   ELSEIF  ValType(aSim[2][1]) = "C"
      aSim[1]:={"@@@",BLANK(aSim[2][2],.T.)}
   ENDIF
ENDIF
IF "AIN[" $ UPPER(cDest) .AND. TYPE("aFilIn") = "A" .AND. (nPoz := VAL(BEFORATNUM("]",AFTERATNUM("AIN[",UPPER(cDest))))) > LEN(m->aFilIn)
  nPoz := NIL
ENDIF



IF x!=NIL.AND. VALTYPE(x) == VALTYPE(&(cDest)) .AND.;
   (EMPTY(n := ASCAN(aSim,{|y| VALTYPE(y[2]) == VALTYPE(x) .AND. y[2] == x })) .OR.;
   (VALTYPE(aSim[n,1]) == VALTYPE(x) .AND. aSim[n,1] == x))
  &(cDest) := x
ENDIF


IF nPoz != NIL .AND. m->aFilIn[nPoz] = NIL
  IF (n:= ASCAN(aSim,{|x| x[2] == BLANK(x[2],.T.) }))==0
     n:=1
  ENDIF
  &(cDest) := aSim[n,1]
ELSE
  IF (n:= ASCAN(aSim,{|x|x[1] == &(cDest)}))==0
     n:=1
  ENDIF
ENDIF
cRet:=aSim[n,2]
IF nPoz != NIL
  m->aFilIn[nPoz] := cRet
ENDIF
IF lFilter
   ADEL(aSim,1)
   ASIZE(aSim,LEN(aSim)-1)
ENDIF
RETURN cRet

//Редактор для Memo-полей - подставляется в InitList() автоматически
//(Titov 16.08.94)
PROCEDURE GetMemoReader(oGet,cHead,nTop,nLeft,nBot,nRight,lNoBox,lLine,cColor,nLenMemo)
LOCAL cMemoBuff:= SaveScreen(nTop,nLeft,nBot,nRight)
LOCAL sRet:=SETKEY(K_CTRL_RET,{||Keyb(K_CTRL_W)})
LOCAL sF1:=SETKEY(K_F1,{||DisplayHelp(5)})
LOCAL i:=IF(lNoBox=NIL,1,0), j, nPoz, lTop := .F., _nCol
LOCAL lNoLine
IF nLenMemo==NIL
   nLenMemo:=100
ENDIF
lNoLine := ValType(lLine)="L" .AND. !lLine
lLine := IF(lLine=NIL,.F.,lLine)
cColor := IF(cColor = NIL, SetColor(), cColor)
InitCargo(oGet)
IF (GetPreValidate(oGet))
   oGet:setFocus()
   #ifdef __HARBOUR__
   SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
   #else
   SETCURSOR(1)
   #endif
   SCROLL(nTop,nLeft,nBot,nRight, 0)
   IF lNoBox==NIL
      @ nTop,nLeft,nBot,nRight BOX FRAMES1 COLOR cColor

      IF VALTYPE(cHead)='C'
         SAYSCREEN(' '+cHead+' ',nTop,nLeft+2)
      ENDIF
   ENDIF
   IF lLine
     SETLASTKEY(K_ENTER)
     @ nTop+i,nLeft+i SAY PADR(" < стр.     кол.     >",nRight-nLeft-1) COLOR cColor
     bLine := {|nRow,lExit,nCol| IF(lExit,lTop := (nRow = 1) .AND. LastKey() = K_UP,NIL),nPoz := nRow-(Row()-nTop-i-1),AEVAL(ARRAY(nBot-nTop-i-i),{|x,y| SetPos(nTop+i+y,nLeft+i),DispOut(STR(y+nPoz-1,2,0),cColor) }),SetPos(nTop+i,nLeft+i+8),DispOut(STR(nRow,3,0),cColor),SetPos(nTop+i,nLeft+i+17),DispOut(STR(nCol+1,3,0),cColor) }
   ELSEIF lNoLine
     bLine := {|nRow,lExit,nCol| IF(lExit,lTop := (nRow = 1) .AND. LastKey() = K_UP,NIL) }
   ELSE
     bLine := {|| NIL }
   ENDIF
   WHILE ( oGet:exitState == GE_NOEXIT )
      DEF_CARGO(oGet):= MemoEdit(DEF_CARGO(oGet),nTop+i+IF(lLine,1,0),nLeft+i+IF(lLine,2,0),nBot-i,nRight-i,.T.,;
      "FunMemoReader",nLenMemo)
      oGet:varPut(DEF_CARGO(oGet))
      IF (lLine .OR. lNoLine) .AND. lTop
        oGet:exitState := GE_UP
      ELSE
        oGet:exitState := GE_ENTER
      ENDIF
      IF ( !GetPostValidate( oGet ) )
         oGet:exitState := GE_NOEXIT
      ENDIF
   ENDDO
   RestScreen(nTop,nLeft,nBot,nRight, cMemoBuff)
   oGet:killFocus()
ENDIF
SETKEY(K_CTRL_RET,sRet)
SETKEY(K_F1,sF1)
RETURN

FUNCTION FunMemoReader(nMode,nRow,nCol)
STATIC lExit:=.F.
EVAL(bLine,nRow,lExit,nCol)
IF !lExit.AND.nRow=1.AND.LASTKEY()=K_UP
   lExit:=.T.
   RETURN(0)
ENDIF
DO CASE
   CASE (LASTKEY()=K_CTRL_RET.OR.LASTKEY()=K_ESC)
   RETURN K_CTRL_W
   CASE LASTKEY()=K_UP.AND.lExit
   KEYBOARD CHR(K_CTRL_W)
ENDCASE
lExit:=.F.
RETURN(0)

/***********************************************************
 * RotateReader()
 *   Редактор модифицированного GET-объекта
 *   Параметр: GET-объект
 */
PROCEDURE RotateReader( oGet, aSim, aRem, nRow, nCol, cColor )
   // Редактирование очень упрощенное, большинство
   // специфических клавиш игнорируются. Поэтому,
   // чтобы упростить себе формирование статуса выхода,
   // запомним предыдущий статус:
   LOCAL LastExit := oGet:ExitState
   LOCAL nKey, bKeyBlock, nLen:=0, i
   LOCAL cOldScreen := SAVESCREEN(MAXROW(),0,MAXROW(),MAXCOL())
   IF aRem==NIL
      aRem:=aSim
   ENDIF

   IF LEN(aSim) == LEN(aRem)
     nRow := IF(nRow==NIL, oGet:row, nRow)
     nCol := IF(nCol==NIL, oGet:col, nCol)
     AEVAL(aRem,{|x| nLen := MAX(LEN(x), nLen)})
     cColor := IF(cColor==NIL, COL_INPUTA, cColor)
     ScrTitul(MAXROW(),"<Пробел> - выбор значения")
   IF ( GetPreValidate(oGet) )
      // Чтение GET-объекта только при выполнении WHEN-условия
      oGet:SetFocus()          // Активизация GET-объекта
      #ifdef __HARBOUR__
      SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
      #else
      SETCURSOR(1)
      #endif
      WHILE ( oGet:exitState == GE_NOEXIT )
         // Прием и анализ нажатия клавиш
         WHILE ( oGet:exitState == GE_NOEXIT )
            // Сначала проверка на SET KEY
            IF(i := ASCAN(aSim, oGet:VarGet())) == 0
              i := 1
              oGet:VarPut( aSim[i] )
              oGet:UpdateBuffer()
            ENDIF
            @ nRow, nCol SAY PADR(aRem[i],nLen) COLOR cColor
            SETPOS(oGet:row,oGet:col)
            IF ( ( bKeyBlock := SetKey( nKey := InKey( 0 ) ) ) ;
               ) != NIL
               // Необходимо имитировать состояние ожидания
               GetDoSetKey( bKeyBlock, oGet )
               LOOP
            ENDIF

            DO CASE
            CASE ( nKey == 32 )// Space
               i := ASCAN(aSim, oGet:VarGet())
               IF (++i) > LEN(aRem)
                 i := 1
               ENDIF
               oGet:VarPut( aSim[i] )

            OTHERWISE
               IF ( nKey < 32 .OR. nKey > 255 )
                  GetApplyKey( oGet, nKey )
               ELSE
                  LOOP
               ENDIF

            ENDCASE

            oGet:UpdateBuffer()
         ENDDO

         IF ( !GetPostValidate( oGet ) )
            // Запрет выхода, если условие VALID не выполнено
            oGet:exitState := GE_NOEXIT
         END

      ENDDO

      i := ASCAN(aSim, oGet:VarGet())
      @ nRow, nCol SAY PADR(IF(i==0,"",aRem[i]),nLen) COLOR cColor
      // деактивизация GET
      oGet:KillFocus()

   END
   RESTSCREEN(MAXROW(),0,MAXROW(),MAXCOL(),cOldScreen)

   ENDIF

   RETURN

PROCEDURE F2_Reader( oGet, nHotKey, bWork, cMessage )
   LOCAL LastExit := oGet:ExitState
   LOCAL nKey, bKeyBlock,i
   LOCAL cOldScreen := SAVESCREEN(MAXROW(),0,MAXROW(),MAXCOL())
   IF( ValType(nHotKey)<>'A', nHotKey := { nHotKey }, )
   IF( ValType(bWork)  <>'A', bWork   := { bWork   }, )
   IF( ValType(cMessage)<>'C',cMessage:='',)

   ScrTitul(MAXROW(),cMessage)
   IF ( GetPreValidate( oGet ) )
      oGet:SetFocus()          // Активизация GET-объекта
      #ifdef __HARBOUR__
      SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
      #else
      SETCURSOR(1)
      #endif
      WHILE ( oGet:exitState == GE_NOEXIT )
         // Прием и анализ нажатия клавиш
         WHILE ( oGet:exitState == GE_NOEXIT )
            // Сначала проверка на SET KEY
            IF nHotKey[1] == 999
               EVAL(bWork[1], oGet)
            ENDIF
            IF ( ( bKeyBlock := SetKey( nKey := InKey( 0 ) ) ) ;
               ) != NIL
               // Необходимо имитировать состояние ожидания
               GetDoSetKey( bKeyBlock, oGet )
               LOOP
            ENDIF

            IF (i:= ASCAN( nHotKey,nKey )) > 0
               EVAL( bWork[ i ],oGet )

            ELSE //IF ( nKey < 32 .OR. nKey > 255 )
              GetApplyKey( oGet, nKey )
            //ELSE
              //LOOP
            ENDIF
            //oGet:UpdateBuffer()
         ENDDO

         IF ( !GetPostValidate( oGet ) )
            // Запрет выхода, если условие VALID не выполнено
            oGet:exitState := GE_NOEXIT
         END

      ENDDO

      // деактивизация GET
      oGet:KillFocus()

   END
   RESTSCREEN(MAXROW(),0,MAXROW(),MAXCOL(),cOldScreen)
RETURN
//--------------------------------------------------------------------------//
FUNCTION BlockCase(oGet,lOnly,aList,cParam,cColor,lReturn,cMess,lEmpty,;
                   lHorizont,aSetVal,cNColor)
//--------------------------------------------------------------------------//
// Навеска в get:block для отображения меню с выбором
// lOnly   - .T., то выбор однозначный, иначе (.F.) множественный
// aList   - массив структуры {"текст выбора",....}
//           если строка, то предполагается, что это имя MEMVAR массива
// cParam  - массив структуры {логич.значен.выбора,....}
//           если строка, то предполагается, что это имя MEMVAR массива
//           если значения массива не логические, то предполагаются
//           имена MEMVAR переменных
//            Если строка, то имя MEMVAR переменной (например,
//           элемент массива aIn)
// cColor  - цвет Get, по умолчанию текущий
// lReturn - .T. признак быстрого выхода если в первом поле отработано K_DOWN
//           при неизменном значении поля, .F. по умолчанию
// cMess   - подсказка на MaxRow() к ней добавляется 'Пробел: Выбор значения'
// lEmpty  - если .T. и  lOnly - .T., то позволяет оставить все
//           значения пустыми, по умолчанию если nApp = 0 - .T., иначе .F.
// lHorizont - если .T., то размещение горизонтальное, по умолчанию .F.
// aSetVal   - массив двух значений определяющих истину/ложь,
//           по умолчанию {.T.,.F.}
//  cNColor - невыделенный цвет, по умолчанию текущий
// Предполагется, что уже существует oGet:name[6]
// (в рамках qInput и G_NCC он существует точно)
LOCAL aCaseSet
IF EMPTY(oGet:name[6])
	aCaseSet := ARRAY(CS_LEN)
	CS_L_ONLY := lOnly
	CS_N_ROW  := oGet:Row
	CS_N_COL  := oGet:Col
	CS_A_LIST := aList
	CS_A_SET  := cParam
	CS_C_COLOR := cColor
	CS_L_RETURN := lReturn
	CS_L_ADD := .F.
	CS_C_MESS := cMess
	CS_L_FRAME := .F.
	CS_L_EMPTY := lEmpty
	CS_C_HEAD := ""
	CS_L_HORIZONT := lHorizont
	CS_A_SETVAL := aSetVal
  CS_C_NCOLOR := cNColor
	oGet:name[6] := aCaseSet
ELSE
	aCaseSet:=oGet:name[6]
ENDIF
DispBegin()
GetCase(oGet:name[6],.T.)
DispEnd()
RETURN ""
//--------------------------------------------------------------------------//
     FUNCTION ReaderCase(oGet)
//--------------------------------------------------------------------------//
// Навеска в get:reader для организации редактирования
// Предполагатся, что уже существует oGet:name[6]
// (в рамках qInput и G_NCC он существует точно)
LOCAL aCaseSet := oGet:name[6], nKey, bKeyBlock

IF ( GetPreValidate( oGet ) )

   // Чтение GET-объекта только при выполнении WHEN-условия

   oGet:SetFocus()          // Активизация GET-объекта
   #ifdef __HARBOUR__
   SetCursor(if(Set( _SET_INSERT ),SC_INSERT,SC_NORMAL))
   #else
   SETCURSOR(1)
   #endif
   WHILE ( oGet:exitState == GE_NOEXIT )
      // Прием и анализ нажатия клавиш

      GetCase(oGet:name[6],.F.)

      // Сначала проверка на SET KEY
      IF ( ( bKeyBlock := SetKey( nKey := LastKey() ) ) ) != NIL
        // Необходимо имитировать состояние ожидания
        GetDoSetKey( bKeyBlock, oGet )
        LOOP
      ENDIF

      IF ( nKey < 32 .OR. nKey > 255 )
        GetApplyKey( oGet, nKey )
      ELSE
        LOOP
      ENDIF

      oGet:UpdateBuffer()

      IF ( !GetPostValidate( oGet ) )
         // Запрет выхода, если условие VALID не выполнено
         oGet:exitState := GE_NOEXIT
				 LOOP
      ELSEIF nKey == K_ENTER
        oGet:exitState := GE_ENTER
      END
   ENDDO

   // деактивизация GET
   oGet:KillFocus()

END

RETURN NIL
//--------------------------------------------------------------------------//
     FUNCTION GetCase(aCaseSet,lDisp)
//--------------------------------------------------------------------------//
// Построение меню с отметкой позиций
// lDisp          - .T. не запускать ReadModal, .F. по умолчанию
// CS_L_ONLY      - .T., то выбор однозначный, иначе (.F.) множественный
// CS_N_ROW,CS_N_COL - координаты левого верхнего угла
// CS_A_LIST      - массив структуры {"текст выбора",....}
//                  или если CS_L_ONLY - .T.
//                  {{код позиции,"текст выбора",признак возможности доступа},....}
//                  если строка, то предполагается,
//                  что это имя MEMVAR массива
//                  По умолчанию код позиции для однозначного выбора ее номер
//                  Признак возможности доступа может быть блоком кода
//                  выполняется при прорисовке каждой позиции
// [CS_A_SET  ]   - массив структуры {CS_A_SETVAL[1] или CS_A_SETVAL[2],....}
//                  если строка, то предполагается, что это имя MEMVAR массива
//                  или имя переменной при CS_L_ONLY - .T.
//                  куда помещать результат
// [CS_C_COLOR]   - цвет Get, по умолчанию текущий
// [CS_L_RETURN]  - .T. признак быстрого выхода если в первом поле отработано K_DOWN
//                  при неизменном значении поля, .F. по умолчанию
// [CS_L_ADD]     - .T. добавить в существующий GetList, .F. по умолчанию
// [CS_C_MESS]    - подсказка на MaxRow() к ней добавляется 'Пробел: Выбор значения'
// [CS_L_FRAME]   - .T. рисовать одинарную рамку (по умолчанию),
//                  .F. не рисовать рамку
// [CS_C_HEAD]    - строка заголовка рамки, "" по умолчанию
// [CS_L_EMPTY]   - если .T. и  CS_L_ONLY - .T., то позволяет оставить все
//                  значения пустыми
// [CS_L_HORIZONT]- если .T., то размещение горизонтальное, по умолчанию .F.
// [CS_A_SETVAL]  - массив двух значений определяющих истину/ложь,
//                  по умолчанию {.T.,.F.}
// [CS_N_POZ_GET] - позиция активного элемента
// [CS_X_ONLY]    - код позиции активного элемента при CS_L_ONLY - .T.
// [CS_C_NCOLOR]  - цвет невыделенного элемента, по умолчанию текущий
// при CS_L_ONLY - .F. - возвращает признак изменения значений
// при CS_L_ONLY - .T. - возвращает код выбранного элемента
//                       NIL если не выбрано не одного
LOCAL oGet, nCursor, bakSet, lDisplay := .T., cDispColor, lUpdate := .F.
LOCAL aDisp, nPoz, nLen := 0, bakExit , cGetColor,cGetColor2,cGetColor3, cParam, nKey
LOCAL nIncRow := 0, nIncCol := 0, xSet, nPozGet
LOCAL aSetKey, i, aList := {}, xCode := NIL, xName := "" // !!
LOCAL cNColor, nPozDisp, _nPoz, cText,lYes
PRIVATE bDispBlock
PRIVATE aSet


  ASIZE(aCaseSet,CS_LEN)
  IF(ValType(CS_L_HORIZONT) = "L",,CS_L_HORIZONT := .F.)
  IF(ValType(CS_N_POZ_GET)  = "N",,CS_N_POZ_GET := 1)
  IF(ValType(CS_L_ADD)    = "L",,CS_L_ADD := .F.)
  IF(ValType(lDisp)       = "L",,lDisp := .F.)
  IF(ValType(CS_L_RETURN) = "L",,CS_L_RETURN := .F.)
  IF(ValType(CS_L_EMPTY)  = "L",,CS_L_EMPTY := IF(TYPE("nApp") = "N" .AND. m->nApp = 0,.T.,.F.))
  IF(ValType(CS_L_FRAME)  = "L",,CS_L_FRAME := .T.)
  IF(ValType(CS_C_COLOR)  = "C",,CS_C_COLOR := SetColor())
  IF(ValType(CS_C_NCOLOR)  = "C",,CS_C_NCOLOR := CS_C_COLOR)
  IF(ValType(CS_C_MESS)   = "C",,CS_C_MESS := "")
  IF(ValType(CS_C_HEAD)   = "C",,CS_C_HEAD := "")
  IF(ValType(CS_A_SETVAL) = "A",,CS_A_SETVAL := {.T.,.F.})

  aList := IF(ValType(CS_A_LIST) = "A",CS_A_LIST,&(CS_A_LIST))
  xSet  := IF(ValType(CS_A_SET) = "A" .OR. CS_A_SET = NIL,CS_A_SET,&(CS_A_SET))
  AEVAL(aList,{|x,nPoz| IF(ValType(x) != "A",aList[nPoz] := {nPoz,x,.T.},NIL),nLen := MAX(nLen,LEN(aList[nPoz,2])),IF(LEN(aList[nPoz]) < 3,(ASIZE(aList[nPoz],3),aList[nPoz,3] := .T.),NIL) })
  nPozGet := CS_N_POZ_GET
  IF ValType(xSet) = "A"
    m->aSet := {}
    AEVAL(xSet,{|x| AADD(m->aSet,x) })
  ELSE
    cParam := CS_A_SET
    IF cParam != NIL .AND. !(CS_L_EMPTY .AND. CS_L_ONLY .AND. ;
                             TYPE("nApp") = "N" .AND.;
                             m->nApp = 0)
      CS_X_ONLY := &cParam
    ENDIF
    m->aSet := AFILL(ARRAY(LEN(aList)),CS_A_SETVAL[2])
  ENDIF
  IF CS_L_ONLY .AND. CS_X_ONLY != NIL .AND. ;
                     (nPoz := ASCAN(aList,{|x| x[1] = CS_X_ONLY })) != 0
    m->aSet[nPoz] := CS_A_SETVAL[1]
  ENDIF
  IF CS_L_ONLY .AND. !CS_L_EMPTY .AND. ASCAN(m->aSet,CS_A_SETVAL[1]) = 0
    m->aSet[1] := CS_A_SETVAL[1]
  ENDIF

  IF !CS_L_ADD .AND. !lDisp
    aSetKey := SaveSetKey()
#ifndef __HARBOUR__
    // m-> m->
    FOR i = 1 TO LEN(aSetKey[1]) STEP 2
      nKey := BIN2I(SUBSTR(aSetKey[1],i,2))
      IF nKey != K_UP .AND. nKey != K_DOWN .AND. nKey != 32 .AND. nKey != K_F1
        SETKEY(nKey,{|| oGet := GetActive(),IF(!lDisp,CS_N_POZ_GET := HEAD_POZ,NIL),ReadKill(.T.) })
      ENDIF
    NEXT
#else
    For i = 1 TO LEN(aSetKey)
        nKey := aSetKey[i][1]
        if nKey != K_UP .AND. nKey != K_DOWN .AND. nKey != 32 .AND. nKey != K_F1
           SETKEY(nKey,{|| oGet := GetActive(),IF(!lDisp,CS_N_POZ_GET := HEAD_POZ,NIL),ReadKill(.T.) })
        endif
    next
#endif

  ENDIF

  m->bDispBlock :=;
   {|x,oGet,lYes|;
     nPoz := HEAD_POZ,;
     lYes := IF(ValType(aList[nPoz,3]) = "B",EVAL(aList[nPoz,3]),aList[nPoz,3]),;
     IF(!lDisp,CS_N_POZ_GET := nPoz,NIL),;
     bakSet := m->aSet[nPoz],;
     SetPos(oGet:Row,oGet:Col-1),;
     DispOut( IF( CS_L_ONLY, "(", "[") ,;
     IF( lYes, IF(oGet:hasFocus,cGetColor2,cDispColor),cNColor) ),;
     SetPos(oGet:Row,oGet:Col+1),;
     DispOut(IF(CS_L_ONLY,")","]"),IF(lYes,IF(oGet:hasFocus,cGetColor2,cDispColor),cNColor)),;
     SetPos(oGet:Row,oGet:Col+3),;
     DispOut(PADR(aList[HEAD_POZ,2],;
     IF(CS_L_HORIZONT,LEN(aList[HEAD_POZ,2]),nLen)),;
    IF(lYes,IF(oGet:hasFocus,cGetColor,cDispColor),cNColor)),;
     SetPos(oGet:Row,oGet:Col),;
     IF(!CS_L_EMPTY .AND. CS_L_ONLY .AND. bakSet = CS_A_SETVAL[1],x := NIL,NIL),;
     x := RotateBlock(x,aDisp,"aSet["+NTOC(nPoz)+"]"),;
     IF(;
        CS_L_ONLY .AND. m->aSet[nPoz] != bakSet .AND. lDisplay,;
        (;
         lDisplay := .F.,;
         AEVAL(m->GetList,;
          {|oGet,i|;
            IF(i != nPoz .AND. ValType(oGet:name) = "A" .AND. LEN(oGet:name) >= 6 .AND. oGet:name[6],;
               m->aSet[i] := CS_A_SETVAL[2],;
               NIL;
              );
           };
             ),;
         SayGetList(aList, @cGetColor2, @cDispColor, @cNColor),;
         lDisplay := .T.;
       ),;
       NIL;
     ),;
    x;
    }

  cDispColor := TOKEN(CS_C_COLOR,",",1)+','+TOKEN(CS_C_COLOR,",",1)+','+TOKEN(CS_C_COLOR,",",1)+','+TOKEN(CS_C_COLOR,",",1)+','+TOKEN(CS_C_COLOR,",",1)
  cGetColor  := TOKEN(CS_C_COLOR,",",2)+','+TOKEN(CS_C_COLOR,",",2)+','+TOKEN(CS_C_COLOR,",",2)+','+TOKEN(CS_C_COLOR,",",2)+','+TOKEN(CS_C_COLOR,",",2)
  cGetColor2 := TOKEN(CS_C_COLOR,";",2)+','+TOKEN(CS_C_COLOR,";",2)+',,,'+TOKEN(CS_C_COLOR,";",3)
  cGetColor3 := TOKEN(CS_C_COLOR,";",3)+','+TOKEN(CS_C_COLOR,";",2)+',,,'+TOKEN(CS_C_COLOR,";",3)
  cNColor    := TOKEN(CS_C_NCOLOR,",",1)+','+TOKEN(CS_C_NCOLOR,",",1)+','+TOKEN(CS_C_NCOLOR,",",1)+','+TOKEN(CS_C_NCOLOR,",",1)+','+TOKEN(CS_C_NCOLOR,",",1)
  IF( LEN(cGetColor)  < 14, cGetColor  := cDispColor,     ) // Цвет Подсказки
  IF( LEN(cGetColor2) < 14, cGetColor2 := cDispColor,  ) // Цвет Точки
  IF( LEN(cGetColor3) < 14, cGetColor3 := cDispColor,  ) // Цвет Точки


  aDisp := {{CS_A_SETVAL[1],IF(CS_L_ONLY,CHR(7),"x")},{CS_A_SETVAL[2]," "}}

  IF !CS_L_ADD
    PRIVATE GetList:={}
  ENDIF

  CLEARWIN(CS_N_ROW-IF(CS_L_FRAME,1,0),CS_N_COL-IF(CS_L_FRAME,2,0),CS_N_ROW+IF(CS_L_HORIZONT,1,LEN(aList))+IF(CS_L_FRAME,1,-1),CS_N_COL+IF(CS_L_FRAME,8,4)+nLen,cDispColor)

  IF CS_L_FRAME
    DispBox(CS_N_ROW-1,CS_N_COL-2,CS_N_ROW+LEN(aList)+2,CS_N_COL+nLen+8,1,cDispColor)
    // Изменение 4.5
    Shadow(CS_N_ROW-1,CS_N_COL-2,CS_N_ROW+LEN(aList)+2,CS_N_COL+nLen+8)
    SetPos(CS_N_ROW-1,CS_N_COL)
    DispOut(CS_C_HEAD,cDispColor)
  ENDIF

  DispBegin()
  nIncCol := CS_N_COL+1+IF(CS_L_FRAME,1,0)
  nIncRow := CS_N_ROW+IF(CS_L_FRAME,1,0)
  FOR _nPoz := 1 TO LEN(aList)
    cText := aList[_nPoz]
    lYes := .F.
    cText := cText[2]
    nPoz := _nPoz
    lYes := IF(ValType(aList[nPoz,3]) = "B",EVAL(aList[nPoz,3]),aList[nPoz,3])
    oGet := GetNew(nIncRow,nIncCol,&("{|x| EVAL(bDispBlock,x,GetList["+NTOC(nPoz)+"]) }"),{"aSet["+NTOC(nPoz)+"]",NIL,nPoz,,,.T.},"X",IF(lYes,cGetColor3,cNColor))
    nIncRow := IF(CS_L_HORIZONT,oGet:Row,oGet:Row+1)
    nIncCol := IF(CS_L_HORIZONT,oGet:Col+5+LEN(cText),oGet:Col)
    oGet:Reader := {|oGet| RotateAndReader( oGet,aDisp,,,,"Пробел: Выбор значения"+CS_C_MESS,cDispColor,cGetColor2) }
    oGet:preBlock := {|oGet,lYes| lYes := IF(ValType(aList[HEAD_POZ,3]) = "B",EVAL(aList[HEAD_POZ,3]),aList[HEAD_POZ,3]),oGet:ColorDisp(IF(lYes,cGetColor3,cNColor)),lYes }
    oGet:postBlock := {|oGet| IF(LastKey() = K_ENTER,ReadKill(.T.),NIL),.T. }
    AADD(GetList,oGet)
    oGet:display()
  NEXT
  DispEnd()
  IF !lDisp
    bakExit := ReadExit(.T.)
    nCursor := SetCursor(IF( UPPER(cDispColor) == UPPER(cGetColor),1,0))
    IF nPozGet != NIL
      nPozDisp := nPozGet-1
      IF ASCAN(GetList,{|oGet| nPozDisp++,EVAL(oGet:preBlock, @oGet).AND.(nPozGet := nPozDisp,.T.) },nPozGet) = 0
        nPozDisp := 0
        IF ASCAN(GetList,{|oGet| nPozDisp++,oGet := GetList[nPozGet-nPozDisp+1],EVAL(oGet:preBlock, @oGet).AND.(nPozGet := nPozGet-nPozDisp+1,.T.) },1,nPozGet) = 0
          nPozGet := NIL
        ENDIF
      ENDIF
    ENDIF
    ReadModal(GetList,nPozGet)

    IF (nPoz := ASCAN(m->aSet,CS_A_SETVAL[1])) != 0.AND.(nPoz<=LEN(aList).OR.(nPoz:=0,.F.))
      xCode := aList[nPoz,1]
      xName := aList[nPoz,2]
    ENDIF
    IF LastKey() != K_ESC .OR. CS_L_RETURN
      IF ValType(xSet) = "A"
        AEVAL(xSet,{|x,nPoz| lUpdate := lUpdate .OR. xSet[nPoz] != m->aSet[nPoz],xSet[nPoz] := m->aSet[nPoz] })
      ELSEIF CS_L_ONLY .AND. cParam != NIL
        CS_X_ONLY := &cParam := xCode
        IF "AIN[" $ UPPER(cParam) .AND. TYPE("aFilIn") = "A" .AND. (nPoz := VAL(BEFORATNUM("]",AFTERATNUM("AIN[",UPPER(cParam))))) <= LEN(m->aFilIn)
          m->aFilIn[nPoz] := xName
        ENDIF
      ENDIF
    ENDIF
    IF CS_L_RETURN.AND.(LastKey() = K_DOWN .OR. LastKey() = K_UP .OR. LastKey() = K_ESC .OR. LastKey() = K_ENTER)
      KEYSEND(IF(LastKey() = K_ENTER,KS_DOWN,RIGHT(KEYREAD(),2)),.T.)
    ENDIF
    SetCursor(nCursor)
    ReadExit(bakExit)
  ENDIF
  IF !CS_L_ADD .AND. !lDisp
    RestSetKey(aSetKey)
  ENDIF
RETURN IF(CS_L_ONLY,xCode,lUpdate)

PROCEDURE SayGetList( aList, cGetColor2, cDispColor, cNColor)
   MEMVAR GETLIST
         AEVAL(GetList,;
           {|oGet,lYes|;
            IF(ValType(oGet:name) = "A" .AND. LEN(oGet:name) >= 6 .AND. oGet:name[6],;
               (;
                lYes := IF(ValType(aList[HEAD_POZ,3]) = "B",EVAL(aList[HEAD_POZ,3]),aList[HEAD_POZ,3]),;
                oGet:ColorDisp(IF(lYes,IF(oGet:hasFocus,cGetColor2,cDispColor),cNColor));
                ),;
               NIL;
               );
             };
              )
RETURN


FUNCTION xAscan(a,b) // из-за ошибки в харборе совиестно с get == titov
LOCAL i,n:=0
FOR i:= 1 TO LEN(a)
IF EVAL(b,a[i],i)
   n:=i
   EXIT
ENDIF
NEXT
RETURN n












