home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b077 / 1.img / SBGL.ZIP / YH2.PRG < prev    next >
Encoding:
Text File  |  1980-01-01  |  1.9 KB  |  120 lines
  1. clear
  2. set talk off
  3. set device to screen
  4. close database
  5. sele 6
  6. use fyl
  7. sele 1
  8. use yhf
  9. sele 2
  10. use sb index sb1
  11. sele 3
  12. use yh
  13. sele 4
  14. use sm
  15. sele 5
  16. use gzl1 index gzl11
  17. a2=.t.
  18. do while a2
  19. k1='        '
  20. k2='         '
  21. k3='    '
  22. k14='        '
  23. k4='          '
  24. k5='          '
  25. k6='          '
  26. k7='          '
  27. k8='          '
  28. k15='          '
  29. kk1='                              '
  30. a1=.t.
  31. do while a1
  32. clear
  33. @ 0,1 say "╣ñ╫≈┴ε║┼" get k15 pict '##########'
  34. @ 1,1 say "╔Φ▒╕▒α║┼" get k2   
  35. @ 2,1 say "╚≤╗¼╡π▒α║┼" get k3    
  36. @ 3,1 say "╗╗╙═╚╒╞┌" get k14 pict '99.99.99'
  37. do dq5.fmt
  38. @ 0,32 say "╢╘╥╘║≤╬¼╨▐╡─╜¿╥Θ" get kk1
  39. read
  40. @ 8,40 clear
  41. wait '╩²╛▌╒²╚╖ú┌ú¼╫≈╖╧ú╞ú¼╓╪╨▐╕─ú╪ú¼╖╡╗╪ú╥ú║' to w
  42. do case 
  43. case w='f'
  44. exit
  45. case w='x'
  46. loop
  47. case w='r'
  48. clos data
  49. retu
  50. case w='z'
  51. sele 1  
  52. k15=val(k15)
  53. a=substr(k14,4,2)
  54. b=substr(k14,7,2)
  55. c=substr(k14,1,2)
  56. k14=a+'/'+b+'/'+c
  57. k14=ctod(k14)
  58. loca for k2=yhf1 .and. k3=yhf2
  59. if eof()
  60. sele 2
  61. seek k2
  62. q1=sb4
  63. do case 
  64. case sb33=1
  65. q2=7.5
  66. case sb33=3
  67. q2=24
  68. otherwise
  69. q2=15.5
  70. endcase
  71. sele 3
  72. loca for q1=yh1 .and. k3=yh2
  73. q2=q2*yh12
  74. pp=yh12
  75. sele 1
  76. appe blank
  77. repl yhf1 with k2,yhf2 with k3,yhf3 with k14,yhf5 with 0,yhf4 with ì
  78. q2,yhf6 with pp
  79. else
  80. repl yhf3 with k14,yhf5 with 0 
  81. endif
  82. k4=val(k4)
  83. k5=val(k5)
  84. k6=val(k6)
  85. k7=val(k7)
  86. k8=val(k8)
  87. sele 4
  88. loca for sm1=k2
  89. repl sm8 with sm8+k4+k5+k6+k7+k8
  90. sele 5               
  91. seek k5
  92. repl gzl1a with 'y',gzl1d with k4+k5+k6+k7+k8,gzl1e with kk1
  93. p1=c+'.'+a 
  94. sele 6
  95. loca for f1=p1
  96. if .not. eof()
  97. repl f3 with f3+k4+k5+k6+k7+k8,f4 with f4+k4,f5 with f5+k5,f6 with ì
  98. f6+k6,f7 with f7+k7,f8 with f8+k8
  99. else
  100. appe blank
  101. repl f1 with p1,f3 with k4+k5+k6+k7+k8,f4 with k4,f5 with k5,f6 ì
  102. with k6,f7 with k7,f8 with k8
  103. endif
  104. otherwise 
  105. loop
  106. endcase 
  107. exit
  108. enddo a1
  109. clear
  110. wait '╗╣╩Σ╚δ┬≡(y/n) ' to w
  111. if w='y'
  112. a2=.t.
  113. else
  114. clos data
  115. retu
  116. endif
  117. enddo a2
  118. retu
  119.  
  120.