home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b007 / 2.ddi / AMISG / DBC2.PRG < prev    next >
Encoding:
Text File  |  1990-05-23  |  1.4 KB  |  108 lines
  1. ****** DBC2.PRG ******
  2. ****** DO DBC2  ******
  3. ****** PARA FN  ******
  4. IF TYPE('FN')='U'
  5. STOR '' TO FN,FNO,CFN
  6. DO SELEF
  7. ENDIF
  8. EXP1='.T.'
  9. EXP='.T.'
  10. DO DBFEXP
  11. FL=''
  12. FL1=''
  13. FLN=0
  14. LM0=''
  15. DO DBFL WITH FN,FL,FL1,FLN,LM0
  16. IF FLN=0
  17. RETU
  18. ENDIF
  19. K=1
  20. FL2=""
  21. DO WHILE K<=FLN
  22. IF K<10
  23. I=STR(K,1)
  24. ELSE
  25. I=STR(K,2)
  26. ENDIF
  27. FL2=FL2+"C&I"+","
  28. K=K+1
  29. ENDDO
  30. FL2=SUBSTR(FL2,1,LEN(FL2)-1)
  31. USE &FN
  32. IF LEN(FL)<>0
  33. SUM &FL TO &FL2 FOR &EXP
  34. ENDIF
  35. COUN TO NUM FOR &EXP
  36. USE
  37. CLEAR
  38. N=6
  39. DO WHILE .T.
  40. ? "┬·╫π╠⌡╝■:&EXP1 ╡─╝╟┬╝╩²╬¬"+STR(NUM,4)
  41. CF=FL1+'  '
  42. LN=FLN
  43. M=1
  44. DO WHILE .T.
  45. L1='⌐░⌐ñ⌐ñ⌐ñ'
  46. L2='⌐ª═│╝╞└╕'
  47. L3='⌐└⌐ñ⌐ñ⌐ñ'
  48. L4='⌐ª ╫▄║═ '
  49. L5='⌐╕⌐ñ⌐ñ⌐ñ'
  50. IF LN<N
  51. N1=LN
  52. ELSE
  53. N1=N
  54. ENDIF
  55. LN=LN-N
  56. J=1
  57. DO WHILE J<=N1
  58. IF M<10
  59. I=STR(M,1)
  60. ELSE
  61. I=STR(M,2)
  62. ENDIF
  63. CC=SUBSTR(CF,1,14)
  64. N2=LEN(TRIM(CC))
  65. IF N2/2.0<>INT(N2/2)
  66. N2=N2+1
  67. ENDIF
  68. IF N2<=8
  69. N2=8
  70. ENDIF
  71. L1=L1+SUBS('⌐╨⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+2)
  72. L2=L2+'⌐ª'+SUBSTR(CF,1,N2)
  73. L3=L3+SUBS('⌐α⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+2)
  74. L4=L4+'⌐ª'+STR(C&I,N2,2)
  75. L5=L5+SUBS('⌐╪⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+2)
  76. CF=SUBSTR(CF,16)
  77. M=M+1
  78. J=J+1
  79. ENDDO
  80. ? L1+'⌐┤'
  81. ? L2+'⌐ª'
  82. ? L3+'⌐╚'
  83. ? L4+'⌐ª'
  84. ? L5+'⌐╝'
  85. IF LN<=0
  86. EXIT
  87. ENDIF
  88. ENDDO
  89. ? ' '
  90. SET CONS ON
  91. YN=' '
  92. DO WHILE .NOT.YN$'YN'
  93. @ 0,0 SAY '╥¬┤≥╙í┬≡?[Y/N]' GET YN PICT '!'
  94. READ
  95. ENDDO
  96. IF YN="N"
  97. SET PRINT OFF
  98. EXIT
  99. ENDIF
  100. SET PRINT ON
  101. SET CONS OFF
  102. N=16
  103. ENDDO
  104. SET PRINT OFF
  105. CLOSE DATA
  106. RETU
  107. ** END OF DBC2.PRG **
  108.