Liren Large Software Subsidy 5/05.iso/a/a046/5.img/TEMPLATE/SSBSTATI.INC

Text File | 1992-04-01 | 17.9 KB | 805 lines

<<* Program : SSBSTATI.INC  *>>

<<procedure SSBStatiBody>>
<<integer recodefld,count>>
<<begin>>

PROC {fileprefix}4
PRIVATE fsum ,favg,db1,dbcx,dbmc,dbftj
STORE '' TO fsum ,favg,db1,dbcx,dbmc
DBFTJ = DBF()
lnnkey=0
DO WHIL .T.
   DO pwaitkey WITH '0.═╦│÷ 1.╤í╘±╫▄╝╞╫╓╢╬ 2.╤í╘±╞╜╛∙╓╡╫╓╢╬ 3.╟≤═│╝╞╓╡ ',;
      lnnkey
   DO CASE
   CASE lnnkey=0
      RETURN
   CASE lnnkey=1
      repsum=.T.
      repavg=.F.
      DO pgetzd WITH repsum,repavg,dbftj
   CASE lnnkey=2
      repavg=.T.
      repsum=.F.
      DO pgetzd WITH repsum,repavg,dbftj
   CASE lnnkey=3
      DO ptj
   ENDCASE
   SELE 1
   USE &dbftj
   I = 1
   fieldnum = FCOUNT()
   DO WHILE I <= fieldnum
      FF(I,2) = .F.
      I = I + 1
   ENDDO
   lnnkey=MOD(lnnkey+1,4)
ENDDO
RETURN

PROC pgetzd
PARA repsum ,repavg,dbftj
db1=dbftj
dbcx=LTRIM(STR(VAL(db1)+1))
USE &dbftj
endswitch = .T.
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 "íⁿí²PgUp PgDn ╤í╘±═│╝╞╫╓╢╬    [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.
   keycode=INKEY()
   IF keycode = 6 .OR. keycode = 27  && [End].or.[Esc]
      EXIT
   ENDIF
   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
      IF FF(I,4)='N'
         FF(I,2) = .NOT. FF(I,2)
         IF FF(I,2)
            @ rownum, 17 SAY CHR(16)+" "
            IF repsum .AND. .NOT. repavg
               FF(I,6)=.T.
               fsum=fsum+FF(I,3)
            ELSE
               FF(I,7)=.T.
               favg=favg+FF(I,3)
            ENDIF
            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
         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
      ELSE
         DO pwarn WITH '╕├╫╓╢╬▓╗╩╟╩²╓╡╨═╡─,▓╗─▄▒╗═│╝╞ !!!'
         keycode=0
      ENDIF
   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 pgettj
SET COLOR TO +W/B,B/W
CLEAR
PRIVATE I,N,PROW,rownum,win_bot,keycode
@ 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
   @ PROW+1,43 SAY FF(I,1)
   @ PROW+1,64 SAY FF(I,3)
   @ PROW+1,75 SAY FF(I,4)
   @ PROW+1,55 SAY STR(FF(I,5),3)
   I = I + 1
   PROW = PROW + 1
ENDDO

