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

Text File | 1990-05-30 | 6.0 KB | 363 lines

****** RPTSPM.PRG *****
CLEAR
*/ ╗±╡├▒φ├√ BGM, ▒φ▒α║┼ BNO, ╬─╝■├√ FN. /*
DIME FNA(32)
DIME NDX0(10)
NDX0='0'
BNO=0
BGM=''
FN=''
FNA=0
DO SELEB
IF LEN(FN)=0
RETU
ENDIF
MBTZX=FNA(4)
MBSZX=FNA(5)
KL=1
CLEAR
@ 3,10 SAY '╟δ╩Σ╚δ┤≥╙í╖▌╩²:' GET KL
READ
YN=' '
@ 3,10 SAY '─·╨Φ╥¬╚╖╢¿╩Σ│÷╠⌡╝■┬≡ ? [Y/N]' GET YN
READ
EXP='.T.'
IF UPPE(YN)='Y'
DO DBFEXP
ENDIF
*/ BIAO GE XIAN /*
SELE 1
USE &FN
SET FILT TO &EXP
GO TOP
IF EOF()
@ 3,10 SAY '├╗╙╨┬·╫π╠⌡╝■<&EXP>╡─╝╟┬╝!! ░┤╚╬╥Γ╝ⁿ╘≥╖╡╗╪......'
A=INKEY(5)
USE
RETU
ENDIF
CLOS DATA
SELE 10
USE FFBT
SET FILT TO B_NO=BNO
GO BOTT
SYM3=TRIM(SNA)
SKIP -1
SYM4=TRIM(SNA)
SKIP -1
SYM2=TRIM(SNA)
COUNT TO MXN
MXN=MXN-3
BC2=INT((LEN(SYM2)-LEN(BGM)*2)/4)
*/ ╗±╡├╦≈╥²╝░╢╘ DBD.DBF ┐Γ╣²┬╦ /*
USE FILE INDE FILE
J=1
DIME FNOA(9)
EXP0=''
DO WHILE J<=FNA(6)
SEEK FNA((J-1)*3+8)
FNOA(J)=F_NO
EXP0=EXP0+'.OR.F_NO="'+F_NO+'"'
J=J+1
ENDDO
NDX=TRIM(FNA(7))
USE DBD INDE DBD
SET FILT TO &EXP0
GO TOP
*/
SELE 9
USE BBTK
SET FILT TO B_NO=BNO
GO TOP
*/ ▒φ┐φ SNUM2 /*
SUM FIELD_LEN TO SNUM1
COUNT TO NUM
SNUM2=SNUM1+2*(NUM+1)
*/ ▒φ═╖╖╓╜Γ╙δ┤≥╙í╞≡╩╝╬╗╓├ BC2 /*
BGM=TRIM(BGM)
BC2=INT((SNUM2-LEN(BGM)*2)/4)
HN='⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ⌐Ñ'
HN=HN+HN+HN+HN
IF LEN(BGM)/2=INT(LEN(BGM)/2)
LGM=LEN(BGM)
ELSE
LGM=LEN(BGM)+1
ENDIF
BGM1=SUBSTR(HN,1,LGM+4)
*/ ╔·│╔┤≥╙í╕±╩╜▒Σ┴┐ X[1,N1] /*
CLOS DATA
SELE 10
USE IDX INDE IDX
CLEAR
I=1
DO WHILE M->I<=FNA(6)
QH=SUBS('ABCDEFGHIJ',M->I,1)
SELE &QH
FN=FNA((M->I-1)*3+8)
USE &FN
IF M->I=1
SET INDE TO &NDX
SET FILT TO &EXP
ELSE
IDXEXP=TRIM(FNA((M->I-2)*3+10))
IF LEN(M->IDXEXP)<>0
SELE 10
LOCA FOR F_NO=FNOA(I).AND.IDX_EXP=IDXEXP
IF .NOT.EOF()
NDX1=TRIM(IDX_NAME)
SELE &QH
SET INDE TO &NDX1
ELSE
NDX0(I)=SYS(3)
NDX1=NDX0(I)
SELE &QH
INDE ON &IDXEXP TO &NDX1
ENDIF
ELSE
IDXEXP='RECNO()'
ENDIF
QH0=SUBS('ABCDEFGHIJ',FNA((M->I-2)*3+9),1)
SELE &QH0
SET RELA TO &IDXEXP INTO &QH ADDI
ENDIF
I=M->I+1
ENDDO
SELE 10
USE DBD
SELE 9
USE BBTK
SET FILT TO B_NO=BNO
GO TOP
N1=1
*N2=1
X1="'⌐º'"
X='X1'
LJ='⌐º'
LJBZ=0
HJBZ=0
DO WHILE .NOT.EOF()
IF SUM='1'
FD=TRIM(FIELD_NAME)
SELE 1
SUM &FD TO LJ1 FOR &EXP
SELE 9
LJBZ=1
LJ=LJ+IIF(LJ1=0,SPACE(FIELD_LEN),STR(LJ1,FIELD_LEN,FIELD_DEC))+'⌐ª'
ELSE
IF HJBZ=0.AND.FIELD_TYPE='C'.AND.FIELD_LEN>=4
LJ=LJ+SPACE(INT((FIELD_LEN-4)/3))+'╫▄'+SPACE(FIELD_LEN-4-INT((FIELD_LEN-4)/3)*2)+'╝╞'+SPACE(INT((FIELD_LEN-4)/3))+'⌐ª'
HJBZ=1
ELSE
LJ=LJ+SPACE(FIELD_LEN)+'⌐ª'
ENDIF
ENDIF
RN=TRIM(FIELD_NAME)
RLEN=FIELD_LEN
SELE 10
LOCA FOR TRIM(FIELD_NAME)=SUBS(RN,4).AND.F_NO=FNOA(AT(SUBS(RN,1,1),'ABCDEFGHIJ'))
REN=FIELD_LEN
** DAI MA ZHUAN HUAN DA YIN!!
IF CODE='1'
REN=LEN
ENDIF
** END DAI MA
EY=IIF(RLEN<=REN,0,IIF(REN=0,0,RLEN-REN))
EY1=STR(INT(EY/2),2)
EY2=STR(EY-&EY1,2)
IF BBTK->FIELD_TYPE='N'
RL1=BBTK->FIELD_DEC
&X=&X+'+IIF(&RN.=0,SPACE('+STR(RLEN,2)+'),SPACE(&EY1)+STR('+RN+','+STR(IIF(REN=0,RLEN,REN),2)+','+STR(RL1,1)+')+SPACE(&EY2))'
ELSE
IF BBTK->FIELD_TYPE='D'
RN='DTOC(&RN)'
ELSE
IF BBTK->FIELD_TYPE='L'
RN='IIF(&RN,"T","F")'
ENDIF
ENDIF
IF CODE='1'
NT=TRIM(NOTE)
LL=STR(LEN,2)
RN='SUBS("&NT.",AT(&RN.,"&NT")+2,&LL.)'
ENDIF
&X=&X+'+SPACE(&EY1.)+'+RN+'+SPACE(&EY2.)'
ENDIF
SELE 9
SKIP
IF EOF()
&X=&X+"+'⌐º'"
ELSE
&X=&X+"+'⌐ª'"
ENDIF
N1=N1+1
X='X'+STR(N1,IIF(N1>9,2,1))
&X=""
ENDDO
N1=N1-1
LJ=SUBS(LJ,1,LEN(LJ)-2)+'⌐º'
*/ ┐¬╩╝┤≥╙í /*
SELE 1
COUNT TO RECNUM
SELE 10
IF LJBZ<>0
RECNUM=RECNUM+1
ENDIF
PS=1
BBMC=TRIM(FN)+'_'+STR(BNO,IIF(BNO>9,2,1))
IF LEN(BBMC)<8
BBMC=BBMC+SPACE(8-LEN(BBMC))
ENDIF
LINE=1
CLEAR
UD=1
HJJ=-2
YH='1'
@ 2,4 TO 9,75 DOUB
@ 1,6 SAY "╩Σ│÷╠⌡╝■╬¬:&EXP."
@ 3,6 SAY '▒Ω╠Γ╫╓╨═:' GET MBTZX PICT '!' VALID MBTZX$'ABCD'
@ 3,COL()+1 SAY '▒φ╠σ╫╓╨═:' GET MBSZX PICT '!' VALID MBTZX$'ABCD'
@ 3,COL()+1 SAY '╨╨╝Σ╛α:[-4,2]:' GET HJJ PICT '99' RANG -4,2
@ 3,COL()+1 SAY '╥│║┼:[1..╥¬ 2..▓╗╥¬]:' GET YH PICT '9' VALID YH$'12'
@ 4,6 SAY '┬·╫π╠⌡╝■╡─╝╟┬╝╩²╬¬['+STR(RECNUM,4)+' ]! ╟δ╩Σ╚δ├┐╥│╘╩╨φ┤≥╙í╡─╝╟┬╝╩²:' GET RECNUM RANG 1,RECNUM
@ 5,6 SAY '  ▒φ║ß╕⌠╧▀╤í╘±:[ 1..┤≥╩╡╧▀ 2..┤≥┐╒╧▀   3..▓╗┤≥╙í    ]:' GET LINE RANG 1,3
@ 6,6 SAY '  ╫▄╝╞╠⌡─┐╬╗╓├:[ 1..╡┌╥╗╠⌡ 2..╫ε║≤╥╗╠⌡ 3..▓╗┤≥╙í    ]:' GET UD RANG 1,3
@ 7,6 SAY '      ┤ª└φ╖╜╩╜:[ 1..┤≥╙í   2..▒ú┤µ     3..┤≥╙í▓ó▒ú┤µ]:' GET PS RANG 1,3
@ 8,6 SAY '           ╚⌠╥¬▒ú┤µ,╘≥╨Φ╩Σ╚δ▒¿▒φ╬─╝■├√:[&BBMC..TXT]:' GET BBMC
READ
CLEAR
@ 3,20 TO 8,50 DOUB
SYM4=IIF(LINE=2,SYM4,SYM2)
IF PS<>2
IF SYS(13)<>'READY'
@ 5,25 SAY '╟δ╫╝▒╕║├┤≥╙í╗·......'
?? CHR(7)+CHR(7)
ENDIF
DO WHILE SYS(13)<>'READY'
ENDDO
@ 5,25 SAY '┐¬╩╝┤≥╙í......      '
SET PRINT ON
ENDIF
IF PS<>1
@ 6,25 SAY '┐¬╩╝▒ú┤µ......      '
IF FILE('&BBMC..TXT')
ERAS &BBMC..TXT
ENDIF
SET ALTE TO &BBMC
SET ALTE ON
ENDIF
SET CONS OFF
DO WHILE KL>0
GO TOP
I=0
PAGE=1
SU=0
BC=0
*/ ┤≥╙í▒φ═╖╙δ├╝╫ó /*
DO RPTMZPT
? SPACE(BC)+SYM2
IF UD=1.AND.LJBZ<>0
I=1
? SPACE(BC)+LJ
SU=SU+1
IF LINE<>3
? SPACE(BC)+SYM4
ENDIF
ENDIF
*/ ┤≥╙í▒φ╠σ /*
SELE 1
GO TOP
DO WHILE .NOT.EOF( )
SELE 10
N2=2
SSM=&X1
Y2='*'
DO WHILE N2<=N1
X='X'+STR(N2,IIF(N2>9,2,1))
Y1=&X
Y1=&Y1
IF LEN(SSM)<100
SSM=SSM+Y1
ELSE
IF TRIM(Y2)='*'
Y2=Y1
ELSE
Y2=Y2+Y1
ENDIF
ENDIF
N2=N2+1
ENDDO
IF TRIM(Y2)='*'
Y2=' '
ENDIF
? SPACE(BC)+SSM+Y2
I=I+1
SU=SU+1
SELE 1
SKIP
IF M->SU>=M->RECNUM .AND. .NOT. EOF()
SELE 10
*/ ╖╓╥│┤ª└φ /*
? SPACE(BC)+SYM3
DO RPTWZPT
IF YH='1'
? SPACE(BC)+SPACE(SNUM2-9)+'╡┌ '+STR(PAGE,2)+' ╥│'
PAGE=PAGE+1
ENDIF
IF SYS(13)='READY'
? CHR(2)
ENDIF
SU=0
BC=1
DO RPTMZPT
? SPACE(BC)+SYM2
ELSE
SELE 1
IF .NOT.EOF( )
SELE 10
IF LINE<>3
? SPACE(BC)+SYM4
ENDIF
ELSE
SELE 10
IF UD=2.AND.LJBZ<>0
IF LINE<>3
? SPACE(BC)+SYM4
ENDIF
? SPACE(BC)+LJ
SU=SU+1
ENDIF
? SPACE(BC)+SYM3
DO RPTWZPT
IF YH='1'
? SPACE(BC+SNUM2-9)+'╡┌ '+STR(PAGE,2)+' ╥│'
ENDIF
ENDIF
ENDIF
SELE 1
ENDDO
IF SYS(13)='READY'
? CHR(2)
ENDIF
SELE 10
KL=KL-1
ENDDO
SET PRINT OFF
CLOS DATA
I=2
DO WHILE I<=FNA(6)
IF LEN(NDX0(I))<>1
NDX1=NDX0(I)
ERAS &NDX1..IDX
ENDIF
I=I+1
ENDDO
SET CONS ON
SET ALTE TO
?? CHR(7)+CHR(7)
@ 5,25 SAY '┤ª└φ═Ω▒╧!!!              '
@ 6,25 SAY SPACE(20)
A=INKEY(5)
RETU
***** END OF RPTSPM.PRG *****