Liren Large Software Subsidy 6/06.iso/b/b077/1.img/SBGL.ZIP/TX.PRG

Text File | 1979-12-31 | 4.9 KB | 244 lines

clear
set talk off
set device to screen
close database
a1=.t.
do while a1
clear
@ 1,5 say "****************************╗¡╓▒╖╜═╝****************************"
@ 2,5 say " ú░ú«═╦│÷                         ú▒ú«╝╞╗«,╣╩╒╧,╩┬╣╩╨▐└φ╣ñ╩▒▒╚╜╧"
@ 3,5 say " ú▓ú«═≥╘¬▓·╓╡╬¼╨▐╖╤╙├┬╩           ú│ú«╩┬╣╩┬╩"
@ 4,5 say " ú┤ú«╣╩╒╧╞╡╢╚                     ú╡ú«╣╩╒╧═ú╗·┬╩"
@ 5,5 say " ú╢ú«╔Φ▒╕┐╔└√╙├┬╩                 ú╖ú«╔Φ▒╕╙╨╨º└√╙├┬╩"
@ 6,5 say " ú╕ú«╓≈╥¬╔Φ▒╕═Ω║├┬╩               ú╣ú«╛½,┤≤,╧í╔Φ▒╕═Ω║├┬╩"
@ 7,5 say " ú┴ú«╝╞╗«ú¼╣╩╒╧ú¼╩┬╣╩╨▐└φ╖╤╙├▒╚╜╧  "
@ 8,5 say "****************************************************************"
wait '     ╟δ╩Σ╚δ╤í╘±║┼(0,1,2,3,4,5,6,7,8,9,a):' to w
set exac off
do case
case w='0'
retu
case w='a'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with '╣╩╒╧,╩┬╣╩,╝╞╗«╨▐└φ╖╤╙├▒╚╜╧'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╖╤╙├'
skip
repl z1 with '╝╞╗«'
skip
repl z1 with '╣╩╒╧'
skip
repl z1 with '╩┬╣╩'
copy to zbmc.txt delimited
use bjb
repl all b8 with val(substr(b7,4,2))
copy to zbsz77.txt for b7=a field b8,b4,b5,b6 delimited
run basica as77
case w='1'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with '╣╩╒╧,╩┬╣╩,╝╞╗«╨▐└φ╣ñ╩▒▒╚╜╧'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╖╤╙├'
skip
repl z1 with '╝╞╗«'
skip
repl z1 with '╣╩╒╧'
skip
repl z1 with '╩┬╣╩'
copy to zbmc.txt delimited
use bjb
repl all b8 with val(substr(b7,4,2))
copy to zbsz77.txt for b7=a field b8,b1,b2,b3 delimited
run basica as77
case w='2'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║"get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬═≥╘¬▓·╓╡╬¼╨▐╖╤╙├┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╖╤╙├┬╩'
copy to zbmc.txt delimited
use fyl index fyl1
repl all f10 with val(substr(f1,4,2))
copy to zbsz99.txt for f1=a field f10,f9 delimited
use zbmc
run basica as99
case w='3'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╩┬╣╩┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╩┬╣╩┬╩'
copy to zbmc.txt delimited
use ysg
repl all y9 with val(substr(y1,4,2))
repl all y8 with y2*100/y7
copy to zbsz99.txt for y1=a field y9,y8 delimited
run basica as99
case w='4'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'╕≈╘┬╣╩╒╧╞╡╢╚'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╣╩╒╧╞╡╢╚'
copy to zbmc.txt delimited
use ygz
repl all g12 with val(substr(g1,4,2))
repl all g13 with g2/g5
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
case w='5'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╣╩╒╧═ú╗·┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '╣╩╒╧═ú╗·┬╩'
copy to zbmc.txt delimited
use ygz
repl all g12 with val(substr(g1,4,2))
repl all g13 with g3/(g3+g6)*100 for g6<>0
repl all g13 with 0 for g3+g6=0
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
case w='6'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╔Φ▒╕┐╔└√╙├┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '┐╔└√╙├┬╩'
copy to zbmc.txt delimited
close database
sele 1
use ysg
sele 2
use ygz
do while .not. eof()
d=g1
sele 1
loca for y1=d
e=y3
sele 2
repl g14 with e
skip
enddo
repl all g12 with val(substr(g1,4,2))
repl all g13 with (g7-g3-g4-g14)/g7*100 for g7<>0
repl all g13 with 100 for g7=0
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
case w='7'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╔Φ▒╕╙╨╨º└√╙├┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '└√╙├┬╩'
copy to zbmc.txt delimited
close database
sele 1
use ysg
sele 2
use ygz
do while .not. eof()
d=g1
sele 1
loca for y1=d
e=y3
sele 2
repl g14 with e
skip
enddo
repl all g12 with val(substr(g1,4,2))
repl all g13 with g6/(g6+g3+g4+g14)*100 for g3+g4+g14<>0
repl all g13 with 100 for g6+g3+g4+g14=0
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
case w='8'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╓≈╥¬╔Φ▒╕═Ω║├┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '═Ω║├┬╩'
copy to zbmc.txt delimited
use ygz
repl all g12 with val(substr(g1,4,2))
repl all g13 with g9/g8*100 for g8<>0
repl all g13 with 100 for g8=0
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
case w='9'
clear
a='  '
@ 4,20 say "╟δ╩Σ╚δ─Ω╖▌ú║" get a pict '99'
read
use zbmc
goto 1
repl z1 with a+'─Ω╕≈╘┬╛½┤≤╧í╔Φ▒╕═Ω║├┬╩'
skip
repl z1 with '╘┬╖▌'
skip
repl z1 with '═Ω║├┬╩'
copy to zbmc.txt delimited
use ygz
repl all g12 with val(substr(g1,4,2))
repl all g13 with g11/g10*100 for g10<>0
copy to zbsz99.txt for g1=a field g12,g13 delimited
run basica as99
endcase
enddo
retu