Liren Large Software Subsidy 6/06.iso/b/b007/2.ddi/AMISG/DBC5.PRG

Text File | 1990-05-26 | 2.5 KB | 180 lines

****** DBC5.PRG ******
****** DO DBC5  ******
****** PARA FN  ******
IF TYPE('FN')='U'
FN=''
FNO=''
CFN=''
DO SELEF
IF LEN(FN)=0
RETU
ENDIF
ENDIF
EXP1='.T.'
EXP='.T.'
DO DBFEXP
SET SCOR OFF
@ 0,0 SAY '╓╕╢¿╖╓└α╣╪╝ⁿ╫╓!!!'
FD=''
CFD=''
FDN=''
DO SELEFD
*/╗π╫▄╫╓╢╬╬≈╬─├√▒φ/*
FL=''
*/╗π╫▄╫╓╢╬║║╫╓├√▒φ/*
FL1=''
*/╗π╫▄╫╓╢╬╕÷╩²/*
FLN=0
*/╗π╫▄╫╓╢╬╨≥║┼▒φ/*
LM0=''
DO DBFL WITH FN,FL,FL1,FLN,LM0
IF FLN=0
RETU
ENDIF
K=1
FL3=''
FL2=''
DO WHILE K<=FLN
IF K<10
I=STR(K,1)
ELSE
I=STR(K,2)
ENDIF
FL3=FL3+'PJ&I'+','
FL2=FL2+"ZH&I"+","
K=K+1
ENDDO
FL2=SUBSTR(FL2,1,LEN(FL2)-1)
FL3=SUBSTR(FL3,1,LEN(FL3)-1)
USE &FN
SUM &FL TO &FL2 FOR &EXP
AVER &FL TO &FL3 FOR &EXP
COUN TO NUM FOR &EXP
INDE ON &FD TO A_B_C
TOTAL ON &FD FIELDS &FL TO A_B_C
USE A_B_C
INDE ON &FD TO A_B_C
USE
IF FILE('A_B_C.1')
ERAS A_B_C.1
ENDIF
RENA &FN..DBF TO A_B_C.1
RENA A_B_C.DBF TO &FN..DBF
CLEAR
N=6
DO WHILE .T.
? "┬·╫π╠⌡╝■:&EXP1 ╡─╝╟┬╝╩²╬¬"+STR(NUM,4)
CF=FL1+' '
LN=FLN
M=1
DO WHILE .T.
L1='⌐░⌐ñ⌐ñ⌐ñ'
L2='⌐ª═│╝╞└╕'
L3='⌐└⌐ñ⌐ñ⌐ñ'
L4='⌐ª ╫▄║═ '
L6='⌐ª ╞╜╛∙ '
L5='⌐╕⌐ñ⌐ñ⌐ñ'
IF LN<N
N1=LN
ELSE
N1=N
ENDIF
LN=LN-N
J=1
DO WHILE J<=N1
IF M<10
I=STR(M,1)
ELSE
I=STR(M,2)
ENDIF
CC=SUBSTR(CF,1,14)
N2=LEN(TRIM(CC))
K=0
NN=ZH&I
DO WHILE NN>1
NN=NN/10
K=K+1
ENDDO
IF N2<=8
N2=8
ENDIF
N3=0
IF N2<K+3
N3=K+3-N2
ENDIF
IF N2/2<>INT(N2/2)
N2=N2+1
ENDIF
N3=0
IF N2<K+3
N3=K+3-N2
ENDIF
IF N3/2#INT(N3/2)
N3=N3+1
ENDIF
L1=L1+SUBS('⌐╨⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L2=L2+'⌐ª'+SPACE(N3)+SUBSTR(CF,1,N2)
L3=L3+SUBS('⌐α⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L4=L4+'⌐ª'+STR(ZH&I,N2+N3,2)
L5=L5+SUBS('⌐╪⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L6=L6+'⌐ª'+STR(PJ&I,N2+N3,2)
CF=SUBSTR(CF,16)
*ENDIF
M=M+1
J=J+1
ENDDO
? L1+'⌐┤'
? L2+'⌐ª'
? L3+'⌐╚'
? L4+'⌐ª'
? L3+'⌐╚'
? L6+'⌐ª'
? L5+'⌐╝'
IF LN<=0
EXIT
ENDIF
ENDDO
? ' '
SET CONS ON
Y=' '
DO WHILE .NOT.Y$'012'
@ 0,0 SAY '  0-═╦│÷. 1-┤≥╙í. 2-╧╘╩╛. ? ' GET Y
READ
ENDDO
IF Y='0'
EXIT
ENDIF
IF Y='2'
CLEAR
? CFD,FL1
USE &FN
DISP &FD,&FL OFF ALL
USE
LOOP
ENDIF
USE IDX INDE IDX
SEEK FNO
IF .NOT.EOF()
NDX=TRIM(IDX_NAME)
IF FILE('A_B_C.2')
ERAS A_B_C.2
ENDIF
RENA &NDX..IDX TO A_B_C.2
RENA A_B_C.IDX TO &NDX..IDX
ENDIF
USE
DO DBPRINT WITH FN,'.T.',1,CFN+'░┤'+CFD+'╗π╫▄▒φ',FDN+','+LM0,20,1
SET PRINT ON
N=16
ENDDO
SET PRINT OFF
CLOSE DATA
ERAS &FN..DBF
RENA A_B_C.1 TO &FN..DBF
IF FILE('A_B_C.2')
ERAS &NDX..IDX
RENA A_B_C.2 TO &NDX..IDX
ENDIF
RETU
** END OF DBC5.PRG **