****************************************************************************
*   Программа  : S_Browse.prg - быстрый Browse в минимальной конфигурации *
*                (не испольует TBrowse-obj,                               *
*                не поддерживает горизонтальный скроллинг,                *
*                не имеет встроенных процедур копирования и удаления)     *
*   Автор      : А. Титов                                                 *
*   Примечание : компилировать с опциями /n /w /a /m                      *
***************************************************************************

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

/*

      *********************
       ОПИСАНИЕ ИНТЕРФЕЙСА
      **********************

Qbrowse(nTop,nLeft,nBottom,nRight,aBlockCol,cColor,cProcName,bColor,lYesClear,bColor1)
 nTop,nLeft,nBottom,nRight - координаты области данных;
 aBlockCol  - массив описания полей вывода,элемент которого содержит инфор-
             мацию для одного столбца данных:
             1) блок кода для выборки данных;
             2) начальная колонка.
             Размерность массива соответствует кол-ву столбцов, например:
             aBlockCols:={{FIELDBLOCK(Fi1),10},{FIELDBLOCK(Fi2),20}}
 [cColor] -  цветовая установка,по умолчанию задается текущая цветовая
             установка (невыделенный и выделенный цвета)
 [cProcName]  - имя функции или блок кода, выполняемый при любом перемеще-
                нии по данным (NIL),
                функция (блок) должна возвращать указание для обновления данных
                на экране:
                0          - прервать QBrowse.
                1 или NIL  - продолжить без обновления экрана (умолчание);
                2          - обновить все записи;
                3          - обновить только текущую запись.
  [bColor]   - блок кода,возвращающий цвет для каждого поля вывода,если указан,
               то по результату его выполнения будет устанавливаться цвет
               при выдаче каждого элемента строки (позволяет делать разно-
               цветные строки и графы)
  [lYesClear] - если присутствует, то при скроллировании делается очистка
                области, а потом отображение данных
  [bColor1]  - то же самое, что и bColor, но для активной (подсвеченной) строки
  [bSayHead] - Блок вывода заголовка по ключу bKeyHead, если не выводить
               то должен вернуть NIL, выполняется только при смене ключа.
               (длина стоки = длине строки BlockCols,;
                рисует начиная от nLeftBrd).
               Получает параметры текущего ключа, и предидущего.
  [bKeyHead] - Блок ключа заголовка. ({|| UPPER(Grup)})
  [nTime]    - время обновления
  QBrowse - функция пользовательского интерфейса, активизирующая полноэк-
ранный монитор просмотра записей со следующими особенностями;

     - запись целиком 'подсвечивается' выделенным цветом, не поддерживается
     горизонтальный скроллинг;
     - выходы по клавишам (если не переопределено):
       <Enter> - остается помеченная выбранная строка,
       <Esc>,<Ctrl-W> - отметка выбранной строки убирается.

     - программисту предоставляются следующие возможности по модифицированию и
наращиванию возможностей функциии:
     а) разработка дополнительных функций ввода, редактирования и т.п. в виде
SETKEY-блоков;
     функция должна возвращать указание для обновления данных
     на экране:
     0          - прервать QBrowse.
     1          - продолжить без обновления экрана,
     2 или NIL  - обновить все записи (умолчание);
     3          - обновить только текущую запись.

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

     - функция Qbrowse работает только непосредственно с данными, все заго-
ловки и разлиновку программист должен строить сам, горизонтальный скроллинг
не поддерживается.

     Дополнительные средства:
     QIni(nBot,nMode) - обновление до nBot-строки
               nMode=2 - обновить все записи;
               nMode=3 - обновить только текущую запись.
     QDown(nBot) - вниз  на одну позицию со скроллингом в области nTop-nBot
     QUp  (nBot) - вверх на одну позицию со скроллингом в области nTop-nBot
     QPush() - занести в стек параметры текущего QBrowse(), применяется при
               вложенности нескольких QBrowse друг в друга,
     QPop()  - выбрать из стека параметры последнего запомомненного
               QBrowse()
     QOff()  - погасить указатель текущей строки
     QOn()   - зажечь указатель текущей строки
     QScroll(nTop,nLeft,nBottom,nRight,sRest) - изменить границы скроллинга
             (те,которые NIL - остаются прежними)
             sRest - образец пустой строки для RESTSCREEN() при скроллировании
             (если возникают проблемы со скроллированием)
             Возвращает прежние значения.
             При этом программист сам должен позаботиться о перерисовке заголов-
             ков и изменении aBlockCol.

		IsHotKey() определяет навешен ли HotKey

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

//#TRANSLATE DBskip( <N> ) => SX_KEYsKIP( <N> )

#INCLUDE "inkey.ch"
#INCLUDE "setcurs.ch"
#include "s_public.ch"

STATIC aBlockCols,aColor
STATIC nTop,nLeft,nBottom,nRight
STATIC nRowAct,nRecAct,nNumRow
STATIC lBottom,lTop,cProcName,bColor,bColor1,cScope,xScope,lYesClear
STATIC sRest
STATIC aStack:={}
STATIC aHotLine, aqHotKey:={ 0, }
STATIC lSayHead, bSayHeads, bKeyHeads, lGoUp:= .F., lGoDown:= .F.

FUNCTION Qbrowse(;
      nTop0,nLeft0,nBottom0,nRight0,aBlockCol,cColor,cProcN,bClr,;
      lClear,bClr1,nDispRow, aHotKey,aRetKey,bSayHead,bKeyHead,nTime;
                  )

// aRetKey по ссылке
LOCAL bRunProcN,i
LOCAL cLastColor:=SETCOLOR()
LOCAL bKeyBlock,nAscan,nCo,kRow, locRow
LOCAL nCursSave := SetCursor(0)
LOCAL lNilHot := .F.
LOCAL lNoInit := !EMPTY(aRetKey)
LOCAL lNoStek := (aRetKey != NIL)
LOCAL lGotKey := .f.,lMore := .t.,nKey:=0
LOCAL lCurProc:=.T.
LOCAL cOldTrapShift,nStat,cTrap
LOCAL nPostRec, nPreRec
LOCAL sAltX:=SETKEY(K_ALT_X)
LOCAL mRow,mWh,nWh,mStr,mCol
nTime := If(nTime==NIL,0,nTime)

IF IsRunPlugIns("BROWSE","СМЕЩЕНИЕ")
  IF ValType(cProcN) = "C"
    cProcN := &('{|| RunPlugIns("BROWSE","СМЕЩЕНИЕ",Lastkey()),'+cProcN+' }')
  ELSEIF ValType(cProcN) = "B"
    bRunProcN := cProcN
    cProcN := {|| RunPlugIns("BROWSE","СМЕЩЕНИЕ",Lastkey()),EVAL(bRunProcN) }
  ELSE
    cProcN := {|| RunPlugIns("BROWSE","СМЕЩЕНИЕ",Lastkey()) }
  ENDIF
ENDIF

IF !lNoInit
  QPush()
  bSayHeads:= bSayHead
  bKeyHeads:= bKeyHead
  lSayHead:= ValType(bSayHeads)=="B".AND.ValType(bKeyHeads)=="B"
  aqHotKey:={ 0, }
  aHotLine := aHotKey
  IF ValType( aHotLine ) == 'A'
    lNilHot := .T.
    AEVAL( aHotLine, ;
           {|x,xi| nKey := xi,;
                   IF( ValType(aHotLine[ nKey ]) =='A',;
                       ( AEVAL( aHotLine[ nKey ],;
                            {|y,yi| IF( ValType(aHotLine[ nKey ][yi] )=='A',,;
                                        aHotLine[ nKey ][yi] := {y,0,,50+yi} ;
                                      ),;
                                    ASIZE( aHotLine[ nKey ][yi], 4 ),;
                                    IF( ValType(aHotLine[ nKey ][yi][2])<>'N',;
                                        aHotLine[ nKey ][yi][2] := 0,;
                                      ),;
                                    IF( ValType(aHotLine[ nKey ][yi][4])<>'N',;
                                        aHotLine[ nKey ][yi][4] := 50+yi,;
                                      ) ;
                             }  ),;
                         ASORT( aHotLine[ nKey],,, {|z1,z2| z1[4]<z2[4]}) ;
                       ),;
                     ) ;
           } )
    nKey := 0

  ELSEIF ValType( aHotLine )  == 'B'
    lNilHot := .T.
  ELSE
    cOldTrapShift := TRAPSHIFT("")
  ENDIF
  cProcName := cProcN
  aColor:={}
  sRest:=SAVESCREEN(nTop0,nLeft0,nTop0,nRight0)
  nTop:=nTop0;nLeft:=nLeft0;nBottom:=nBottom0;nRight:=nRight0
  aBlockCols:=aBlockCol
  nNumRow := nBottom-nTop+1   // Задание на кол-во строк
  nRowAct := IF(nDispRow != NIL,nDispRow,nTop)  //Активная строка
  nRecAct := RECNO()    //Активная запись
  FOR nCo := nTop TO nRowAct-1
    dbSkip(-1)
  NEXT
  bColor:=bClr
  bColor1:=bClr1
  lYesClear:=lClear
  lBottom:=.F.;lTop:=.F.
  IF ( !Used() )
     RETURN (NIL)
  END
  IF (cColor==NIL)
     cColor:=cLastColor
  ENDIF
  aColor:=LineToArray(cColor,',')
  IF (LEN(aColor)>2 .AND. aColor[3] == 'N/N')
     ASIZE(aColor,2)
  ENDIF
ELSE
 nCo           := aRetKey[1]
 cLastColor    := aRetKey[2]
 bKeyBlock     := aRetKey[3]
 nAscan        := aRetKey[4]
 kRow          := aRetKey[5]
 nCursSave     := aRetKey[6]
 lGotKey       := aRetKey[7]
 lCurProc      := aRetKey[8]
 lNilHot       := aRetKey[9]
 nKey          := aRetKey[10]
 cOldTrapShift := aRetKey[11]
ENDIF
aRetKey    := NIL

RunPlugIns("BROWSE","ВХОД")



IF sAltX==NIL
   sAltX:=SETKEY (K_ALT_X, {||NewExportImport()})
ENDIF


WHILE (lMore) .OR. lNoInit
   IF !lGotKey .OR. lNoInit
       IF !lNoInit
         kRow := nBottom-nTop+1


         QInit(nBottom,nNumRow)

         IF (lCurProc .AND. cProcName != NIL .AND.;
            !(nKey==K_LEFT.OR.nKey==K_RIGHT).AND.;
            !(lTop .AND. (nKey==K_UP .OR. nKey==K_PGUP)) .AND.;
            !(lBottom .AND. (nKey==K_DOWN .OR. nKey==K_PGDN)) )
         
            cTrap:=TRAPSHIFT("")
            nCo:=IF(VALTYPE(cProcName)=='B',EVAL(cProcName),&(cProcName)()) //aSelRec)
            TRAPSHIFT(cTrap)
            SetPos(nRowAct,nLeft)
            lCurProc:=.F.
            DO CASE
               CASE (VALTYPE(nCo)!='N' .OR. ;
               VALTYPE(nCo)=='N' .AND. nCo!=0 .AND. nCo!=2 .AND. nCo!=3)
               CASE (nCo==2)
               QIni(nBottom,nCo,.F.)
               LOOP
               CASE (nCo==0)
               lMore := .F.
               LOOP
               CASE (nCo==3)
               nNumRow:=1
               LOOP
            ENDCASE
         ENDIF
         lCurProc:=.T.
         // ожидание
         IF lNilHot
           cOldTrapShift := TRAPSHIFT( {||qHotKey()})
         ENDIF
         

         WHILE (nKey := InKey(nTime,INKEY_KEYBOARD+INKEY_LDOWN+INKEY_LUP+INKEY_RDOWN+INKEY_RUP+INKEY_MWHEEL)) = 0;QIni(nBottom,2,.T.);ENDDO

         RunPlugIns("РЕЕСТР","НАЖАТИЕ_КЛАВИШИ",nKey)

         bKeyBlock := NIL
         IF lNilHot
           TRAPSHIFT( cOldTrapShift )
           IF aqHotKey[1] <> 0
             lNilHot := .T.
             IF ValType( aqHotKey[2]) == 'B'
               bKeyBlock := aqHotKey[2]
               aqHotKey[2] := NIL

             ENDIF
           ENDIF
         ENDIF
       ENDIF
       IF lNoInit .OR. ;
               !EMPTY( bKeyBlock) .OR. ;
              ( (bKeyBlock := SetKey(nKey)) != NIL )
          IF !lNoInit
            IF lNoStek
              aRetKey := {nCo,cLastColor,bKeyBlock,nAscan,kRow,nCursSave,lGotKey,lCurProc,lNilHot,nKey,cOldTrapShift}
              EXIT
            ELSE
              cTrap:=TRAPSHIFT("")
              nCo:=Eval(bKeyBlock, ProcName(1), ProcLine(1), "")
              TRAPSHIFT(cTrap)
            ENDIF
          ENDIF
          IF lNilHot
            aqHotKey[1] := 0
          ENDIF
          lNoInit := .F.
          SetPos(nRowAct,nLeft)
          IF nKey!=K_LEFT.AND.nKey!=K_RIGHT
             nPreRec := IF(DELETE(),RECNO(),NIL)
             dbSkip( 1 )
             IF EOF() .AND. nPreRec != NIL
               dbGoTo(nPreRec)
               IF RecLock()
                 dbRecall()
                 dbSkip()
                 nPostRec := RECNO()
                 dbGoTo(nPreRec)
                 dbDelete()
                 dbUnLock()
                 dbGoTo(nPostRec)
               ENDIF
             ENDIF
             dbSKIP( -1 )
          ENDIF
          nRecAct := RECNO()    //Активная запись
          lTop:=lBottom:=.F.
          DO CASE
             CASE (VALTYPE(nCo)!='N' .OR. ;
             VALTYPE(nCo)=='N' .AND. nCo!=0 .AND. nCo!=1 .AND. nCo!=3)
             QIni(nBottom,2,.F.)
             CASE (nCo==0)
             nNumRow:=0
             lMore := .F.
             CASE (nCo==1)
             nNumRow:=0
             CASE (nCo==3)
             nNumRow:=1
          ENDCASE
          LOOP
       END
       aqHotKey[1] := 0
    ELSE
       lGotKey := .f.
    END
    nNumRow := 0  //Задание на отображение
    DO CASE

        CASE nKey == K_LDBLCLK
        mRow:=mRow()
        mCol:=mCol()
        IF mRow<=nBottom.AND.mRow>=nTop;
             .and.mCol<=nRight.AND.mCol>=nLeft
           KEYBOARD CHR(K_RETURN)
        ELSEIF mRow>22.OR.mRow=0
           GenerateKeyFromScreen(mRow,mCol)
        ENDIF


        CASE nKey == K_LBUTTONDOWN
        mRow:=mRow()
        mCol:=mCol()
        IF mRow<=nBottom.AND.mRow>=nTop;
             .and.mCol<=nRight.AND.mCol>=nLeft
           i := 0
           IF  mRow > nRowAct
              qOff()
              while mRow > nRowAct.and.i++ < 15
                  QDown(nBottom,.T.)
              enddo
              qOn()
           ELSEIF mRow < nRowAct
              qOff()
              While mRow < nRowAct.and.i++ < 15
                    QUp(nBottom,.T.)
              enddo
              qOn()
           ENDIF
        ELSEIF mRow>22.OR.mRow=0
           GenerateKeyFromScreen(mRow,mCol)
        ENDIF

        CASE nKey == K_MWFORWARD.and.!lBottom
             mWh := mWheel()
             if mWh == 1
                QDown(nBottom,.T.)
                elseif mWh > 1
                       qOff()
                       For nWh := 1 to mWh
                           QDown(nBottom,.T.)
                       next
                       QOn()
             endif

        CASE nKey == K_MWBACKWARD.and.!lTop
             mWh := mWheel()
             if mWh == 1
                QUp(nBottom,.T.)
                elseif mWh > 1
                       qOff()
                       For nWh := 1 to mWh
                           QUp(nBottom,.T.)
                       next
                       QOn()
             endif

        
        CASE ( nKey == K_DOWN .AND. !lBottom)
        QDown(nBottom,.T.)
        CASE ( nKey == K_UP .AND. !lTop)
        QUp(nBottom,.T.)
        CASE ( nKey == K_PGDN .AND. !lBottom)
        nNumRow:=kRow
        lTop:=.F.
        lBottom:=.F.
        IF lSayHead
          locRow:= 0
          DO WHILE locRow<kRow
             IF(IfSayHead(), locRow++, )
             IF(locRow<kRow, (DBSKIP(1),locRow++),)
          ENDDO
        ELSE
          dbSKIP(kRow)
        ENDIF
        IF !EOF()
          nRecAct:=RECNO()
          nRowAct:=nTop
        ELSE
          nKey:=K_CTRL_PGDN
          lGotKey:=.T.
        ENDIF
        CASE ( nKey == K_PGUP .AND. !lTop)
        lBottom:=.F.
        IF lSayHead
          locRow:= 0
          DO WHILE locRow<kRow
             IF(IfSayHead(), locRow++, )
             IF(locRow<kRow, (DBSKIP(-1),locRow++),)
          ENDDO
        ELSE
          dbSKIP( -kRow )
        ENDIF
        nNumRow:=kRow
        nRecAct:=RECNO()
        lTop := .T.
        IF (!BOF())
           nRowAct:=nTop
           lTop:=.F.
        ENDIF
        IF lTop
           lTop:=.F.
           nKey:=K_CTRL_PGUP
           lGotKey:=.T.
        ENDIF
        CASE ( nKey == K_CTRL_PGDN .AND. !lBottom)
        lTop:=.F.
        GO BOTTOM
        nRecAct:=RECNO()
        nNumRow:=kRow
        IF lSayHead
          locRow:= 0
          DO WHILE locRow+1<kRow
             IF(IfSayHead(), locRow++, )
             IF(locRow+1<kRow, (DBSKIP(-1),locRow++),)
          ENDDO
        ELSE
          dbSKIP( -kRow+1 )
        ENDIF
        IF (BOF())
           nRecAct:=RECNO()
           nRowAct:=nTop
           FOR i:=1 TO kRow
           QDown()
           NEXT
        ELSE
           nRowAct:=nBottom
           lBottom:=.T.
        ENDIF
        CASE (nKey==K_CTRL_PGUP .AND. !lTop)
        lBottom:=.F.
        GO TOP
        nRecAct:=RECNO()
        nNumRow:=kRow
        nRowAct:=nTop
        lTop:=.T.
        CASE ( nKey == K_RETURN )
        lMore := .f.
        CASE (nKey==K_ESC .OR. nKey==K_CTRL_W)
        //Восстановление цветов
        nCo:=0
        nRowAct := MIN(nBottom,nRowAct)
        nRowAct:= RowToDisplay(nRowAct,,.F.,1,.T.)
        lMore := .f.

    ENDCASE
ENDDO

SETKEY (K_ALT_X,sAltX)

RunPlugIns("BROWSE","ВЫХОД")
IF aRetKey = NIL
  QPop()
  TRAPSHIFT(cOldTrapShift )
  SETCURSOR(nCursSave)
  SETCOLOR(cLastColor)
ENDIF
RETURN NIL

FUNCTION RowToDisplay(nRow,cColor,lEmpty, nColor, lRepSay)
PLOCAL nCo:= 0, cPreHKey, cCurHKey, nCurRec, cHSay, lBof:= .F.
PLOCAL aRowCol := qScroll()





DispBegin()
IF !lSayHead.OR.lEmpty



   CLEARWIN(nRow,aRowCol[2],nRow,aRowCol[4],aColor[1])

   AEVAL(aBlockCols,{|x|(DISPOUTAT(nRow,x[2],IF(lEmpty, SPACE(LEN(TRANSFORM(EVAL(x[1]),''))), EVAL(x[1])),;
           IF(cColor != NIL,cColor,IF(nColor==1,IF(bColor==NIL,aColor[1],EVAL(bColor,++nCo, .F.)),IF(bColor1==NIL,aColor[2],EVAL(bColor1,++nCo, .F.)))));
                    )})

ELSE
  nCurRec:= RECNO()
IF !lGoUp
  DBSKIP(-1)
  cPreHKey:= IF(BOF(), NIL, EVAL(bKeyHeads))
  DbGoTo(nCurRec)
  cCurHKey:= EVAL(bKeyHeads)
ELSE
  cPreHKey:= IF(BOF(), (lBof:=.T., IF(nRow==aRowCol[1], NIL, EVAL(bKeyHeads))),;
                        EVAL(bKeyHeads))
  IF(!BOF(), DBSKIP(1),)
  cCurHKey:= EVAL(bKeyHeads)
  DbGoTo(nCurRec)
ENDIF
  IF(cPreHKey!= cCurHKey, cHSay:= EVAL(bSayHeads,cCurHKey,cPreHKey), )
  IF !EMPTY(cHSay)
      IF !lRepSay.AND.!(lGoDown.AND.lBottom)
        IF lGoUp.AND.lBof.AND.nRow==aRowCol[1]
            IF(nColor!=2, SCROLL(aRowCol[1],aRowCol[2],aRowCol[3],aRowCol[4],-1), )
        ENDIF
        DISPOUTAT(nRow,aRowCol[2],cHSay,;
                IF(cColor != NIL,cColor,IF(bColor==NIL,aColor[1],EVAL(bColor, 1, .T.))))
        IF !lGoUp
            nRow++
            IF(nRow>aRowCol[3],;
                   IF((lGoDown.OR.nRowAct==aRowCol[3]).AND.nColor!=2,;
                              (SCROLL(aRowCol[1],aRowCol[2],aRowCol[3],aRowCol[4],1),;
                               nRow:= aRowCol[3]),;
                      ), )
        ELSE
            IF !lBof
               nRow--
               IF(nRow<aRowCol[1], (IF(nColor!=2,SCROLL(aRowCol[1],aRowCol[2],aRowCol[3],aRowCol[4],-1),),nRow:= nTop), )
            ELSE
               IF(nRow>=aRowCol[1], nRow:= aRowCol[1]+1, )
            ENDIF
        ENDIF
      ENDIF
  ENDIF
IF nRow==aRowCol[3].AND.nRowAct==aRowCol[3].AND.nColor!=2.AND.nRecAct!=RECNO()
   nRow--
   SCROLL(aRowCol[1],aRowCol[2],aRowCol[3],aRowCol[4],1)
ENDIF
IF nRow<=aRowCol[3]
  CLEARWIN(nRow,aRowCol[2],nRow,aRowCol[4],aColor[1])
  AEVAL(aBlockCols,{|x|DISPOUTAT(nRow,x[2],EVAL(x[1]),;
          IF(cColor != NIL,cColor,IF(nColor==1,IF(bColor==NIL,aColor[1],EVAL(bColor,++nCo, .F.)),IF(bColor1==NIL,aColor[2],EVAL(bColor1,++nCo, .F.)))));
                   })
ENDIF
IF(lGoUp, lGoUp:= .F., )
IF(lGoDown, lGoDown:= .F., )
ENDIF
DispEnd()
RETURN nRow

FUNCTION IfSayHead()
PLOCAL cPreHKey, cCurHKey, nCurRec
  nCurRec:= RECNO()
  DBSKIP(-1)
  cPreHKey:= IF(BOF(), NIL, EVAL(bKeyHeads))
  DbGoTo(nCurRec)
  cCurHKey:= EVAL(bKeyHeads)
RETURN  IF(cPreHKey!= cCurHKey, !EMPTY(EVAL(bSayHeads,cCurHKey,cPreHKey)), .F.)

FUNCTION Qini(nBot,nMode,lNotProc)
// 2 - обновить все записи;
// 3 - обновить только текущую запись.
PLOCAL locSkip
IF (nBot==NIL)
   nBot:=nBottom
ELSEIF (nBot <= nTop)
   RETURN (NIL)
ENDIF
SetPos(nRowAct,nLeft)
IF !EMPTY(DBFILTER()) //.OR.!EMPTY(GetScope())
    dbSKIP(1)
    dbSKIP( -1 )
ENDIF
lTop:=lBottom:=.F.
DO CASE
   CASE (nMode==2)
   nRecAct:=RECNO()
   nNumRow:=nBot-nTop+1
       IF lSayHead
          locSkip:= 0
          DO WHILE locSkip<nRowAct-nTop
             IF(IfSayHead(), locSkip++, )
             IF(locSkip<nRowAct-nTop, (DBSKIP(-1),locSkip++),)
          ENDDO
       ELSE
          dbSKIP( nTop-nRowAct )
       ENDIF
   IF (nRowAct>=nBot)
      dbSKIP( nRowAct-nBot)
      nRowAct:=nBot //???
   ENDIF
   IF (BOF())
      nRowAct:=nTop
      WHILE RECNO()<>nRecAct.AND.!EOF()
         nRowAct++
         dbSKIP()
      ENDDO
    GO TOP
    ENDIF
    CASE (nMode==3)
    nNumRow:=1
ENDCASE
Qinit(nBot,nNumRow)
IF (cProcName != NIL .AND. lNotProc==NIL)
   IF (VALTYPE(cProcName)=='B')
      EVAL(cProcName)
   ELSE
      &(cProcName)() //aSelRec)
   ENDIF
   SetPos(nRowAct,nLeft)
ENDIF
nNumRow:=0
RETURN (NIL)

STATIC FUNCTION QInit(nBot,nLine)  //Обновление (служебное)
// nBot-до какой строки
// nLine-если присутствует, то обновить только nLine строк, начиная с текущей
PLOCAL nNumR:=IF(PCOUNT()>1,nLine,nBot-nTop+1) // Задание на кол-во строк
PLOCAL nRow //,Sc_block:=ScopeBlock()
PLOCAL cLastColor:=SETCOLOR(),nCo:=0
IF (PCOUNT()>1 .AND. nLine==0)
   RETURN (NIL)
ENDIF
IF (nBot==NIL)
   nBot:=nBottom
ENDIF
nRow:=IF(nNumR > 1,nTop,nRowAct)
IF lYesClear!=NIL.AND.nNumR>=nBot-nTop+1
   @ nTop,nLeft CLEAR TO nBot,nRight
ENDIF
IF ( !EOF() .OR. ( EOF().AND.BOF() ) )
   DispBegin()

   DBEVAL({|| IF(nRow<=nBot, (nRow:= RowToDisplay(nRow,,.F.,1,nNumR==1.AND.!(lGoUp.OR.lGoDown)), IF(lSayHead.AND.nRecAct==RECNO(),nRowAct:=nRow,)) ,), nRow++},,;
              ,nNumR,,.T.)
   DispEnd()
   IF EOF() //.OR.!EVAL(Sc_Block))
     IF (nRowAct >= nRow)
        IF nRow > nTop
           nRowAct:=nRow-1
        ENDIF
        GO BOTTOM
        #ifdef AXS
          dbSkip(+1)  // Для Владика
          dbSkip(-1)
        #endif
        nRecAct := RECNO()
        dbSKIP()
     ENDIF
     FOR nRow:=nRow TO nBot
       nRow:= RowToDisplay(nRow,aColor[1],.T.,1,.F.)
     NEXT
  ENDIF
ELSE
   nRecAct := RECNO()
ENDIF
GO nRecAct
dbSkip()
dbSkip(-1)
nCo:=0
nRowAct := MIN(nBot,nRowAct)
nRowAct := RowToDisplay(nRowAct,,.F.,2,.T.)
SetPos(nRowAct,nLeft)
SETCOLOR(cLastColor)
RETURN (NIL)

FUNCTION QDown(nBot,lSpec)
PLOCAL nCo:=0
//lSpec - для внутреннего использования (без выполнения CurProc)
lTop:=.F.
IF lBottom
   RETURN (.F.)
ENDIF
IF (nBot==NIL)
   nBot:=nBottom
ELSEIF (nBot < nTop)     //Было <=
   dbSKIP()
   IF EOF()
      dbSKIP( -1 )
      IF BOF()
         GO LastRec()+1
      ENDIF
      lBottom:=.T.
   ENDIF
   RETURN (!lBottom)
ENDIF
//Восстановление цветов
nRowAct := MIN(nBot,nRowAct)
nRowAct := RowToDisplay(nRowAct,,.F.,1,.T.)
IF(lSayHead, lGoDown := .T., )
lTop:=.F.
dbSKIP()
IF (!EOF())
   nRecAct:=RECNO()
   IF (nRowAct == nBot)
      SCROLL(nTop,nLeft,nBot,nRight,1)
      IF lYesClear=NIL
         RESTSCREEN(nBot,nLeft,nBot,nRight,sRest)
      ENDIF
   ELSE
      nRowAct++
   ENDIF
ELSE
   dbSKIP( -1 )
   IF (BOF())
      GO LastRec()+1
   ENDIF
   lBottom:=.T.
ENDIF

IF (nRowAct<=nBot)
   QInit(nBot,1)
ELSE
   QInit(nBot,nBot-nTop+1)
ENDIF
IF (cProcName != NIL .AND. lSpec==NIL)
   IF (VALTYPE(cProcName)=='B')
      EVAL(cProcName)
   ELSE
      &(cProcName)() //aSelRec)
   ENDIF
   SetPos(nRowAct,nLeft)
ENDIF
nNumRow:=0
RETURN (!lBottom)

FUNCTION QUp(nBot,lSpec)
PLOCAL nCo:=0
lBottom:=.F.
IF lTop
   RETURN (.F.)
ENDIF
IF (nBot==NIL)
   nBot:=nBottom
ELSEIF (nBot < nTop) //было <=
   dbSKIP( -1)
   IF BOF()
      lTop:=.T.
      IF (EOF())
         GO LASTREC()+1
      ENDIF
   ENDIF
   RETURN (!lTop)
ENDIF
nRowAct := MIN(nBot,nRowAct)
//Восстановление цветов
nRowAct := RowToDisplay(nRowAct,,.F.,1,.T.)

lBottom:=.F.
dbSKIP( -1 )
IF (!BOF())
   nRecAct:=RECNO()
   IF (nRowAct == nTop)
      SCROLL(nTop,nLeft,nBot,nRight,-1)
      IF lYesClear=NIL
         RESTSCREEN(nTop,nLeft,nTop,nRight,sRest)
      ENDIF
   ELSE
      nRowAct--
   ENDIF
ELSE
   lTop:=.T.
   IF (EOF())
      GO LASTREC()+1
   ENDIF
ENDIF
IF(lSayHead, lGoUp:= .T., )
IF (nRowAct<=nBot)
   QInit(nBot,1)
ELSE
   QInit(nBot,nBot-nTop+1)
ENDIF
IF (cProcName != NIL .AND. lSpec==NIL)
   IF (VALTYPE(cProcName)=='B')
      EVAL(cProcName)
   ELSE
      &(cProcName)() //aSelRec)
   ENDIF
   SetPos(nRowAct,nLeft)
ENDIF
nNumRow:=0
RETURN(!lTop)


//z0ne
FUNCTION QPush(aExternal) //логично предположить, что передавать надо по ссылке, z0ne
AADD(aStack,{nTop,nLeft,nBottom,nRight,aBlockCols,aColor,nRowAct,nRecAct,;
     nNumRow,lBottom,lTop,cProcName,sRest,bColor,lYesClear,bColor1,aHotLine,;
     aqHotKey,lSayHead,bSayHeads,bKeyHeads})
If (aExternal<>NIL).and.(ValType(aExternal)=='A')
  aExternal:=ACLONE(ATAIL(aStack))
  ASIZE(aStack,LEN(aStack)-1)
endif
RETURN (NIL)

FUNCTION QPop(aExternal) //а тут можно без ссылки
PLOCAL n
If (aExternal<>NIL).and.(ValType(aExternal)=='A')
  AADD(aStack,aExternal)
endif
n:=LEN(aStack)
nTop:=aStack[n,1];nLeft:=aStack[n,2];nBottom:=aStack[n,3];nRight:=aStack[n,4]
aBlockCols:=aStack[n,5];aColor:=aStack[n,6];nRowAct:=aStack[n,7]
nRecAct:=aStack[n,8];nNumRow:=aStack[n,9];lBottom:=aStack[n,10]
lTop:=aStack[n,11];cProcName:=aStack[n,12];sRest:=aStack[n,13]
bColor:=aStack[n,14];lYesClear:=aStack[n,15];bColor1:=aStack[n,16]
aHotLine:=aStack[n,17]
aqHotKey:=aStack[n,18]
lSayHead:=aStack[n,19]
bSayHeads:= aStack[n,20]
bKeyHeads:= aStack[n,21]
ASIZE(aStack,--n)
RETURN (NIL)

Function QOff(cColor)
nRowAct := Min(nBottom, nRowAct)
nRowAct := RowToDisplay(nRowAct,cColor,.F.,1,.T.)
Return (NIL)

Function QOn()
nRowAct := Min(nBottom, nRowAct)
nRowAct := RowToDisplay(nRowAct,,.F.,2,.T.)
Return (NIL)

//--------------------------------------------------------------------------//
FUNCTION QScroll(y1,x1,y2,x2,sRes,nRwAct,nRcAct)
//--------------------------------------------------------------------------//
PLOCAL a:={nTop,nLeft,nBottom,nRight,sRest,nRowAct,nRecAct}
nTop:=IF(y1!=NIL,y1,nTop)
nLeft:=IF(x1!=NIL,x1,nLeft)
nBottom:=IF(y2!=NIL,y2,nBottom)
nRight:=IF(x2!=NIL,x2,nRight)
sRest:=IF(sRest!=NIL,sRes,sRest)
nRowAct:=IF(nRwAct!=NIL,nRwAct,nRowAct)
nRecAct:=IF(nRcAct!=NIL,nRcAct,nRecAct)

RETURN(a)

PROCEDURE NotHotkey()
  aqHotKey[1] := 555
  aqHotKey[2] := NIL
RETURN

PROCEDURE ClearHotkey()
  aqHotKey[1] := 0
  aqHotKey[2] := NIL
RETURN

FUNCTION IsHotkey()
PLOCAL cOld := TrapShift()
PLOCAL lRet := aHotLine != NIL .AND. EMPTY(aqHotKey[1]) .AND. ( ValType(aHotLine) = "B" .OR. ASCAN(aHotLine,{|x| !EMPTY(x) }) != 0 ) .AND. !EMPTY(cOld)
TrapShift(cOld)
RETURN lRet


PROCEDURE StackHotKey( lPush, aNewHot )
  STATIC aStackHot := {}
  IF lPush
    IF aNewHot = NIL .OR. ValType(aNewHot) != "A" .OR. ASCAN(aNewHot,{|x| !EMPTY(x) }) = 0
      AADD( aStackHot, { aHotLine, TrapShift(),aqHotKey } )
    ELSE
      AADD( aStackHot, { aHotLine, TrapShift( {|| qHotKey() } ),aqHotKey } )
    ENDIF
    aqHotKey:={ 0, }
    aHotLine := aNewHot
  ELSEIF !EMPTY( aStackHot )
    aHotLine := ATAIL( aStackHot )[1]
    TrapShift( ATAIL( aStackHot )[2] )
		aqHotKey := ATAIL( aStackHot )[3]
    ASIZE( aStackHot, LEN(aStackHot)-1 )
  ENDIF
RETURN

//z0ne
FUNCTION GetHotLine
RETURN aHotLine

PROCEDURE qHotKey( nBit)
  PLOCAL nW := WSELECT(), nLine := 1,;
        nKey := 0, aHot := {0,0,21,74,'',{},ROW(),COL() }, aLine,;
        cOldTrapShift, i, nLen := 0, nCurs

Local nStat
nBit := KBDStat()


IF EMPTY( aqHotKey[1] ) .AND. aHotLine != NIL .AND. ;
   ( isbit(nBit, 1) .OR. isbit(nBit, 2) .OR. isbit(nBit, 3) .OR. isbit(nBit, 4) .OR.;
     isbit(nBit, 10) .OR. isbit(nBit, 12) )
  nCurs:=SetCursor(0)
  WSELECT( 0 )
  IF isbit(nBit, 3)   // CTRL
    nLine := 1 ;    nBit  := 3
  ELSEIF isbit(nBit, 1)  .OR. isbit(nBit, 2)  // SHIFT
    nLine := 2 ;    nBit  := IF( isbit(nBit, 1), 1, 2 )
  ELSEIF isbit(nBit, 10) .OR. isbit(nBit, 12) .OR. isbit(nBit, 4)  // ALT
    nLine := 3 ;    nBit  := IF(isBit(nBit,4),4,IF( isbit(nBit, 10), 10, 12 ))
  ENDIF

  IF ValType( aHotLine ) == 'B' ;    aLine := ACLONE( EVAL( aHotLine, nLine ) )
  ELSE                          ;    aLine := ACLONE( aHotLine[nLine] )
  ENDIF

  IF ValType( aLine ) == 'A' .AND. !EMPTY( aLine )
    AEVAL( aLine, {|x,xi|IF( ValType( IF( ValType(x[1])=='B', ;
                                        x[1]:=EVAL(x[1]), ;
                                        x[1] ) ) == 'C',;
                         (nLen := MAX( nLen, LEN(x[1]) ),;
                          ASIZE(x,5),;
                          x[5] := ATNUM( ':', x[1] ),;
                          IF( x[2]==555.AND.EMPTY(aHot[6]).AND.EMPTY(x[1]),,;
                              AADD( aHot[6], x ) )   ),;
                           ) } )

    // Дополним разделительные линии
    AEVAL( aHot[6], {|x| IF( x[2] == 555, x[1]:= PADC(x[1],nLen,'─'), ) } )

    IF !EMPTY( aHot[6] )
      aHot[ 1 ] := aHot[3] - LEN(aHot[6])-1
      aHot[ 2 ] := aHot[4] - nLen -3
      aHot[5] := ShadowBox( '[ '+ {'Ctrl','Shift', 'Alt'}[ nLine ] + ' ]',;
                          aHot[1], aHot[2], aHot[3], aHot[4], COL_YES_OR_NO, ,.T., .T. )
      AEVAL( aHot[6], {|x,i| SAYSCREEN( x[1], aHot[1]+i, aHot[2]+2),;
                             COLORWIN( aHot[1]+i, aHot[2]+2,;
                                       aHot[1]+i, aHot[2]+x[5],'GR+/B*' );
                       } )

      while (nStat := KBDStat()) > 0 .and.(nStat & 15) < 16.and.Inkey() == 0; enddo
      nKey:=LASTKEY()

      BrRestScreen( aHot[5] )

      IF nKey <> 0
        IF ( i := ASCAN( aHot[6], {|x| !EMPTY(x[2]).AND.x[2]==nKey } ) ) <> 0
          aqHotKey[1] := nKey
          aqHotKey[2] := aHot[6][i][3]
        ENDIF
        if (nStat & 15) > 0
           hb_KeyPut(nKey)
        endif
      ENDIF
    ENDIF
  ENDIF
  WSELECT( nW )
  @ aHot[7], aHot[8] SAY ''
  SetCursor(nCurs)
ENDIF

RETURN
