home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9101.ZIP / TECHTIP1.JAN < prev    next >
Encoding:
Text File  |  1990-11-16  |  6.1 KB  |  196 lines
  1. «RM78»«LM0»* HILTBAR.PRG        by Bo Guo, Carl E. Kurt, 1990
  2. *             dBase III+/dBase IV/dBXL/Quicksilver/Clipper
  3.  
  4. PARAMETER FIELDS,AbortFlag,TOPROW,LEFTCOL,BOTTROW,RIGHTCOL
  5. * -- FIELDS is the key field(s) displayed for selection
  6. * -- AbortFlag is a Boolean to check whether action is aborted
  7. * -- TOPROW,LEFTCOL,BOTTROW,RIGHTCOL are values defined screen window
  8.  
  9. RECCNT=recc()         && Number of records
  10. BottFlag=.F.          && Cursor bar in the bottom of the page?
  11. PreRow=TOPROW          && Previous cursor bar position
  12. LstSqn=1         && Sequence when records are listed in
  13.             && unindexed fi~le it is equal to recno()go top~
  14. @TOPROW-1,LEFTCOL-1 to BOTTROW+1,RIGHTCOL+1  && Draw a window box
  15. do while .T.
  16.   RowNum=TOPROW
  17.   do while (RowNum<=BOTTROW)         && List a page of the key~
  18.      @RowNum,LEFTCOL say &FIELDS     && fields in the window
  19.      skip
  20.      RowNum=RowNum+1
  21.      LstSqn=LstSqn+1
  22.      if LstSqn=RECCNT+1                && Set EOF flag in last page
  23.          if RIGHTCOL-LEFTCOL>15
  24.           @BOTTROW+1,int((RIGHTCOL+leftcol)/2)-5 say " * E O F * "
  25.          else
  26.               @BOTTROW+1,int((RIGHTCOL+leftcol)/2)-2 say " EOF "
  27.          endi
  28.        exit
  29.      endi
  30.    enddo
  31.    if .not. BottFlag
  32.     if RowNum-1<PreRow             &&
  33.         PreRow=RowNum-1             &&
  34.     endif                     &&
  35.     skip -(RowNum-PreRow)             && Skip to back to 
  36.                                              &&   the record to which
  37.           LstSqn=LstSqn-(RowNum-PreRow)      &&
  38.     RowNum=PreRow                 &&
  39.    else                         &&   the cursor bar
  40.     skip -1                     &&   is to point
  41.     RowNum=RowNum-1                 &&
  42.      LstSqn=LstSqn-1
  43.     BottFlag=.F.           &&
  44.    endif                       &&
  45.    PreRow=TOPROW            && Reset previous cursor position
  46.    do while .T.
  47.     set color to N/W              && Display current fields
  48.     @RowNum,LEFTCOL say &FIELDS   &&   in highlight video
  49.     set color to 
  50.     KeyIn=0
  51.     do while KeyIn=0
  52.          KeyIn=inkey()            && Wiat for a key press
  53.     endd
  54.     do case
  55.          case KeyIn=13            && *** <Return> to select
  56.                       && the record
  57.         AbortFlag=.F.
  58.         return
  59.          case KeyIn=27
  60.         AbortFlag=.T.           && *** <Esc> to abort 
  61.                         && the selection
  62.         return        
  63.          case Keyln=5.or.Keyln=19   && *** <UpArrow> or <LeftArrow>
  64.         do case                 &&      Up one record
  65.            case RowNum>TOPROW   && Non-top cursor
  66.              @RowNum,LEFTCOL say & FIELDS
  67.              skip -1
  68.              RowNum=RowNum-1
  69.              LstSqn=LstSqn-1
  70.                   loop
  71.          case RowNum=TOPROW.and.LstSqn>1 && Top cursor pointing to
  72.            @RowNum,LEFTCOL say &FIELDS   &&  record other than 1st
  73.            skip -(BOTTROW-TOPROW+1)      && Skip back a page
  74.            if LstSqn<=BOTTROW-TOPROW+1
  75.                 PreRow=LstSqn+TOPROW-2
  76.                 LstSqn=1
  77.            else
  78.                 BottFlag=.T.
  79.                 LstSqn=LstSqn-(BOTTROW-TOPROW+1)
  80.            endi
  81.          otherwise
  82.            loop
  83.     endcase
  84.      case KeyIn=24.or.KeyIn=32.or.KeyIn=4    && *** <DnArrow>, <Space>,
  85.                          && <RightArrow>
  86.       do case                            &&   Done one record
  87.        case RowNum<BOTTROW.and.LstSqn<RECCNT && Non-bottom cursor
  88.       @RowNum,LEFTCOL say &FIELDS        &&   pointing to record
  89.       skip                     &&   other than the last
  90.       RowNum=RowNum+1
  91.         LstSqn=LstSqn+1
  92.       loop
  93.        case RowNum=BOTTROW.and.LstSqn<RECCNT && At bottom of page
  94.       @RowNum,LEFTCOL say &FIELDS         &&   and not pointing
  95.       skip 1                 &&   to last record
  96.         LstSqn=LstSqn+1
  97.        otherwise             && Cursor pointing to last record
  98.          loop
  99.     endcase
  100.      case KeyIn=18            && *** <PgUp> Up one page
  101.     if LstSqn>BOTTROW-TOPROW+1    && Current page is not page 1
  102.       skip -((BOTTROW-TOPROW+1)+RowNum-TOPROW)
  103.         LstSqn=LstSqn-((BOTTROW-TOPROW+1)+RowNum-TOPROW)
  104.           LstSqn=iif(LstSqn>0,LstSqn,1)
  105.        PreRow=RowNum
  106.     else
  107.        if LstSqn-(RowNum-TOPROW)>1         && Current page: page 2
  108.          PreRow=RowNum
  109.          go top
  110.          LstSqn=1
  111.        else                     && Current page: page 1
  112.          loop
  113.        endif
  114.         endif
  115.      case KeyIn=3                 && *** <PgDn> Down a page
  116.     if BOTTROW-RowNum+LstSqn<RECCNT         && Current page is not
  117.                          && the last page
  118.        PreRow=RowNum
  119.        skip BOTTROW-RowNum+1
  120.        LstSqn=LstSqn+BOTTROW-RowNum+1
  121.     else                     && Current page:Last page
  122.        loop
  123.     endif
  124.      case KeyIn=1                 && *** <Home> Go top of page
  125.     if RowNum<>TOPROW          && Non-top cursor
  126.        @RowNum,LEFTCOL say &FIELDS
  127.        skip -(RowNum-TOPROW)
  128.        LstSqn=LstSqn-(RowNum-TOPROW)
  129.        LstSqn=iif(LstSqn>0,LstSqn,1)
  130.        RowNum=TOPROW
  131.     endif
  132.     loop
  133.      case KeyIn=6             && *** <End> Go bottom of page
  134.     if RowNum<>BOTTROW.or.LstSqn=RECCNT  && Non-bottom cursor or
  135.        @RowNum,LEFTCOL say &FIELDS         &&  not pointing to
  136.                          &&  the last record
  137.        TmpNum=RowNum+RECCNT-LstSqn
  138.        skip BOTTROW-RowNum
  139.        LstSqn=LstSqn+BOTTROW-RowNum
  140.        if EOF()
  141.            skip -1
  142.            LstSqn=RECCNT
  143.            RowNum=TmpNum
  144.        else
  145.            RowNum=BOTTROW
  146.        endif
  147.     endif
  148.     loop
  149.      case KeyIn=31                     && *** <^PgUp> Go top of
  150.                        &&     the database
  151.     if LstSqn=RowNum-TOPROW+1       && In 1st page
  152.        if LstSqn>1               && Not pointing to the
  153.         @RowNum,LEFTCOL say &FIELDS    &&   1st record
  154.         go top
  155.         LstSqn=1
  156.         RowNum=TOPROW
  157.       endif
  158.       loop
  159.     else                     && Not in 1st page
  160.       go top
  161.       LstSqn=1
  162.       RowNum=TOPROW
  163.     endif
  164.       case KeyIn=30        && *** <^PgDn> Go Bottom of
  165.                 &&     the Database
  166.     if LstSqn=RECCNT    && Pointing to the last record
  167.       loop
  168.     endif
  169.     if BOTTROW-RowNum+LstSqn<RECCNT      && Not in the last page
  170.       go bottom
  171.       skip -(BOTTROW-TOPROW)
  172.       LstSqn=RecCnt-(BOTTROW-TOPROW)
  173.       BottFlag=.T.
  174.     else                  && In the last page
  175.       @RowNum,LEFTCOL say &FIELDS
  176.       RowNum=RowNum+RECCNT-LstSqn
  177.       go bottom
  178.       LstSqn=ReeCnt
  179.       loop
  180.     endif
  181.       otherwise                  && Other keys not accepted
  182.     ?chr(7)
  183.     loop
  184.    endcase
  185.    @TOPROW,LEFTCOL clea to BOTTROW,RIGHTCOL && Clear window content
  186.    if RIGHTCOL-LEFTCOL>15             && Erase EOF flag and
  187.                          && restore frame
  188.     @BOTTROW+1,int((RIGHTCOL+leftcol)/2)-5 say replica(chr(196),11)
  189.    else
  190.     @BOTTROW+1,int((RIGHTCOL+leftcol)/2)-2 say replica(chr(196),5)
  191.    endi
  192.    exit
  193.   enddo
  194.   loop
  195. enddo
  196.