Qbrowse

 /*      *********************
 ОПИСАНИЕ ИНТЕРФЕЙСА
 **********************
 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