Liren Large Software Subsidy 5

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSABROW.INC < prev next >

Wrap

Text File | 1988-06-03 | 12.3 KB | 503 lines

<<* MSABROW.INC *>> <<* Modified by R. Borter, Jr 5 May 1988 *>> <<procedure GenBrowseSimple>> <<begin>> <<GenColor( 0,'SCREEN' )>> CLEAR <<GenColor( 0,'STATUS' )>> @ 0,0 @ 0,0 SAY "Record# " * <<GenColor( 0,'PROMPT' )>> DO PromptBar @ 23,0 SAY "No fields to browse." WAIT <<end>> <<*GenBrowseSimple*>> <<procedure GenBrowsePrompt>> <<begin>> <<* 1 2 3 4 5 6 0123456789012345678901234567890123456789012345678901234567890123456789 BROWSE: Edit Find Goto fiLter <Arrows> <Del> <Return> *>> @ rowPROMPT,0 CLEAR @ rowPROMPT+1,0 SAY "BROWSE: Edit Find Goto fiLter "+ ; CHR(27)+CHR(24)+CHR(25)+CHR(26)+" <Del> <Return> " <<GenColor( 1,'HILITE' )>> @ rowPROMPT+1, 9 SAY "E" @ rowPROMPT+1,16 SAY "F" @ rowPROMPT+1,23 SAY "G" @ rowPROMPT+1,33 SAY "L" @ rowPROMPT+1,50 SAY "Del" @ rowPROMPT+1,57 SAY "Return" <<GenColor( 1,'PROMPT' )>> <<end>> <<*GenBrowsePrompt*>> <<# procedure GenDoOneDisp string alpha begin if ismultials genln( 'DO CASE' ) forall databases alpha := chr( dbfcount + 64 ) genln( 'CASE dbfarea = "',dbfcount,'"' ) pushmargin( 1 ) if fldtotal > 0 genln( 'DO ',fileprefix,'_',alpha,'DIS WITH row,1' ) endif popmargin endfor genln( 'ENDCASE' ) else genln( 'DO ',fileprefix,'_DISP WITH row,1' ) endif end GenDoOneDisp procedure GenDoDisplay string alpha begin if ismultials genln( 'DO CASE' ) forall databases alpha := chr( dbfcount + 64 ) genln( 'CASE dbfarea = "',dbfcount,'"' ) pushmargin( 1 ) if fldtotal > 0 genln( 'DO ',fileprefix,'_',alpha,'DIS WITH (rowTOP),skipRECS' ) else GenColor( 0,'SCREEN' ) genln( 'CLEAR' ) GenColor( 0,'STATUS' ) genln( '@ 0,0' ) genln( '@ 0,0 SAY "No fields available..."' ) endif popmargin endfor genln( 'ENDCASE' ) else genln( 'DO ',fileprefix,'_DISP WITH (rowTOP),skipRECS' ) endif end GenDoDisplay #>> <<procedure GenBrowseBody>> <<begin>> PRIVATE pancol,panMAX,panLAST,recnumTOP,recnumLAST,skipRECS PRIVATE HOME,ENDkey,UParrow,DOWNarrow,LEFTarrow,RIGHTarrow PRIVATE row,rowTOP,rowBOTTOM,rowPROMPT,KEYSTROKES,PagePaint PRIVATE isedited * ---Initialize constants. HOME = CHR(1) ENDkey = CHR(6) UParrow = CHR(5) DOWNarrow = CHR(24) LEFTarrow = CHR(19) RIGHTarrow = CHR(4) KEYSTROKES = "EFGL"+UParrow+DOWNarrow+HOME+LEFTarrow+; RIGHTarrow+ENDkey+PgDn+PgUp+DelRecord+Returnkey <<if ismultials>> rowTOP = 2 <<else>> rowTOP = 1 <<endif>> rowBOTTOM = 20 rowPROMPT = rowBOTTOM + 3 skipRECS = rowBOTTOM - rowTOP + 1 * ---Initialize local variables. row = rowTOP recnum = RECNO() recnumTOP = recnum PagePaint = .T. isedited = .F. pancol = 1 panLAST = 1 <<if ismultials>> DO CASE <<forall databases>> CASE dbfarea = {"}{dbfcount}{"} <<InitBrowse>> panMAX = {panmax} <<endfor>> ENDCASE <<else>> panMAX = {panmax} <<endif>> * ---Perform BROWSE. <<GenColor( 0,'SCREEN' )>> CLEAR * ---The following loop is really a "REPEAT/UNTIL <cond>". DO WHILE .T. *---SET CURSOR OFF ?? SYS(2002) IF PagePaint recnum = RECNO() GOTO recnumTOP <<if ismultials>> <<GenColor( 2,'HILITE' )>> <<select database 1>> <<filespec( dbfnam,fpath,fname,fext )>> <<fname := fpath[1]>> @ 0,0 SAY {"}{fname}:{"} + DBFname <<endif>> <<pushmargin( 2 )>> <<GenDoDisplay>> <<popmargin>> GOTO recnum IF pancol = panLAST * ---Reposition record pointer when repainting current page. row = rowTOP ENDIF panLAST = pancol PagePaint = .F. ENDIF <<GenColor( 1,'PROMPT' )>> DO PromptBar <<GenBrowsePrompt>> @ row,0 SAY CHR(16) DO GetKey WITH choice,KEYSTROKES * ---Reposition record pointer. DO WHILE choice $ UParrow+DOWNarrow @ row,0 SAY " " IF choice = UParrow SKIP -1 DO CASE CASE BOF() GOTO TOP CASE row > rowTOP row = row - 1 OTHERWISE <<if Fox>> recnumTOP = RECNO() * ---Scroll window down. Scroll rowTOP,0,rowBOTTOM,79,-1 <<pushmargin( 4 )>> <<GenDoOneDisp>> <<popmargin>> <<endif>> ENDCASE ELSE SKIP DO CASE CASE EOF() GOTO BOTTOM CASE row < rowBOTTOM row = row + 1 OTHERWISE <<if FOX>> * ---Adjust top-of-page record pointer. recnum = RECNO() GOTO recnumTOP SKIP recnumTOP = RECNO() GOTO recnum * ---Scroll window up. Scroll rowTOP,0,rowBOTTOM,79,1 <<pushmargin( 4 )>> <<GenDoOneDisp>> <<popmargin>> <<endif>> ENDCASE ENDIF @ row,0 SAY CHR(16) DO GetKey WITH choice,KEYSTROKES ENDDO * ---Prompt line selections. DO CASE CASE choice = Returnkey EXIT CASE choice = "E" recnumLAST = RECNO() SAVE SCREEN DO {fileprefix}_EDIT WITH isedited IF recnumLAST = RECNO() .AND. .NOT. isedited RESTORE SCREEN ELSE * ---Redisplay the screen. <<GenColor( 3,'SCREEN' )>> CLEAR GOTO recnumLAST * ---Do not reposition record pointer. panLAST = 0 PagePaint = .T. ENDIF CASE choice = "F" ?? SYS(2002,1) * ---Find a record. <<select all databases>> <<if ndxtotal = 0>> DO SayLine WITH rowPROMPT,"*** NO INDEX FILE IN USE" WAIT <<elsif ismultindx>> DO {fileprefix}_NDXS WITH rowPROMPT,choice IF choice > "0" recnumLAST = RECNO() DO {fileprefix}_SEEK WITH rowPROMPT IF EOF() DO SayLine WITH rowPROMPT,"No find." WAIT GOTO recnumLAST ELSE recnumTOP = RECNO() PagePaint = .T. ENDIF ENDIF <<else>> recnumLAST = RECNO() DO {fileprefix}_SEEK WITH rowPROMPT IF EOF() DO SayLine WITH rowPROMPT,"No find." WAIT GOTO recnumLAST ELSE recnumTOP = RECNO() PagePaint = .T. ENDIF <<endif>> <<* MODIFICATIONS *>> CASE choice = "G" DO DoGOTO WITH rowPROMPT,recnum,LastRec IF recnum > 0 recnumTOP = RECNO() PagePaint = .T. ENDIF CASE choice = DelRecord * ---Delete the record. IF DELETED() RECALL ELSE DELETE ENDIF <<if ismultials>> panLAST = 0 PagePaint = .T. <<*Display the whole thing*>> <<else>> DO {fileprefix}_DISP WITH row,1 <<endif>> CASE choice = PgDn IF .NOT. EOF() GOTO recnumTOP SKIP skipRECS IF EOF() GOTO BOTTOM ENDIF recnumTOP = RECNO() PagePaint = .T. ENDIF CASE choice = PgUp IF .NOT. BOF() GOTO recnumTOP SKIP -skipRECS IF BOF() GOTO TOP ENDIF recnumTOP = RECNO() PagePaint = .T. ENDIF CASE choice = "L" * ---Set FILTER. <<GenColor( 2,'WINDOW' )>> @ 1,0 CLEAR <<select database 8>> <<*Is SELECT H being used?*>> <<if dbfnam>> <<*Yes, then use old <expr> system...*>> DO {fileprefix}_EXPR WITH expr <<else>> <<*No, use new and improved...*>> DO {fileprefix}_COND WITH expr,notes <<endif>> IF "" = TRIM( expr ) SET FILTER TO ELSE * ---Check for valid LOGICAL expression. IF TYPE( expr ) = "L" SET FILTER TO &expr ELSE <<GenColor( 4,'PROMPT' )>> @ rowPROMPT,0 CLEAR @ rowPROMPT,0 SAY "Invalid expression." WAIT ENDIF ENDIF GOTO TOP IF EOF() <<GenColor( 3,'PROMPT' )>> @ rowPROMPT,0 CLEAR @ rowPROMPT,0 SAY "No matching records." WAIT SET FILTER TO GOTO TOP ENDIF recnumTOP = RECNO() PagePaint = .T. <<GenColor( 2,'SCREEN' )>> CLEAR CASE choice = HOME PagePaint = (pancol <> 1) pancol = 1 CASE choice = LEFTarrow IF pancol > 1 pancol = pancol - 1 PagePaint = .T. ENDIF CASE choice = RIGHTarrow IF pancol < panMAX pancol = pancol + 1 PagePaint = .T. ENDIF CASE choice = ENDkey PagePaint = (pancol <> panMAX) pancol = panMAX ENDCASE ENDDO SET FILTER TO GOTO TOP * ---SET CURSOR OFF ?? SYS(2002) <<end>> <<*GenBrowseBody*>> <<procedure GenBrowseDBU>> <<begin>> PRIVATE recnumTOP,recnumLAST,skipRECS PRIVATE row,rowTOP,rowBOTTOM,rowPROMPT,KEYSTROKES,PagePaint PRIVATE isedited PRIVATE filterSAVE rowPROMPT = 23 isedited = .F. filterSAVE = "" DO WHILE .T. * ---BUILD THE SCREEN <<GenColor( 2,'SCREEN' )>> @ 0,0,22,79 BOX '' @ 0,0,22,79 BOX "╒═╕│╛═╘│" @ 2,0 SAY "├" @ 2,79 SAY "┤" @ 2,1 SAY REPLICATE("─",78) <<GenColor( 2,'PROMPT' )>> @ rowPROMPT,0 CLEAR <<GenBrowsePrompt>> <<GenColor( 2,'SCREEN' )>> DBEDIT(3,1,22,78,.T.,"VGBROW",.T.,.T.,.T.,.T.,"═╧═") STORE UPPER(CHR(LASTKEY())) TO CHOICE DO CASE CASE choice = Returnkey EXIT CASE choice = "E" recnumLAST = RECNO() SET FILTER TO SAVE SCREEN DO {fileprefix}_EDIT WITH isedited * ---Restore FILTER. IF "" <> TRIM( filterSAVE ) SET FILTER TO &filterSAVE GOTO TOP ENDIF IF recnumLAST = RECNO() .AND. .NOT. isedited RESTORE SCREEN ELSE * ---Redisplay the screen. <<GenColor( 3,'SCREEN' )>> CLEAR GOTO recnumLAST * ---Do not reposition record pointer. panLAST = 0 PagePaint = .T. ENDIF CASE choice = "F" * ---Find a record. <<select all databases>> <<if ndxtotal = 0>> DO SayLine WITH rowPROMPT,"*** NO INDEX FILE IN USE" WAIT <<elsif ismultindx>> DO {fileprefix}_NDXS WITH rowPROMPT,choice IF choice > "0" recnumLAST = RECNO() DO {fileprefix}_SEEK WITH rowPROMPT IF EOF() DO SayLine WITH rowPROMPT,"No find." WAIT GOTO recnumLAST ELSE recnumTOP = RECNO() PagePaint = .T. ENDIF ENDIF <<else>> recnumLAST = RECNO() DO {fileprefix}_SEEK WITH rowPROMPT IF EOF() DO SayLine WITH rowPROMPT,"No find." WAIT GOTO recnumLAST ELSE recnumTOP = RECNO() PagePaint = .T. ENDIF <<endif>> CASE choice = "G" DO DoGOTO WITH rowPROMPT,recnum,LastRec IF recnum > 0 recnumTOP = RECNO() PagePaint = .T. ENDIF CASE choice = DelRecord * ---Delete the record. IF DELETED() RECALL ELSE DELETE ENDIF <<if ismultials>> panLAST = 0 PagePaint = .T. <<*Display the whole thing*>> <<else>> <<endif>> CASE choice = "L" * ---Set FILTER. <<GenColor( 2,'WINDOW' )>> @ 1,0 CLEAR <<select database 8>> <<*Is SELECT H being used?*>> <<if dbfnam>> <<*Yes, then use old <expr> system...*>> DO {fileprefix}_EXPR WITH expr <<else>> <<*No, use new and improved...*>> DO {fileprefix}_COND WITH expr <<endif>> IF "" = TRIM( expr ) SET FILTER TO filterSAVE = "" ELSE SET FILTER TO &expr filterSAVE = expr ENDIF GOTO TOP IF EOF() <<GenColor( 3,'PROMPT' )>> @ rowPROMPT,0 CLEAR @ rowPROMPT,0 SAY "No matching records." WAIT SET FILTER TO filterSAVE = "" GOTO TOP ENDIF recnumTOP = RECNO() PagePaint = .T. <<GenColor( 2,'SCREEN' )>> CLEAR ENDCASE ENDDO SET FILTER TO GOTO TOP <<end>> <<*GenBrowseDBU*>> <<* EOF: MSABROW.INC *>>