rownum = 4
win_bot = 13
N = FCOUNT()
keycode = 0
I = 1
SET COLOR TO N/W
@ 22, 0 CLEAR TO 24,80
@ 23, 2 SAY "íⁿí²PgUp PgDn ╤í╘±╫╓╢╬   [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)
@ 4,55 SAY STR(FF(I,5),3)
? SYS(2002)
DO WHILE .T.
   IF keycode = 27 .OR. keycode = 6 && [End].or.[Esc]
      endswitch = .F.
      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
         @ 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, 55 SAY STR(FF(I,5),3)
         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)
         @ rownum, 55 SAY STR(FF(I,5),3)
      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, 55 SAY STR(FF(I,5),3)
         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)
         @ rownum, 55 SAY STR(FF(I,5),3)
      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)
         @ rownum, 55 SAY STR(FF(I,5),3)
         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)
         @ rownum, 55 SAY STR(FF(I,5),3)
      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, 55 SAY STR(FF(I,5),3)
         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)
         @ rownum, 55 SAY STR(FF(I,5),3)
      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)
      @ rownum, 55 SAY STR(FF(I,5),3)
      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)
            @ rownum, 55 SAY STR(FF(I,5),3)
            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)
      @ rownum, 55 SAY STR(FF(I,5),3)
   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)
      @ rownum, 55 SAY STR(FF(I,5),3)
      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)
            @ rownum, 55 SAY STR(FF(I,5),3)
            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)
      @ rownum, 55 SAY STR(FF(I,5),3)
   CASE keycode = 13
      fieldname = FF(I,3)
      fieldexpr = fieldexpr + FF(I,3)
      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


PROC ptj
llnkey=0
DO WHILE .T.
   DO pwaitkey WITH '0.═╦│÷  1.╤í╘±╠⌡╝■═│╝╞  2.╤í╘±╚½▓┐═│╝╞ ',llnkey
   DO CASE
   CASE llnkey= 0
      RETURN
   CASE llnkey = 1
      DO WHILE endswitch
         DO pgettj
      ENDDO
      DO pgetlast
      LOOP
   CASE llnkey = 2
      DO pgetlast
      LOOP
   ENDCASE
ENDDO
RETURN


PROC pgetlast
tjdbf=''
PRIV lat lag lad
DO pprompt WITH '╒²╘┌═│╝╞, ╟δ╔╘║≥.......'
IF LEN(fsum+favg)=0
   RETURN
ENDIF

lflist=fsum+favg
IF LEN(lflist)=0
   RETURN
ENDIF
llnmax=FCOUNT(1)
DIME lad(llnmax)
DIME lap(llnmax)
llnmax=LEN(lflist)+1
DIME lat(llnmax)
DIME lag(llnmax)
lagi=0
DO pgentjk

SELE 3
GO TOP
SELE 1
GO TOP
DO WHIL .NOT.EOF()
   STOR '' TO lnew,lold
   lat(1)=0
   lfirst=.T.
   SCAT TO lad
   I=2
   IF LEN(TRIM(fieldexpr))>0
      LOCA FOR &fieldexpr
      DO WHIL .NOT.EOF().AND.lnew=lold
         lat(1)=lat(1)+1
         lold=lnew
         DO WHILE I<=lagi
            IF FF(lag(I-1),6)
               lat(I)=IIF(lfirst,lad(lag(I-1)),lat(I)+lad(lag(I-1)))
               I=I+1
            ENDIF
            IF I<=lagi .AND. FF(lag(I-1),7)
               lat(I)=IIF(lfirst,0,lat(I)*(lat(1)-1))
               lat(I)=IIF(lfirst,lad(lag(I-1)),lat(I)+lad(lag(I-1)))/lat(1)
               I=I+1
            ENDIF
         ENDDO
         lfirst=.F.
         CONTINUE
         SCAT TO lad
         lnew=''
         I=2
      ENDDO
      SELE 3
      APPE BLAN
      GATH FROM lat
      SELE 1
   ELSE
      DO WHIL .NOT.EOF().AND.lnew=lold
         lat(1)=lat(1)+1
         lold=lnew
         DO WHILE I<=lagi
            IF FF(lag(I-1),6)
               lat(I)=IIF(lfirst,lad(lag(I-1)),lat(I)+lad(lag(I-1)))
               I=I+1
            ENDIF
            IF I<=lagi .AND. FF(lag(I-1),7)
               lat(I)=IIF(lfirst,0,lat(I)*(lat(1)-1))
               lat(I)=IIF(lfirst,lad(lag(I-1)),lat(I)+lad(lag(I-1)))/lat(1)
               I=I+1
            ENDIF
         ENDDO
         lfirst=.F.
         SKIP
         SCAT TO lad
         lnew=''
         I=2
      ENDDO
      SELE 3
      APPE BLAN
      GATH FROM lat
      SELE 1
   ENDIF
