Category : Files from Magazines
Archive   : DBMS0191.ZIP
Filename : TECHTIP1.JAN

®RM78¯®LM0¯* HILTBAR.PRG by Bo Guo, Carl E. Kurt, 1990
* dBase III+/dBase IV/dBXL/Quicksilver/Clipper

PARAMETER FIELDS,AbortFlag,TOPROW,LEFTCOL,BOTTROW,RIGHTCOL
* -- FIELDS is the key field(s) displayed for selection
* -- AbortFlag is a Boolean to check whether action is aborted
* -- TOPROW,LEFTCOL,BOTTROW,RIGHTCOL are values defined screen window

RECCNT=recc() && Number of records
BottFlag=.F. && Cursor bar in the bottom of the page?
PreRow=TOPROW && Previous cursor bar position
LstSqn=1 && Sequence when records are listed in
&& unindexed fi~le it is equal to recno()go top~
@TOPROW-1,LEFTCOL-1 to BOTTROW+1,RIGHTCOL+1 && Draw a window box
do while .T.
RowNum=TOPROW
do while (RowNum<=BOTTROW) && List a page of the key~
@RowNum,LEFTCOL say &FIELDS && fields in the window
skip
RowNum=RowNum+1
LstSqn=LstSqn+1
if LstSqn=RECCNT+1 && Set EOF flag in last page
if RIGHTCOL-LEFTCOL>15
@BOTTROW+1,int((RIGHTCOL+leftcol)/2)-5 say " * E O F * "
else
@BOTTROW+1,int((RIGHTCOL+leftcol)/2)-2 say " EOF "
endi
exit
endi
enddo
if .not. BottFlag
if RowNum-1 PreRow=RowNum-1 &&
endif &&
skip -(RowNum-PreRow) && Skip to back to
&& the record to which
LstSqn=LstSqn-(RowNum-PreRow) &&
RowNum=PreRow &&
else && the cursor bar
skip -1 && is to point
RowNum=RowNum-1 &&
LstSqn=LstSqn-1
BottFlag=.F. &&
endif &&
PreRow=TOPROW && Reset previous cursor position
do while .T.
set color to N/W && Display current fields
@RowNum,LEFTCOL say &FIELDS && in highlight video
set color to
KeyIn=0
do while KeyIn=0
KeyIn=inkey() && Wiat for a key press
endd
do case
case KeyIn=13 && *** to select
&& the record
AbortFlag=.F.
return
case KeyIn=27
AbortFlag=.T. && *** to abort
&& the selection
return
case Keyln=5.or.Keyln=19 && *** or
do case && Up one record
case RowNum>TOPROW && Non-top cursor
@RowNum,LEFTCOL say & FIELDS
skip -1
RowNum=RowNum-1
LstSqn=LstSqn-1
loop
case RowNum=TOPROW.and.LstSqn>1 && Top cursor pointing to
@RowNum,LEFTCOL say &FIELDS && record other than 1st
skip -(BOTTROW-TOPROW+1) && Skip back a page
if LstSqn<=BOTTROW-TOPROW+1
PreRow=LstSqn+TOPROW-2
LstSqn=1
else
BottFlag=.T.
LstSqn=LstSqn-(BOTTROW-TOPROW+1)
endi
otherwise
loop
endcase
case KeyIn=24.or.KeyIn=32.or.KeyIn=4 && *** , ,
&&
do case && Done one record
case RowNum @RowNum,LEFTCOL say &FIELDS && pointing to record
skip && other than the last
RowNum=RowNum+1
LstSqn=LstSqn+1
loop
case RowNum=BOTTROW.and.LstSqn @RowNum,LEFTCOL say &FIELDS && and not pointing
skip 1 && to last record
LstSqn=LstSqn+1
otherwise && Cursor pointing to last record
loop
endcase
case KeyIn=18 && *** Up one page
if LstSqn>BOTTROW-TOPROW+1 && Current page is not page 1
skip -((BOTTROW-TOPROW+1)+RowNum-TOPROW)
LstSqn=LstSqn-((BOTTROW-TOPROW+1)+RowNum-TOPROW)
LstSqn=iif(LstSqn>0,LstSqn,1)
PreRow=RowNum
else
if LstSqn-(RowNum-TOPROW)>1 && Current page: page 2
PreRow=RowNum
go top
LstSqn=1
else && Current page: page 1
loop
endif
endif
case KeyIn=3 && *** Down a page
if BOTTROW-RowNum+LstSqn && the last page
PreRow=RowNum
skip BOTTROW-RowNum+1
LstSqn=LstSqn+BOTTROW-RowNum+1
else && Current page:Last page
loop
endif
case KeyIn=1 && *** Go top of page
if RowNum<>TOPROW && Non-top cursor
@RowNum,LEFTCOL say &FIELDS
skip -(RowNum-TOPROW)
LstSqn=LstSqn-(RowNum-TOPROW)
LstSqn=iif(LstSqn>0,LstSqn,1)
RowNum=TOPROW
endif
loop
case KeyIn=6 && *** Go bottom of page
if RowNum<>BOTTROW.or.LstSqn=RECCNT && Non-bottom cursor or
@RowNum,LEFTCOL say &FIELDS && not pointing to
&& the last record
TmpNum=RowNum+RECCNT-LstSqn
skip BOTTROW-RowNum
LstSqn=LstSqn+BOTTROW-RowNum
if EOF()
skip -1
LstSqn=RECCNT
RowNum=TmpNum
else
RowNum=BOTTROW
endif
endif
loop
case KeyIn=31 && *** <^PgUp> Go top of
&& the database
if LstSqn=RowNum-TOPROW+1 && In 1st page
if LstSqn>1 && Not pointing to the
@RowNum,LEFTCOL say &FIELDS && 1st record
go top
LstSqn=1
RowNum=TOPROW
endif
loop
else && Not in 1st page
go top
LstSqn=1
RowNum=TOPROW
endif
case KeyIn=30 && *** <^PgDn> Go Bottom of
&& the Database
if LstSqn=RECCNT && Pointing to the last record
loop
endif
if BOTTROW-RowNum+LstSqn go bottom
skip -(BOTTROW-TOPROW)
LstSqn=RecCnt-(BOTTROW-TOPROW)
BottFlag=.T.
else && In the last page
@RowNum,LEFTCOL say &FIELDS
RowNum=RowNum+RECCNT-LstSqn
go bottom
LstSqn=ReeCnt
loop
endif
otherwise && Other keys not accepted
?chr(7)
loop
endcase
@TOPROW,LEFTCOL clea to BOTTROW,RIGHTCOL && Clear window content
if RIGHTCOL-LEFTCOL>15 && Erase EOF flag and
&& restore frame
@BOTTROW+1,int((RIGHTCOL+leftcol)/2)-5 say replica(chr(196),11)
else
@BOTTROW+1,int((RIGHTCOL+leftcol)/2)-2 say replica(chr(196),5)
endi
exit
enddo
loop
enddo