Liren Large Software Subsidy 5

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

/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / SSBFIMA.INC < prev next >

Wrap

Text File | 1992-04-01 | 22.5 KB | 865 lines

<<* Program : SSBFIMA.INC *>> <<procedure SSBFindMainBody>> <<integer recodefld,count>> <<begin>> PROCEDURE FINDSUB00 PARAMETERS STATUVAL PRIVATE FIELDLEN,FIELDSTA,FIELDTAB,FIELDEXPR STORE "" TO FIELDSTA,FIELDEXPR PRIVATE LINELEN,LABLEN1,LABLEN2,PAGSP,PAGMAX STORE 0 TO LINELEN,LABLEN1,LABLEN2,PAGSP,PAGMAX <<select fields on (fldtyp $ 'CNLD')>> <<recodefld := fldtotal>> <<* if ismultials *>> <<count := 1 >> DIMENSION FF({recodefld},7),PAG(5),HEADTITL(5),FIELDTAB(5) STORE 0 TO PAG(1),PAG(2),PAG(3),PAG(4),PAG(5) FIELDNUM = {recodefld} <<# genln( '*---- field information tabel ----------*' ) pushmargin(1) forall fields if (fldtyp $ 'CNLD') genln('FF(',count,',1) = "',ltrim(rtrim(fldlab)),'"') genln('FF(',count,',3) = "',fldnam,'"') genln('FF(',count,',4) = "',fldtyp,'"') if (fldtyp $ 'L') genln('FF(',count,',5) = 3') else genln('FF(',count,',5) = ',fldwid) endif if ismultials genln('FF(',count,',6) = "',fldals,'"') endif genln(' ') count := count + 1 endif endfor popmargin #>> <<* else *>> <<* DIMENSION FF({recodefld},5),PAG(5),HEADTITL(5),FIELDTAB(5) STORE 0 TO PAG(1),PAG(2),PAG(3),PAG(4),PAG(5) I = 1 FIELDNUM = FCOUNT() DO WHILE I <= FIELDNUM FF(I,3) = FIELD(I) FF(I,4) = TYPE(FIELD(I)) I = I + 1 ENDDO USE {msetfilename} INDEX {msetfilename} I = 1 DO WHILE I <= {recodefld} AAA = FF(I,3) FIND &AAA FF(I,1) = FIELDLAB IF FF(I,4) = 'L' FF(I,5) = 3 ELSE FF(I,5) = FIELDLEN ENDIF I = I + 1 ENDDO USE {fname} *>> <<* endif *>> ENDSwitch = .T. EscSwitch = .T. DO CASE CASE STATUVAL = "F" DO FINDSUB01 CASE STATUVAL = "S" CREATE VIEW workarea FROM ENVIRONMENT all DO {fileprefix}4 SET VIEW TO workarea ERASE workarea.vue ENDCASE NASCON = " " IF EscSwitch .AND. STATUVAL = "F" IF LEN(FIELDTAB) > 1 SET COLOR TO W/R @ 15, 20 CLEAR TO 17,60 @ 16, 25 SAY "┤°╠⌡╝■▓Θ╤»┬≡? ( Y/N )" GET NASCON PICTURE "XX" READ ENDIF IF NASCON $ "Yy" DO WHILE ENDSWITCH DO FINDSUB02 ENDDO ENDIF SET COLOR TO W/B,N/W CLEAR SET HEADING OFF IF LEN(FIELDTAB) > 1 DO FINDSUB06 ENDIF ENDIF RETURN ******************************************************************** PROCEDURE FINDSUB01 SET COLOR TO W/B,B/W CLEAR PRIVATE; I,N,PROW,ROWNUM,Win_Bot,KeyCode ROWNUM = 4 Win_Bot = 13 N = FIELDNUM KeyCode = 0 SET COLOR TO N/BG @ 3, 14 CLEAR TO 14,60 @ 3, 14 SAY "⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ ╩²╛▌┐Γ╫╓╢╬ ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤" I = 1 PROW = 3 DO WHILE I < 11 @ PROW+I,14 SAY "⌐ª" @ PROW+I,60 SAY "⌐ª" I = I + 1 ENDDO @ 14, 14 SAY "⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝" @ 18, 2 CLEAR TO 18,77 I = 1 PROW = 3 DO WHILE I < 11 .AND. I <= N @ PROW+1,19 SAY FF(I,1) @ PROW+1,40 SAY FF(I,3) @ PROW+1,52 SAY FF(I,4) @ PROW+1,55 SAY STR(FF(I,5),3) I = I + 1 PROW = PROW + 1 ENDDO I = 1 FIELDTAB = "" SET COLOR TO N/W @ 22, 0 CLEAR TO 24,80 @ 23, 2 SAY "íⁿí² ╤í╘±▓Θ╤»╫╓╢╬ [Enter] ╤í╓╨ [End] ╜ß╩° [Esc] ╖┼╞·" SET COLOR TO N/W @ 4,17 CLEAR TO 4,58 IF FF(I,2) @ ROWNUM, 17 SAY CHR(16)+" " ELSE @ ROWNUM, 17 SAY " " ENDIF @ 4,19 SAY FF(I,1) @ 4,40 SAY FF(I,3) @ 4,52 SAY FF(I,4) @ 4,55 SAY STR(FF(I,5),3) ? SYS(2002) DO WHILE .T. IF KeyCode = 6 .OR. KeyCode = 27 && [End].or.[Esc] IF KeyCode = 27 EscSwitch = .F. ENDIF EXIT ENDIF STORE INKEY() TO KeyCode DO CASE CASE KeyCode = 24 DO CASE CASE ROWNUM > Win_Bot-1 .AND. I < N SET COLOR TO N/GB DO FIELDCHI SCROLL 4,16,Win_Bot,58,1 I = I+1 SET COLOR TO N/W DO FIELDCHI CASE ROWNUM <= Win_Bot-1 .AND. I < N SET COLOR TO N/GB DO FIELDCHI ROWNUM = ROWNUM+1 I = I+1 SET COLOR TO N/W DO FIELDCHI OTHERWISE ?? CHR(7) ENDCASE CASE KeyCode = 5 DO CASE CASE ROWNUM < 5 .AND. I > 1 SET COLOR TO N/GB DO FIELDCHI SCROLL 4,16,Win_Bot,58,-1 I = I - 1 SET COLOR TO N/W DO FIELDCHI CASE ROWNUM >= 5 .AND. I > 1 SET COLOR TO N/GB DO FIELDCHI ROWNUM = ROWNUM-1 I = I - 1 SET COLOR TO N/W DO FIELDCHI OTHERWISE ?? CHR(7) ENDCASE CASE KeyCode = 3 IF I + 5 <= N STEP_L = 5 ELSE STEP_L = N-I+1 ENDIF SET COLOR TO N/GB DO FIELDCHI DO WHILE STEP_L > 0 DO CASE CASE ROWNUM > Win_Bot-1 .AND. I < N DO FIELDCHI SCROLL 4,16,Win_Bot,58,1 I = I+1 CASE ROWNUM <= Win_Bot-1 .AND. I < N ROWNUM = ROWNUM+1 I = I+1 OTHERWISE ?? CHR(7) ENDCASE STEP_L = STEP_L-1 ENDDO SET COLOR TO N/W DO FIELDCHI CASE KeyCode = 18 IF I - 5 >= 1 STEP_L = 5 ELSE STEP_L = I ENDIF SET COLOR TO N/GB DO FIELDCHI DO WHILE STEP_L > 0 DO CASE CASE ROWNUM < 5 .AND. I > 1 DO FIELDCHI SCROLL 4,16,Win_Bot,58,-1 I = I-1 CASE ROWNUM >= 5 .AND. I > 1 ROWNUM = ROWNUM-1 I = I-1 OTHERWISE ?? CHR(7) ENDCASE STEP_L = STEP_L-1 ENDDO SET COLOR TO N/W DO FIELDCHI CASE KeyCode = 13 SET COLOR TO N/W FF(I,2) = .NOT. FF(I,2) IF FF(I,2) @ ROWNUM, 17 SAY CHR(16)+" " <<if ismultials>> DO CASE CASE LEN(FIELDTAB) > 1 .AND. FF(I,6) $ "AM" FIELDTAB = FF(I,3) CASE LEN(FIELDTAB) > 1 FIELDTAB = FF(I,6) + "->" + FF(I,3) CASE LEN(FIELDTAB) > 1 .AND. FF(I,6) $ "AM" FIELDTAB = FIELDTAB + "," + FF(I,3) CASE LEN(FIELDTAB) > 1 FIELDTAB = FIELDTAB + "," + FF(I,6) + "->" + FF(I,3) ENDCASE ELSE @ ROWNUM, 17 SAY " " IF FF(1,6) $ "AM" FIELDLEN = LEN(FF(I,3)) FIELDSTA = AT(FF(I,3),FIELDTAB) ELSE FIELDLEN = LEN(FF(I,3)) + 3 FIELDSTA = AT(FF(I,3),FIELDTAB) - 3 ENDIF FIELDTAB = STUFF(FIELDTAB,FIELDSTA-1,FIELDLEN+1,"") ENDIF <<else>> IF LEN(FIELDTAB) < 1 FIELDTAB = FF(I,3) ELSE FIELDTAB = FIELDTAB + "," + FF(I,3) ENDIF ELSE @ ROWNUM, 17 SAY " " FIELDLEN = LEN(FF(I,3)) FIELDSTA = AT(FF(I,3),FIELDTAB) FIELDTAB = STUFF(FIELDTAB,FIELDSTA-1,FIELDLEN+1,"") ENDIF <<endif>> SET COLOR TO W+/B,N/W @ 17, 2 SAY "▓┘ ╫≈ ╫╓ ╢╬ ▒φ : " SET COLOR TO N/GB,N/W @ 18, 2 CLEAR TO 18,77 @ 18, 2 SAY FIELDTAB ENDCASE ENDDO IF KeyCode <> 27 PagMax = 0 I = 1 PAGSP = 1 PAG(PAGSP) = 1 DO WHILE I <= N LINELEN = 9 LABLEN1 = 0 LABLEN2 = 0 DO WHILE I <= N IF FF(I,2) LABLEN1 = LEN( TRIM( FF(I,1) ) ) LABLEN2 = MAX( LABLEN1,FF(I,5) ) + 1 LINELEN = LINELEN + LABLEN2 ENDIF IF LINELEN > 80 LINELEN = LINELEN - LABLEN2 PAG(PAGSP) = I - 1 PAGSP = PAGSP + 1 EXIT ENDIF I = I + 1 ENDDO PagMax = PagMax + 1 ENDDO PAG(PAGSP) = I - 1 I = 1 PAGSP = 1 DO WHILE PAGSP <= PAGMAX DO FIELDPRO PAGSP = PAGSP + 1 ENDDO ENDIF RETURN ******************************************************************** PROCEDURE FINDSUB02 PRIVATE I,N,PROW,ROWNUM,Win_Bot,KeyCode N = FIELDNUM SET COLOR TO +W/B,B/W CLEAR @ 3, 0 SAY "⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ ▓┘╫≈╠⌡╝■ ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ" SET COLOR TO N/W,N/W @ 20, 2 CLEAR TO 20,77 @ 20, 2 SAY FIELDEXPR SET COLOR TO N/BG @ 3, 40 CLEAR TO 14,80 @ 3, 40 SAY "⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ ╩²╛▌┐Γ╫╓╢╬ ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤" I = 1 PROW = 3 DO WHILE I < 11 @ PROW+I,40 SAY "⌐ª" @ PROW+I,78 SAY "⌐ª" I = I + 1 ENDDO @ 14, 40 SAY "⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝" I = 1 PROW = 3 DO WHILE I < 11 .AND. I <= N @ PROW+1,43 SAY FF(I,1) @ PROW+1,64 SAY FF(I,3) @ PROW+1,75 SAY FF(I,4) I = I + 1 PROW = PROW + 1 ENDDO ROWNUM = 4 Win_Bot = 13 KeyCode = 0 I = 1 SET COLOR TO N/W @ 22, 0 CLEAR TO 24,80 @ 23, 2 SAY "íⁿí² ╤í╘±╫╓╢╬ [Enter] ╤í╓╨ [Esc]╖┼╞·╤í╘± " SET COLOR TO N/W @ 4,43 CLEAR TO 4,76 @ 4,43 SAY FF(I,1) @ 4,64 SAY FF(I,3) @ 4,75 SAY FF(I,4) ? SYS(2002) DO WHILE .T. IF KeyCode = 27 .OR. KeyCode = 6 && [End].or.[Esc] IF KeyCode = 27 FIELDEXPR = "" ENDIF EXIT ENDSWITCH = .F. ENDIF STORE INKEY() TO KeyCode DO CASE CASE KeyCode = 24 DO CASE CASE ROWNUM > Win_Bot-1 .AND. I < N SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) SCROLL 4,42,Win_Bot,76,1 I = I+1 SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) CASE ROWNUM <= Win_Bot-1 .AND. I < N SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) ROWNUM = ROWNUM+1 I = I+1 SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) OTHERWISE ?? CHR(7) ENDCASE CASE KeyCode = 5 DO CASE CASE ROWNUM < 5 .AND. I > 1 SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) SCROLL 4,42,Win_Bot,76,-1 I = I - 1 SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) CASE ROWNUM >= 5 .AND. I > 1 SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) ROWNUM = ROWNUM-1 I = I - 1 SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) OTHERWISE ?? CHR(7) ENDCASE CASE KeyCode = 3 IF I + 5 <= N STEP_L = 5 ELSE STEP_L = N-I+1 ENDIF SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) DO WHILE STEP_L > 0 DO CASE CASE ROWNUM > Win_Bot-1 .AND. I < N @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) SCROLL 4,42,Win_Bot,76,1 I = I+1 CASE ROWNUM <= Win_Bot-1 .AND. I < N ROWNUM = ROWNUM+1 I = I+1 OTHERWISE ?? CHR(7) ENDCASE STEP_L = STEP_L-1 ENDDO SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) CASE KeyCode = 18 IF I - 5 >= 1 STEP_L = 5 ELSE STEP_L = I ENDIF SET COLOR TO N/GB @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) DO WHILE STEP_L > 0 DO CASE CASE ROWNUM < 5 .AND. I > 1 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) SCROLL 4,42,Win_Bot,76,-1 I = I-1 CASE ROWNUM >= 5 .AND. I > 1 ROWNUM = ROWNUM-1 I = I-1 OTHERWISE ?? CHR(7) ENDCASE STEP_L = STEP_L-1 ENDDO SET COLOR TO N/W @ ROWNUM, 42 CLEAR TO ROWNUM, 76 @ ROWNUM, 43 SAY FF(I,1) @ ROWNUM, 64 SAY FF(I,3) @ ROWNUM, 75 SAY FF(I,4) CASE KeyCode = 13 <<if ismultials>> IF FF(I,6) $ "AM" FIELDNAME = FF(I,3) ELSE FIELDNAME = FF(I,6) + "->" + FF(I,3) ENDIF <<else>> FIELDNAME = FF(I,3) <<endif>> FIELDEXPR = FIELDEXPR + FIELDNAME SET COLOR TO +W/B @ 5, 2 SAY "╫╓ ╢╬ ├√: " @ 5,13 SAY FIELDNAME DO FINDSUB03 SET COLOR TO N/W,N/W @ 20, 2 CLEAR TO 20,77 @ 20, 2 SAY FIELDEXPR EXIT ENDCASE ENDDO RETURN ******************************************************************** PROCEDURE FINDSUB03 SET COLOR TO W/N @ 9,37 CLEAR TO 17,77 SET COLOR TO +N/W,W/N @ 8,36 CLEAR TO 16,75 @ 8,36 SAY "⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ ╣╪╧╡╘╦╦π╖√ ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤" I = 1 PROW = 8 DO WHILE I < 8 @ PROW+I,36 SAY "⌐ª" @ PROW+I,74 SAY "⌐ª" I = I + 1 ENDDO @ 16,36 SAY "⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝" menuchoice = 0 @ 10,40 PROMPT " 1. = ╡╚ ╙┌ " @ 11,40 PROMPT " 2. <> ▓╗ ╡╚ ╙┌ " @ 12,40 PROMPT " 3. > ┤≤ ╙┌ " @ 13,40 PROMPT " 4. >= ┤≤ ╙┌ ╗≥ ╡╚ ╙┌ " @ 14,40 PROMPT " 5. < ╨í ╙┌ " @ 15,40 PROMPT " 6. <= ╨í ╙┌ ╗≥ ╡╚ ╙┌ " MENU TO menuchioc chioc = SUBSTR( "AABCDEF",menuchioc+1,1) DO CASE CASE chioc = "A" RELAOPER = " = " CASE chioc = "B" RELAOPER = " <> " CASE chioc = "C" RELAOPER = " > " CASE chioc = "D" RELAOPER = " >= " CASE chioc = "E" RELAOPER = " < " CASE chioc = "F" RELAOPER = " <= " ENDCASE FIELDEXPR = FIELDEXPR + RELAOPER SET COLOR TO +W/B @ 7, 2 SAY "╘╦╦π▓┘╫≈: " @ 7,13 SAY RELAOPER DO FINDSUB05 SET COLOR TO N/W,N/W @ 20, 2 CLEAR TO 20,77 @ 20, 2 SAY FIELDEXPR DO FINDSUB04 SET COLOR TO N/W,N/W @ 20, 2 CLEAR TO 20,77 @ 20, 2 SAY FIELDEXPR RETURN ******************************************************************** PROCEDURE FINDSUB04 PRIVATE menuchioc,chioc SET COLOR TO W/N @ 11,33 CLEAR TO 19,73 SET COLOR TO N/GB,N/W @ 10,32 CLEAR TO 18,71 @ 10,32 SAY "⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ ┬▀╝¡╘╦╦π╖√ ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤" I = 1 PROW = 10 DO WHILE I < 8 @ PROW+I,32 SAY "⌐ª" @ PROW+I,70 SAY "⌐ª" I = I + 1 ENDDO @ 18,32 SAY "⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝" menuchoice = 0 @ 12,36 PROMPT " 1. ═╦ │÷ ┴¼ ╜╙ ▒φ ┤∩ ╩╜ " @ 13,36 SAY " ------------------------------ " @ 14,36 PROMPT " 2. ╙├ .AND. (╙δ) ┴¼ ▒φ ┤∩ ╩╜ " @ 15,36 PROMPT " 3. ╙├ .OR. (╗≥) ┴¼ ▒φ ┤∩ ╩╜ " @ 16,36 PROMPT " 4. ╙├ .AND..NOT.(╙δ╖╟)┴¼▒φ┤∩╩╜ " @ 17,36 PROMPT " 5. ╙├ .AND..NOT.(╗≥╖╟)┴¼▒φ┤∩╩╜ " MENU TO menuchioc chioc = SUBSTR( "AABCDEF",menuchioc+1,1) DO CASE CASE chioc = "A" ENDSWITCH = .F. CASE chioc = "B" FIELDEXPR = FIELDEXPR + " .AND. " CASE chioc = "C" FIELDEXPR = FIELDEXPR + " .OR. " CASE chioc = "D" FIELDEXPR = FIELDEXPR + " .AND. .NOT " CASE chioc = "E" FIELDEXPR = FIELDEXPR + " .OR. .NOT " ENDCASE RETURN ******************************************************************** PROCEDURE FINDSUB05 SET CONFIRM ON SET COLOR TO +W/B,N/W DO CASE CASE TYPE("&FIELDNAME") = "D" AAA1 = CTOD(' / / ') CASE TYPE("&FIELDNAME") = "C" AAA1 = SPACE(20) CASE TYPE("&FIELDNAME") = "L" AAA1 = .F. CASE TYPE("&FIELDNAME") = "N" AAA1 = 0.00 ENDCASE @ 9, 2 SAY "╠⌡ ╝■ ╓╡: " @ 9,13 GET AAA1 READ IF TYPE ("&AAA1") = "U" DO CASE CASE TYPE("&FIELDNAME") = "D" AAA2 = "CTOD('" + DTOC(AAA1) + "')" CASE TYPE("&FIELDNAME") = "N" AAA2 = LTRIM( STR( AAA1,12,2)) CASE TYPE("&FIELDNAME") = "L" AAA2 = IIF( AAA1,".T.",".F.") CASE TYPE("&FIELDNAME") = "C" AAA2 = "'" + TRIM(AAA1) + "'" ENDCASE FIELDEXPR = FIELDEXPR + AAA2 ELSE IF TYPE("&AAA1") = "N" FIELDEXPR = FIELDEXPR + "'" + TRIM(AAA1) + "'" ELSE FIELDEXPR = FIELDEXPR + TRIM(AAA1) ENDIF ENDIF SET CONFIRM OFF RETURN ******************************************************************** PROCEDURE FINDSUB06 *PROGRAM SSB-FIND.PRG PRIVATE pancol,panLAST,recnumTOP,recnumLAST,skipRECS PRIVATE HOME,ENDkey,UParrow,DOWNarrow,LEFTarrow,RIGHTarrow PRIVATE PgUp,PgDn,Rrturnkey PRIVATE row,rowTOP,rowBOTTOM,rowPROMPT,KEYSTROKES,PagePaint PRIVATE choice,menuhdg * ---Initialize constants. HOME = CHR(1) ENDkey = CHR(6) UParrow = CHR(5) DOWNarrow = CHR(24) LEFTarrow = CHR(19) RIGHTarrow = CHR(4) PgUp = CHR(18) PgDn = CHR(3) Returnkey = CHR(13) menuhdg = "▓Θ ╤» ╧╡ ═│" rowTOP = 1 rowBOTTOM = 20 rowPROMPT = rowBOTTOM + 3 skipRECS = rowBOTTOM - rowTOP + 1 * ---Initialize local variables. row = rowTOP recnum = RECNO() recnumTOP = recnum PagePaint = .T. pancol = 1 panLAST = 1 * ---Perform BROWSE. SET COLOR TO W/B,N/W &&ScreenAtr CLEAR * ---The following loop is really a "REPEAT/UNTIL <cond>". SET COLOR TO N/W @ 22, 0 CLEAR TO 24,80 @ 23, 2 SAY "í·╙╥╖¡ í√╫≤╖¡ íⁿ╔╧╥│ í²╧┬╥│ [End]╙╥╬▓╥│ [Home]╫≤╩╫╥│ [Enter]╖╡╗╪ [Esc] ╖┼╞· " DO WHILE .T. *---SET CURSOR OFF * ?? SYS(2002) IF PagePaint recnum = RECNO() GOTO recnumTOP DO FIELDISP WITH rowTOP,skipRECS GOTO recnum IF pancol = panLAST * ---Reposition record pointer when repainting current page. row = rowTOP ENDIF panLAST = pancol PagePaint = .F. ENDIF * ---Read data from keyborbd choice = CHR(INKEY()) * ---Prompt line selections. DO CASE CASE choice = Returnkey EXIT CASE choice = PgDn .OR. choice = DOWNarrow IF .NOT. EOF() GOTO recnumTOP SKIP skipRECS IF EOF() GOTO BOTTOM ENDIF recnumTOP = RECNO() PagePaint = .T. ENDIF CASE choice = PgUp .OR. choice = UParrow IF .NOT. BOF() GOTO recnumTOP SKIP -skipRECS IF BOF() GOTO TOP ENDIF recnumTOP = RECNO() PagePaint = .T. ENDIF 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 < PagMax pancol = pancol + 1 PagePaint = .T. ENDIF CASE choice = ENDkey PagePaint = (pancol <> PagMax) pancol = PagMax ENDCASE ENDDO GOTO TOP * ---SET CURSOR OFF * ?? SYS(2002) RETURN ******************************************************************** PROCEDURE FIELDCHI @ ROWNUM, 17 CLEAR TO ROWNUM, 58 @ ROWNUM, 19 SAY FF(I,1) @ ROWNUM, 40 SAY FF(I,3) @ ROWNUM, 52 SAY FF(I,4) @ ROWNUM, 55 SAY STR(FF(I,5),3) IF FF(I,2) @ ROWNUM, 17 SAY CHR(16)+" " ELSE @ ROWNUM, 17 SAY " " ENDIF RETURN ********************************************************************* PROCEDURE FIELDPRO HEADTITL(pagsp) = " ╝╟┬╝║┼ " LINELEN = 9 LABLEN = 0 FIELDLAB = "" FIELDTAB(pagsp) = " " SCREENWID = 80 DO WHILE I <= pag(Pagsp) IF FF(I,2) LABLEN = LEN( TRIM( FF(I,1) ) ) LINELEN = LINELEN + MAX( LABLEN,FF(I,5) ) + 1 IF LABLEN <= FF(I,5) FIELDLAB = TRIM(FF(I,1)) + SPACE(FF(I,5) - LABLEN + 1) HEADTITL(pagsp) = HEADTITL(pagsp) + FIELDLAB <<if ismultials>> DO CASE CASE (FIELDTAB(pagsp) = " ") .AND. (FF(I,6) $ "AM") FIELDTAB(pagsp) = FF(I,3) CASE FIELDTAB(pagsp) = " " FIELDTAB(pagsp) = FF(I,6) + "->" + FF(I,3) CASE (FIELDTAB(pagsp) <> " ") .AND. (FF(I,6) $ "AM") FIELDTAB(pagsp) = FIELDTAB(pagsp) + ',' + FF(I,3) CASE FIELDTAB(pagsp) <> " " FIELDTAB(pagsp) = FIELDTAB(pagsp) + ',' + FF(I,6) + '->' + FF(I,3) ENDCASE <<else>> IF FIELDTAB(pagsp) = " " FIELDTAB(pagsp) = FF(I,3) ELSE FIELDTAB(pagsp) = FIELDTAB(pagsp) + ',' + FF(I,3) ENDIF <<endif>> ELSE HEADTITL(pagsp) = HEADTITL(pagsp) + TRIM( FF(I,1) ) + " " IF FIELDTAB(pagsp) = " " FIELDTAB(pagsp) = FF(I,3) + ',"' + SPACE( LABLEN - FF(I,5) - 1 ) + '"' ELSE FIELDTAB(pagsp) = FIELDTAB(pagsp) + ',' + FF(I,3) + ',"' +; SPACE( LABLEN - FF(I,5) - 1 ) + '"' ENDIF ENDIF ENDIF I = I + 1 ENDDO RETURN ******************************************************************** PROCEDURE FIELDISP * Program.: FIELDISP.PRG PARAMETER row,listRECS IF listRECS > 1 * ---Display heading when listing the entire page. SET COLOR TO N/W &&StatusAtr @ row-1,0 @ row-1,0 SAY headtitl(pancol) * ---Clear the window area. SET COLOR TO W/B,N/W &&WindowAtr Scroll row,0,rowBOTTOM+1,79,rowBOTTOM+1-row ENDIF * ---Display the records. SET HEADING OFF SET COLOR TO W/B,N/W &&WindowAtr @ row-1,0 SAY "" IF LEN( RTRIM( FIELDEXPR ) ) <> 0 FieldList = FIELDTAB(pancol) + " FOR " + FIELDEXPR ELSE FieldList = FIELDTAB(pancol) ENDIF LIST NEXT listRECS &FieldList SET HEADING ON << end >> <<* EOF: SSBFIMA.INC *>>