ENDDO
lnkey=0
DO WHIL .T.
   SELE 1
   DO pwaitkey WITH '0.═╦│÷  1.Σ»└└═│╝╞╜ß╣√  2.┤≥╙í═│╝╞╜ß╣√  3.▒ú┤µ▓ó═╦│÷ ',lnkey
   SELE 3
   DO CASE
   CASE lnkey=1
      IF EOF()
         GO TOP
      ENDIF
      SET COLOR TO W/B,B/W
      BROW NOMO NOAP
      LOOP
   CASE lnkey=2
      DO plist
      LOOP
   CASE lnkey=3
      USE
      temf1=''
      DO pgettemf WITH temf1
      temf1=temf1+'.DRT'
      RENAME tjdbf TO &temf1
      DO pprompt WITH '╟δ╕°╢¿╕├═│╝╞╜ß╣√╥╗╕÷├√│╞'
      ACCEPT "╕├═│╝╞╜ß╣√├√│╞╬¬:" TO pname
      SELE 1
      USE &dbftj
      I = 1
      fieldnum = FCOUNT()
      DO WHILE I <= fieldnum
         FF(I,2) = .F.
         I = I + 1
      ENDDO
      fieldexpr=''
      RENAME &temf1 TO &pname
   CASE lnkey=0
      USE
      ERASE D:\fox21\tjdbf.dbf
      SELE 1
      USE &dbftj
      I = 1
      fieldnum = FCOUNT()
      DO WHILE I <= fieldnum
         FF(I,2) = .F.
         I = I + 1
      ENDDO
      fieldexpr=''
   ENDCASE
   SELE 1
   EXIT
ENDDO

RETURN


PROC pgentjk
SELE 1
USE &dbftj
COPY STRU EXTE TO tjdbf1
lcount=LEN(LTRIM(STR(RECCOUNT())))
SELE 3
USE tjdbf1
COPY STRU TO tjdbf2
GO TOP
SELE 4
USE tjdbf2
GO TOP
APPE BLAN
REPL field_name WITH '╝╟┬╝╕÷╩²',field_type WITH 'N',field_len WITH lcount
SELE 3
I=1
lagi=1
SELE 3
GO TOP
xstr=','
DO WHIL .NOT.EOF()
   lrecno=RECNO()
   lflen=field_len
   lfdec=field_dec
   lfname=TRIM(field_name)
   lftype=field_type
   SELE 4
   IF FF(lrecno,6)
      IF LEN(TRIM(FF(lrecno,1)))<=6
         lfname=TRIM(FF(lrecno,1))+'╫▄╝╞'
      ELSE
         lfname=LEFT(FF(lrecno,1)+'    ',8)+'╝╞'
      ENDIF
      IF .NOT.','+lfname+','$xstr
         lag(lagi)=lrecno
         lagi=lagi+1
         APPE BLAN
         REPL field_name WITH lfname,field_type WITH 'N',;
            field_len WITH MIN(lcount+lflen,15),field_dec WITH lfdec
         xstr=xstr+lfname+','
      ENDIF
   ENDIF

   IF FF(lrecno,7)
      IF LEN(TRIM(FF(lrecno,1)))<=6
         lfname=TRIM(FF(lrecno,1))+'╞╜╛∙'
      ELSE
         lfname=LEFT(FF(lrecno,1)+'    ',8)+'╛∙'
      ENDIF
      IF .NOT.','+lfname+','$xstr
         lag(lagi)=lrecno
         lagi=lagi+1
         APPE BLAN
         REPL field_name WITH lfname,field_type WITH 'N',;
            field_len WITH lflen,field_dec WITH lfdec
         xstr=xstr+lfname+','
      ENDIF
   ENDIF
   SELE 3
   SKIP
ENDDO
SELE 3
USE
ERASE tjdbf1.dbf
SELE 4
USE
SELE 3
CREA tjdbf.dbf FROM tjdbf2.dbf EXTE
ERASE tjdbf2.dbf
USE tjdbf.dbf
SCAT TO lat
RETURN


PROC pgettemf
PARA xtemf
IF '*'$dbcx
   dbcx='1'
ENDIF
xtemf=RIGHT('00000000'+LTRIM(STR(VAL(dbcx)+1)),8)
DO WHIL FILE(xtemf+'.DRT').OR.FILE(xtemf+'.DBF')
   dbcx=xtemf
   xtemf=RIGHT('00000000'+LTRIM(STR(VAL(dbcx)+1)),8)
ENDDO
RETURN


PROC pwaitkey
PARA xcprompt,xnin
xnin=xnin+1
SET COLO TO N/GB
@24,0 SAY SPACE(80)
xsprompt=xcprompt
@24,0 SAY '╟δ╤í╘±--'
xncol=8
DO WHIL ' '$xsprompt
   @24,xncol PROMPT LEFT(xsprompt,AT(' ',xsprompt))
   xncol=xncol+AT(' ',xsprompt)
   xsprompt=LTRIM(SUBSTR(xsprompt,AT(' ',xsprompt)))
ENDDO
MENU TO xnin
IF xnin>0
   xnin=xnin-1
ENDIF
@24,0 SAY SPACE(80)
RETURN


PROC pprompt
PARA xcprompt
SET COLO TO &&PromptAtr
@24,0 SAY SPACE(80)
@24,0 SAY xcprompt
RETURN


PROC pwait
PARA xswarn
SET COLO TO &&PromptAtr
DO WHIL INKEY(10)=0
ENDDO
@24,0 SAY SPACE(80)
@24,0 SAY xswarn+'  ╚╬╟├╥╗╝ⁿ' PICT '@S80'
xntemp=INKEY(10)
@24,0 SAY SPACE(80)
RETURN


PROC pwarn
PARA xswarn
SET COLO TO &&PromptAtr
@22,0 SAY ''
?CHR(7)+CHR(7)
@24,0 SAY SPACE(80)
@24,0 SAY xswarn+'  í√⌐╝' PICT '@S78'
xntemp=INKEY(10)
@24,0 SAY SPACE(80)
RETURN


PROC plist
GO TOP
IF EOF()
   RETURN
ENDIF
p_page=RECCOUNT()/66+1
p_width=RECSIZE()+FCOUNT()
IF p_width<110
   p_width=1
ELSE
   p_width=0
ENDIF
IF fprnon(p_width,p_page)
   SET CONS OFF
   LIST TO PRIN
   SET CONS ON
ENDIF
RETURN


PROC fprnon
PARA x_zx,x_page     &&╓╜╨═(0┐φ,1╒¡), ╥│╩²
as=IIF(x_page>0,LTRIM(STR(x_page))+'╥│','')
as='╨Φ'+as+IIF(x_zx>0,'╒¡','┐φ')+'╨╨╓╜, ╟δ░┤╥¬╟≤╜½┤≥╙í╗·╫╝▒╕║├'
alok=.F.
DO pprompt WITH as

DO WHIL .T.
   DO pwait WITH as
   IF SYS(13)='OFFLINE'
      DO pprompt WITH '┤≥╙í╗·╬┤╫╝▒╕║├,   Esc═╦│÷┤≥╙í'
      IF INKEY(10)=27
         EXIT
      ENDIF
   ELSE
      alok=.T.
      as=IIF(x_page>0,LTRIM(STR(x_page))+'╥│','')
      as='╙╨'+as+',  ╒²╘┌┤≥╙í, ╟δ╔╘║≥....'
      DO pprompt WITH as
      EXIT
   ENDIF
ENDDO
RETURN alok
<< end >>
<<* EOF: SSBSTATI.INC *>>