home *** CD-ROM | disk | FTP | other *** search
/ Phoenix Heaven Sunny 2 / APPARE2.BIN / oh_towns / kakeibo / kakeibo.bas next >
BASIC Source File  |  1995-06-20  |  244KB  |  6,646 lines
  1. 100 '----------------------------家計簿----------by 94.9.1 ------------
  2. 105 'kakeibo.bas  V1.0 L10
  3. 110 '
  4. 115 *初期設定
  5. 120  CLEAR ,,1024,1300*1000
  6. 125  GOSUB *CNF_SETUP      :VAR$="KAKEIBO.BAS V1.0 L10"
  7. 130  DIM CALE%(INT((141*83+2-1))/2),MONT(12),YOBI$(6)        :'ｶﾚﾝﾀﾞｰ
  8. 135  DIM MXY(20,3),PXY(20,3)                                 :'ﾏｳｽｲﾁﾊﾝﾃｲ
  9. 140  DIM MEMO$(MSX),PAST$(MSX)                               :'ﾒﾓ
  10. 145  DIM KOM$(KSZ),KMT%(KSZ),KMAX(365),ZAN&(366)             :'ﾄｳﾛｸ ｺｳﾓｸ
  11. 150  DIM KIN&(365,NSX),KMI%(365,NSX),KSU%(365,NSX),KNE$(365,NSX) :'ﾉｰﾄ
  12. 155  DIM CORD$(CDX),CORDN%(CDX),CONX(CDZ),COFX$(CDZ),COMX(CDZ)   :'ｺｰﾄﾞ
  13. 160  DIM FSI$(CDX),FSN$(CDX),FSD$(CDX),EDX%(CDZ)             :'ﾌｧｲﾙﾒｲ
  14. 165  DIM BNAME$(26),PAGE1(26),PAGE2(26)                      :'ｷﾞﾝｺｳﾒｲ
  15. 170  DIM BYM$(BNZ),BCD(BNZ),BME$(BNZ),BIN#(BNZ),BOUT#(BNZ)   :'ﾌﾂｳ ﾖｷﾝ
  16. 175  DIM TYD$(TYZ),TYN$(TYZ),TYI#(TYZ),TYK$(TYZ),TYO#(TYZ)   :'ﾃｲｷ ﾖｷﾝ
  17. 180  DIM GKX#(365,KSZ),GKT#(5),GZT%(KSZ,1),GZP%(1),GRPZ#(KSZ,1)  :'ｸﾞﾗﾌ
  18. 185  DIM MAX_O#(12),MAX_I#(12),RFD(10),RFP(10)
  19. 190  DIM RFZ(RJZ,1),RFN$(RJZ),RFK&(RJZ),RFS%(RJZ),RJK(RJZ,5)
  20. 195  DIM PXL%(20),PYL%(20),PXE%(20),PYE%(20)                 :'ｳｲﾝﾄﾞ
  21. 200  DIM XLS(10),XES(10),XFS(10),YLS(10),YES(10),YFS(10),BPS(10),BQS(10)
  22. 205  CXP=INT((658*498+2-1))/2  :CTP=INT((142*152+2-1))/2
  23. 210  CXG=INT((640*480+2-1))/2  :X=INT((303*103+2-1))/2
  24. 215  DIM CPY%(CXP),SCR%(CXP),CALK%(CTP),U%(X)     :'ｽｸﾘｰﾝ
  25. 220  DIM BCL(80)                                  :'ｶﾗｰ
  26. 225  MX1=0   :MY1=0   :MX2=639  :MY2=479  :ERP=0
  27. 230  CORP=0  :CSL8=1  :WAIX=50  :FSW_P=1  :MEMO_X=10
  28. 235  CSP2=1  :CSP5=1  :CSP8=1   :CSPT=1   :CSPB=1     :MOX=1
  29. 240  CSP3=1  :CSP6=1  :KMCJ=1
  30. 245  GX1=1   :GX2=-17 :GY1=17   :GY2=-17  :GZS=1      :SX=1    :SY=1
  31. 250  SCREEN 0 :SCREEN@ 2  :CONSOLE 0,24,2 :CLS
  32. 255  WINDOW (0,0)-(639,479)     :VIEW (0,0)-(639,479),%215
  33. 260  GOSUB *FAST_MESE
  34. 265  ON INTERVAL GOSUB *CLOCK_P :INTERVAL 1
  35. 270  IF GRAP_CSW=1 THEN GOSUB *GRAP_CALK
  36. 275  GOSUB *SET_SCR
  37. 280  GOSUB *MENU1
  38. 285  GOSUB *END_MESE
  39. 290  IF MJ=0 THEN 280
  40. 295  GOSUB *END_SAVE
  41. 300  END
  42. 305 '--------------------------------------------------------------------
  43. 310 *LOAD_MOUSE_DAT
  44. 315  ER=0   :MSLP=0
  45. 320  ON ERROR GOTO *MSL_ERR
  46. 325  OPEN "I",#1,FIL$(5)
  47. 330        INPUT #1,ZF,ZE
  48. 335              FOR A=ZF TO ZE
  49. 340                  FOR B=0 TO 3
  50. 345                      INPUT #1,PXY(A,B)
  51. 350                      IF EOF(1)=-1 THEN *MSL_EBAK
  52. 355                  NEXT B
  53. 360              NEXT A
  54. 365  *MSL_EBAK
  55. 370  ON ERROR GOTO 0
  56. 375  CLOSE #1
  57. 380  IF ER=1 THEN
  58. 385              GOSUB *SAVE_MOUSE_DAT
  59. 390              IF ER=0 THEN *LOAD_MOUSE_DAT
  60. 395              MSLP=1
  61. 400          ENDIF
  62. 405  *MSL_EBAK2
  63. 410  RETURN
  64. 415  '
  65. 420 *MSL_ERR
  66. 425  RESTORE *MXY_DATA1
  67. 430  GOSUB *SET_MD
  68. 435  IF ERR<>63 THEN *ERR_MESE
  69. 440  ER=1
  70. 445  RESUME *MSL_EBAK
  71. 450  '
  72. 455 *SAVE_MOUSE_DAT
  73. 460  ER=0
  74. 465  ON ERROR GOTO *MSS_ERR
  75. 470  OPEN "O",#2,FIL$(5)
  76. 475        PRINT #2,XF,XE
  77. 480              FOR A=XF TO XE
  78. 485                  FOR B=0 TO 3
  79. 490                      PRINT #2,MXY(A,B)
  80. 495                  NEXT B
  81. 500              NEXT A
  82. 505  *MSS_EBAK
  83. 510  ON ERROR GOTO 0
  84. 515  CLOSE #2
  85. 520  RETURN
  86. 525  '
  87. 530 *MSS_ERR
  88. 535  IF ERR<>64 THEN *ERR_MESE
  89. 540  KILL FIL$(5)
  90. 545  RESUME
  91. 550  '
  92. 555 *SWAP_MD
  93. 560  IF MSLP=1 THEN RESTORE *MXY_DATA1 :GOTO *SET_MD
  94. 565  XF=ZF  :XE=ZE
  95. 570  FOR A=ZF TO ZE
  96. 575      FOR B=0 TO 3
  97. 580          MXY(A,B)=PXY(A,B)
  98. 585      NEXT B
  99. 590  NEXT A
  100. 595  RETURN
  101. 600  '
  102. 605 *SET_MD
  103. 610  READ XF,XE
  104. 615  FOR A=XF TO XE
  105. 620     FOR B=0 TO 3
  106. 625         READ MXY(A,B)
  107. 630     NEXT B
  108. 635  NEXT A
  109. 640  RETURN
  110. 645 '
  111. 650 '
  112. 655 *MXY_DATA1
  113. 660  DATA 0,9                :'ﾏｳｽ ｲﾁﾊﾝﾃｲ ﾃﾞｰﾀ
  114. 665  DATA 30 ,20 ,170,140    :'ｶﾚﾝﾀﾞｰ
  115. 670  DATA 220,20 ,340,140    :'ﾌｧｲﾙ
  116. 675  DATA 390,20 ,498,140    :'ｸﾞﾗﾌ a
  117. 680  DATA 500,20 ,610,140    :'ﾒﾓ
  118. 685  DATA 30 ,170,240,450    :'ﾉｰﾄ1
  119. 690  DATA 241,170,440,450    :'ﾉｰﾄ2
  120. 695  DATA 470,200,610,340    :'計算機
  121. 700  DATA 470,360,540,450    :'商品ｺｰﾄﾞ
  122. 705  DATA 550,360,610,450    :'通帳
  123. 710  DATA 620,430,635,450    :'end
  124. 715 '
  125. 720 *SET_CALKTIF
  126. 725  LOAD@ FIL$(4),CALK%
  127. 730  RETURN
  128. 735 '
  129. 740 *SET_UPFIL
  130. 745  IF FOX>0 AND SET_FX>0 THEN
  131. 750                             FOXP=SET_FX
  132. 755                             XL=MPXL+10  :YL=MPYL+60
  133. 760                             A$="家計簿データ読み込み中"
  134. 765                             LINE (XL,YL)-STEP(LEN(A$)*8,16),                                                  PSET,%BCL(10),BF
  135. 770                             SYMBOL(XL,YL),A$,1,1,%0
  136. 775                             GOSUB *FILD_LOAD
  137. 780                             FSW_P=0
  138. 785                        ENDIF
  139. 790  RETURN
  140. 795 '
  141. 800 *YOBID_SET
  142. 805  RESTORE *YOBI_DAT
  143. 810  FOR A=0 TO 6
  144. 815     READ YOBI$(A)
  145. 820  NEXT A
  146. 825  RETURN
  147. 830 '
  148. 835 *YOBI_DAT
  149. 840  DATA 日,月,火,水,木,金,土
  150. 845  '
  151. 850 *END_LOAD
  152. 855  F$=FIL$(6)
  153. 860  ON ERROR GOTO *ERR_ENDL
  154. 865  OPEN "I",#1,F$
  155. 870       INPUT #1,MOX,CSP4S
  156. 875       INPUT #1,BANKP,CSPBS,CSPTS
  157. 880       INPUT #1,PDF,PDE,GXY,GZY,GXM,GZM,GXD,GZD
  158. 885       INPUT #1,GZS,GX2,GY2,SX,SY,GRAP_SW,GRAP_CSW
  159. 890       INPUT #1,RSX,RKML
  160. 895       FOR A=0 TO 13
  161. 900           INPUT #1,PXL%(A),PYL%(A),PXE%(A),PYE%(A)
  162. 905       NEXT A
  163. 910       INPUT #1,NEXP
  164. 915       FOR A=0 TO NEXP
  165. 920             INPUT #1,XLS(A),XES(A),XFS(A),YLS(A)
  166. 925             INPUT #1,YES(A),YFS(A),BPS(A),BQS(A)
  167. 930       NEXT A
  168. 935 *ENDL_RET
  169. 940  CLOSE #1
  170. 945  ON ERROR GOTO 0
  171. 950  IF CSP4S=0 THEN CSP4S=1
  172. 955  IF CSPBS=0 THEN CSPBS=1
  173. 960  IF CSPTS=0 THEN CSPTS=1
  174. 965  GOSUB *MEMO_LOAD  :CSP4=CSP4S
  175. 970  IF BANKP>0 THEN
  176. 975                  GOSUB *BANK_DLOAD  :GOSUB *TEIKI_LOAD
  177. 980                  CSPB=CSPBS         :CSPT=CSPTS
  178. 985             ENDIF
  179. 990  RETURN
  180. 995 '
  181. 1000 *ERR_ENDL
  182. 1005  IF ERR<>63 THEN *ERR_MESE
  183. 1010  GOSUB  *SET_PXL
  184. 1015  RESUME *ENDL_RET
  185. 1020 '
  186. 1025 *END_SAVE
  187. 1030  F$=FIL$(6)
  188. 1035  ON ERROR GOTO *ERR_ENDS
  189. 1040  OPEN "O",#1,F$
  190. 1045       PRINT #1,MOX,CSP4
  191. 1050       PRINT #1,BANKP,CSPB,CSPT
  192. 1055       PRINT #1,PDF,PDE,GXY,GZY,GXM,GZM,GXD,GZD
  193. 1060       PRINT #1,GZS,GX2,GY2,SX,SY,GRAP_SW,GRAP_CSW
  194. 1065       PRINT #1,RSX,RKML
  195. 1070       FOR A=0 TO 13
  196. 1075           PRINT #1,PXL%(A),PYL%(A),PXE%(A),PYE%(A)
  197. 1080       NEXT A
  198. 1085       PRINT #1,NEXP
  199. 1090       FOR B=0 TO NEXP
  200. 1095             A=NP(B)
  201. 1100             PRINT #1,XLS(A),XES(A),XFS(A),YLS(A)
  202. 1105             PRINT #1,YES(A),YFS(A),BPS(A),BQS(A)
  203. 1110       NEXT B
  204. 1115 *ENDS_RET
  205. 1120  CLOSE #1
  206. 1125  ON ERROR GOTO 0
  207. 1130  RETURN
  208. 1135 '
  209. 1140 *ERR_ENDS
  210. 1145  IF ERR<>64 THEN *ERR_MESE
  211. 1150  KILL F$
  212. 1155  RESUME
  213. 1160 '
  214. 1165 *SET_BCL
  215. 1170  RESTORE *BCL_DAT
  216. 1175  FOR A=0 TO 29
  217. 1180      READ BCL(A)
  218. 1185  NEXT A
  219. 1190  GOSUB *BCL_LOAD
  220. 1195  RETURN
  221. 1200 '
  222. 1205 *BCL_DAT
  223. 1210  DATA 0,1,2,4,5,6,8,21,3,2,9
  224. 1215  DATA 10,11,13,14,15,16,13,1,2
  225. 1220  DATA 2,20,21,9,27,29,30,1,13,3
  226. 1225 *BCL_DAT2
  227. 1230  DATA 81,179,52,252,182,88,186,46,218,92
  228. 1235  DATA 140,20,188,29,120,163,191,51,195,93
  229. 1240  DATA 220,227,49,95,160,24,222,116,80,190
  230. 1245  DATA 248,178,232,28,61,183,210,56,84,112
  231. 1250  DATA 31,17,184,32,16,131,124,244,242,60,79
  232. 1255 '
  233. 1260 *SET_PXL
  234. 1265  RESTORE *DAT_PXL
  235. 1270  FOR A=0 TO 13
  236. 1275      READ PXL%(A)
  237. 1280      READ PYL%(A)
  238. 1285      READ PXE%(A)
  239. 1290      READ PYE%(A)
  240. 1295  NEXT A
  241. 1300  RETURN
  242. 1305  '
  243. 1310 *DAT_PXL
  244. 1315  DATA 200,200,205,160,170,200,290,150,170,150,340,250
  245. 1320  DATA 170,200,290,150,150,200,360,150,5  ,180,630,250
  246. 1325  DATA 400,200,141,151,200,200,230,160,60 ,180,500,250
  247. 1330  DATA 200,200,210,141,200,200,340,141,200,200,210,141
  248. 1335  DATA 200,200,210,141,80 ,220,520,230
  249. 1340 '
  250. 1345 *SET_RXY
  251. 1350  GOSUB *SET_DP
  252. 1355  YY=PY     :MM=PM
  253. 1360  M=PM      :D=PD    :GOSUB *PDX_SET
  254. 1365  RXD=D     :RXM=M   :RXY=PY
  255. 1370  B=YOBI    :GOSUB *YOBI_P    :DP=C
  256. 1375  RETURN
  257. 1380 '
  258. 1385 *SET_SCR
  259. 1390  GOSUB *SET_RXY
  260. 1395  LOAD@ FIL$(0)  :LINE (0,461)-(639,479),PSET,%BCL(0),BF
  261. 1400  GOSUB *CALEND_DET
  262. 1405  GET@A (0,0)-(639,479),SCR%
  263. 1410  GOSUB *SET_CALENDA_TIF  :RXMS=RXM
  264. 1415  FOR A=0 TO 9  :NP(A)=A  :NEXT A
  265. 1420  RETURN
  266. 1425 '
  267. 1430 *SET_CALENDA_TIF
  268. 1435  F$=FIL$(13)+RIGHT$("0"+MID$(STR$(RXM),2),2)+".tif"
  269. 1440  ON ERROR GOTO *SET_TIF_ERR
  270. 1445     LOAD@ F$,(30,20)
  271. 1450  *SET_TIF_BAK
  272. 1455   ON ERROR GOTO 0
  273. 1460   GET@A (30,20)-(170,101),CALE%
  274. 1465   RETURN
  275. 1470  '
  276. 1475 *SET_TIF_ERR
  277. 1480  RESUME *SET_TIF_BAK
  278. 1485  '
  279. 1490 *CALEND_DET
  280. 1495  X=68 :Y=105 :B=DP :C=1
  281. 1500  SYMBOL(30,105),STR$(PY)+"/"+STR$(PM),.65!,.65!,%BCL(4)
  282. 1505  FOR A=1 TO MONT(RXM)
  283. 1510      IF B=1 THEN CL=BCL(15)   ELSE CL=BCL(0)
  284. 1515      SYMBOL(X,Y),MID$(STR$(A),2),.6!,.7!,%CL
  285. 1520      C=C+1  :IF A=<10 THEN X=X+10     ELSE X=X+12
  286. 1525      IF C>10 THEN
  287. 1530                   C=1
  288. 1535                   IF Y=105    THEN X=39 :Y=Y+12 :GOTO 1550
  289. 1540                   IF Y=105+12 THEN X=33 :Y=Y+12
  290. 1545              ENDIF
  291. 1550      B=B-1 :IF B<0 THEN B=6
  292. 1555  NEXT A
  293. 1560  RETURN
  294. 1565  '
  295. 1570 '--------------------------------------------------------------------
  296. 1575 *MENU1
  297. 1580  MUX=300  :MUY=200
  298. 1585  IF NEXP>0 THEN
  299. 1590                 IF NEXP>1 THEN GOSUB *SCR_SETUP
  300. 1595                 NEXP=NEXP-1   :JP=BPS(NEXP)
  301. 1600                 GOSUB *SWAP_MD
  302. 1605                 GOTO 1650
  303. 1610            ENDIF
  304. 1615  *MENU2
  305. 1620   PUT@A (0,0)-(639,479),SCR%
  306. 1625   IF RXM<>RXMS THEN GOSUB *SET_CALENDA_TIF  :RXMS=RXM                                      ELSE PUT@A (30,20)-(170,101),CALE%
  307. 1630   GOSUB *SWAP_MD :PALETTE 227,[250,200,200]
  308. 1635   GOSUB *SEL_MXY
  309. 1640   IF JP>0 THEN WHILE MOUSE(2,0)=-1  :WEND  :MOUSE 5
  310. 1645   IF ER=1 THEN RETURN
  311. 1650   ON JP GOSUB *CALENDER,*FIL_P ,*GRAH_P,*MEMO_P,*NOTO_R,*NOTO_P,                          *CALK_P  ,*CORD_P,*BANK_P,*RET
  312. 1655   IF JP=10 THEN RETURN
  313. 1660   GOTO  *MENU2
  314. 1665 '--------------------------------------------------------------------
  315. 1670 *SET_DP
  316. 1675  PY=VAL(LEFT$(YM$,2)) :PM=VAL(MID$(YM$,4,2)) :PD=VAL(RIGHT$(YM$,2))
  317. 1680  YOBI=(((PY-84)+INT((PY-84)/4)) MOD 7)
  318. 1685  *SET_DP2
  319. 1690  DP=0  :PDX=0
  320. 1695  RESTORE *YM_DATA
  321. 1700  FOR A=1 TO 12
  322. 1705    READ MONT(A)
  323. 1710  NEXT A
  324. 1715  IF ( PY MOD 4 )=0 THEN  MONT(2)=MONT(2)+1 :URY=1     ELSE  URY=0
  325. 1720  RETURN
  326. 1725 '
  327. 1730 *YM_DATA
  328. 1735  DATA 31,28,31,30,31,30,31,31,30,31,30,31
  329. 1740 '-------------------------------------------------------------------
  330. 1745 *YOBI_P
  331. 1750  A=1  :X=0
  332. 1755  WHILE  A<M  :X=X+MONT(A) :A=A+1 :WEND
  333. 1760  C=7-((X+B-URY) MOD 7)
  334. 1765  RETURN
  335. 1770 '-------------------------------------------------------------------
  336. 1775 *PDX_SET
  337. 1780  PDX=0
  338. 1785  FOR A=1 TO M
  339. 1790      IF A<M THEN PDX=PDX+MONT(A)
  340. 1795  NEXT A
  341. 1800  IF M>2 THEN PDX=PDX+URY
  342. 1805  PDX=PDX+D-1
  343. 1810  RETURN
  344. 1815 '--------------------------------------------------------------------
  345. 1820 *SEL_MXY
  346. 1825  ER=0  :JP=0  :BJP=0
  347. 1830  MOUSE 0
  348. 1835  MOUSE 1,MUX,MUY,1
  349. 1840  MOUSE 4,MX1,MY1,MX2,MY2
  350. 1845  WHILE MOUSE(2,0)=0
  351. 1850    K$=INKEY$
  352. 1855    IF K$<>"" THEN 
  353. 1860       IF ASC(K$)<1 THEN 1850
  354. 1865       IF ASC(K$)>=1 AND ASC(K$)=<10 THEN
  355. 1870            JP=ASC(K$)
  356. 1875            GOTO *RET_SEL
  357. 1880       ENDIF
  358. 1885    ENDIF
  359. 1890    IF BDP=8 THEN
  360. 1895       T=TIME
  361. 1900       IF K$<>"" THEN
  362. 1905                      A$=INKEY$
  363. 1910                      IF A$<>"" THEN
  364. 1915                                     IF A$=CHR$(13) THEN *RET_SEL
  365. 1920                                     K$=K$+A$
  366. 1925                                ENDIF
  367. 1930                      IF TIME<T+4 THEN 1905    ELSE *RET_SEL
  368. 1935                 ENDIF
  369. 1940       ENDIF
  370. 1945    IF BDP=7 THEN 
  371. 1950                  IF K$<>"" THEN GOTO *RET_SEL
  372. 1955             ENDIF
  373. 1960    IF MOUSE (2,1)=-1 THEN
  374. 1965                           MUX=MOUSE(4,1)  :MUY=MOUSE(5,1)
  375. 1970                           ER=1
  376. 1975                           GOTO *RET_SEL2
  377. 1980                      ENDIF
  378. 1985  WEND
  379. 1990  MUX=MOUSE(4,0) :MUY=MOUSE(5,0)
  380. 1995  FOR A=XF TO XE
  381. 2000     IF MUX>MXY(A,0) AND MUX<MXY(A,2) AND MUY>MXY(A,1) AND                          MUY<MXY(A,3) THEN JP=A+1 :GOTO *RET_SEL
  382. 2005  NEXT A
  383. 2010  *RET_SEL2
  384. 2015  WHILE MOUSE(2,0)=-1  :WEND
  385. 2020  WHILE MOUSE(2,1)=-1  :WEND
  386. 2025  MOUSE 5
  387. 2030  *RET_SEL
  388. 2035   RETURN
  389. 2040 '-------------------------------------------------------------------
  390. 2045 *NEX_XY
  391. 2050  NX=NEXP-1
  392. 2055  WHILE  NX>0
  393. 2060         A=NP(NX-1) :GOSUB *SWAP_XY
  394. 2065         GOSUB *SET_XYD
  395. 2070         IF MUX>MXY(11,0) AND MUX<MXY(11,2) AND MUY>MXY(11,1) AND                       MUY<MXY(11,3) THEN JP=BDP :NEXP=NEXP-1 :A=NP(NX-1) :                                           GOSUB *SWAP_XY  :GOTO *RET_NEX2
  396. 2075         A=NP(NX-1) :GOSUB *SWAP_XY  :NX=NX-1
  397. 2080  WEND
  398. 2085  GOSUB *SWAP_MD
  399. 2090  FOR A=XF TO XE
  400. 2095      IF MUX>MXY(A,0) AND MUX<MXY(A,2) AND MUY>MXY(A,1) AND                          MUY<MXY(A,3) THEN JP=A+1 :NX=0 :GOTO *RET_NEX
  401. 2100  NEXT A
  402. 2105  JP=0
  403. 2110  *RET_NEX
  404. 2115   RETURN
  405. 2120 '
  406. 2125 *RET_NEX2
  407. 2130  C=0
  408. 2135  FOR B=0 TO NEXP
  409. 2140      NP(C)=NP(B)
  410. 2145      IF B<>NX-1 THEN C=C+1
  411. 2150  NEXT B
  412. 2155  NP(NEXP)=A
  413. 2160  RETURN
  414. 2165 '
  415. 2170 *NEX_P
  416. 2175  PUT@A (0,0)-(639,479),SCR%
  417. 2180  IF RXM<>RXMS THEN GOSUB *SET_CALENDA_TIF  :RXMS=RXM                                      ELSE PUT@A (30,20)-(170,101),CALE%
  418. 2185  BCL(1)=BCL(11) :BCL(9)=BCL(6) :BCL(17)=BCL(11)  :SKIP=0
  419. 2190  PALETTE 227,[250,200,200]
  420. 2195  FOR NPX=0 TO NEXP-1
  421. 2200      A=NP(NPX)  :GOSUB *SWAP_XY
  422. 2205      IF NX=0 AND BDP=JP THEN  SKIP=NPX+1 :GOTO 2215
  423. 2210      GOSUB *BOLD_P
  424. 2215      A=NP(NPX)  :GOSUB *SWAP_XY
  425. 2220  NEXT NPX
  426. 2225  IF NX>0 THEN A=NP(NEXP) :GOSUB *SWAP_XY :                                      ON JP GOTO *CALENDER2,*FIL_P2,*GRAH_P2,*MEMO_P2,*NOTO_R2,*NOTO_P2,                     *CALK_P2  ,*CORD_P2,*BANK_P2
  427. 2230  IF SKIP>0 THEN A=NP(SKIP-1)  :NX=SKIP  :NEXP=NEXP-1 :GOSUB *RET_NEX2                       :GOTO 2225
  428. 2235  ON JP GOTO *CALENDER,*FIL_P ,*GRAH_P,*MEMO_P,*NOTO_R,*NOTO_P,                          *CALK_P  ,*CORD_P,*BANK_P
  429. 2240  RETURN
  430. 2245 '
  431. 2250 *SCR_BACK
  432. 2255  PUT@A (0,0)-(639,479),SCR%
  433. 2260  IF RXM<>RXMS THEN GOSUB *SET_CALENDA_TIF  :RXMS=RXM                                      ELSE PUT@A (30,20)-(170,101),CALE%
  434. 2265  IF NEXP=1 THEN 2315
  435. 2270  BCL(1)=BCL(11) :BCL(9)=BCL(6) :BCL(17)=BCL(11)  :NPX=0
  436. 2275  PALETTE 227,[250,200,200]
  437. 2280  WHILE  NPX<(NEXP-1)
  438. 2285      A=NP(NPX)  :GOSUB *SWAP_XY
  439. 2290                  GOSUB *BOLD_P
  440. 2295      A=NP(NPX)  :GOSUB *SWAP_XY
  441. 2300      NPX=NPX+1
  442. 2305  WEND
  443. 2310  BCL(1)=BCL(18)  :BCL(9)=BCL(19)  :BCL(17)=BCL(13)
  444. 2315  GOSUB *BOLD_P
  445. 2320  RETURN
  446. 2325 '
  447. 2330 *SCR_SETUP
  448. 2335  A=NEXP-1 :GOSUB *SWAP_XY
  449. 2340  PUT@A (0,0)-(639,479),SCR%
  450. 2345  IF RXM<>RXMS THEN GOSUB *SET_CALENDA_TIF  :RXMS=RXM                                      ELSE PUT@A (30,20)-(170,101),CALE%
  451. 2350  BCL(1)=BCL(11)  :BCL(9)=BCL(6)  :BCL(17)=BCL(11)
  452. 2355  PALETTE 227,[250,200,200]
  453. 2360  NPX=0  :GSWX=1  :YLW=75  :YU=28
  454. 2365  WHILE  NPX<(NEXP-1)
  455. 2370       A=NP(NPX)  :GOSUB *SWAP_XY
  456. 2375                   GOSUB *BOLD_P
  457. 2380       A=NP(NPX)  :GOSUB *SWAP_XY
  458. 2385       NPX=NPX+1
  459. 2390  WEND
  460. 2395  BCL(1)=BCL(18)  :BCL(9)=BCL(19)  :BCL(17)=BCL(13)  :GSWX=0
  461. 2400  A=NEXP-1   :GOSUB *SWAP_XY
  462. 2405  RETURN
  463. 2410 '
  464. 2415 *BOLD_P
  465. 2420  MPXF=MPXL+MPXE   :MPYF=MPYL+MPYE
  466. 2425  GET@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  467. 2430  *BOLD_P3
  468. 2435  LINE (MPXL,MPYL)-STEP(MPXE+2,MPYE+2),PSET,%BCL(4),BF
  469. 2440  IF BDP=7 THEN
  470. 2445                PUT@A (MPXL,MPYL)-(MPXF,MPYF),CALK%
  471. 2450                LINE (MPXL+12,MPYL+1)-STEP(127,8),PSET,%BCL(1),BF
  472. 2455                GOSUB *SUJI_PRINT
  473. 2460                RETURN
  474. 2465           ENDIF
  475. 2470  X=16  :Y=16
  476. 2475  LINE (MPXL,MPYL)-STEP(MPXE  ,MPYE  ),PSET,%BCL(0),BF,%BCL(1)
  477. 2480  LINE (MPXL,MPYL)-STEP(X ,Y ),PSET,%BCL(0),BF,%BCL(2)
  478. 2485  LINE (MPXF,MPYL)-STEP(-X,Y ),PSET,%BCL(0),BF,%BCL(2)
  479. 2490  LINE (MPXF,MPYL)-STEP(-X,Y ),PSET,%BCL(0),BF,%BCL(2)
  480. 2495  LINE (MPXF,MPYF)-STEP(-X,-Y),PSET,%BCL(0),BF,%BCL(2)
  481. 2500  LINE (MPXF,MPYF-Y)  -STEP(-X,-Y),PSET,%BCL(0),BF,%BCL(2)
  482. 2505  LINE (MPXF,MPYF-Y*2)-STEP(-X,-Y),PSET,%BCL(0),BF,%BCL(2)
  483. 2510  XA=INT(X/4) :YA=INT(Y/4)
  484. 2515  CONNECT(MPXF-XA*3,MPYF-(Y+YA*3))-STEP(XA*2,0)-STEP(-XA,YA*2)-                                  STEP(-XA,-YA*2),%BCL(0),PSET,F
  485. 2520  CONNECT(MPXF-X,MPYF)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  486. 2525  CONNECT(MPXF-XA*3,MPYF-(Y*2+YA))-STEP(XA*2,0)-STEP(-XA,-YA*2)-                                  STEP(-XA,YA*2),%BCL(0),PSET,F
  487. 2530  CONNECT(MPXF-X,MPYF-Y)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  488. 2535  CONNECT(MPXF-XA*3,MPYF-YA*3)-STEP(3,0)-STEP(-3,3)-STEP(0,-3)-                       STEP(XA*2,YA*2)-STEP(0,-3)-STEP(-3,3)-STEP(3,0),                                %BCL(0),PSET,F
  489. 2540  CONNECT(MPXF-X,MPYF-Y*2)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-                             STEP(2,-2)-STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  490. 2545  LINE(MPXL+7,MPYL+3)-STEP(2,2),PSET,%BCL(0),BF
  491. 2550  CONNECT(MPXL+7,MPYL+7)-STEP(2,0)-STEP(2,5)-STEP(-6,0)-STEP(2,-5),                                  %BCL(0),PSET,F
  492. 2555  CONNECT(MPXL,MPYL+Y)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  493. 2560  CONNECT(MPXF-6,MPYL+4)-STEP(0,6)-STEP(-6,0)-STEP(3,2)-                       STEP(0,-4)-STEP(-3,2),%BCL(0),PSET
  494. 2565  CONNECT(MPXF-X,MPYL+Y)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  495. 2570  IF BPQ=1 THEN *BOLD_P2
  496. 2575  LINE (MPXF-X,MPYF)  -STEP(-X,-Y),PSET,%BCL(0),BF,%BCL(2)
  497. 2580  LINE (MPXF-X*2,MPYF)-STEP(-X,-Y),PSET,%BCL(0),BF,%BCL(2)
  498. 2585  CONNECT(MPXF-(X+XA*3),MPYF-YA*3)-STEP(XA*2,YA)-STEP(-XA*2,YA)-                                  STEP(0,-YA*2),%BCL(0),PSET,F
  499. 2590  CONNECT(MPXF-X*2,MPYF)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  500. 2595  CONNECT(MPXF-(X*2+XA),MPYF-YA*3)-STEP(-XA*2,YA)-STEP(XA*2,YA)-                                  STEP(0,-YA*2),%BCL(0),PSET,F
  501. 2600  CONNECT(MPXF-X*3,MPYF)-STEP(2,-2)-STEP(X-4,0)-STEP(0,-Y+4)-STEP(2,-2)                             -STEP(0,Y)-STEP(-X,0),%BCL(0),PSET,F,%BCL(4)
  502. 2605 *BOLD_P2
  503. 2610  X=16 :Y=16
  504. 2615  LINE (MPXL,MPYL+Y)-STEP(MPXE-X,MPYE-Y*(2-BPQ)),                                   PSET,%BCL(0),BF,%BCL(2)
  505. 2620  ON BDP GOSUB *BD_1P,*BD_2P,*BD_3P ,*BD_4P ,*BD_5P ,*BD_6P ,*RET,                         *BD_8P,*BD_9P,*BD_10P,*BD_11P,*BD_12P,*BD_13P,*BD_14P,                      *BD_15P,*BD_16P,*BD_17P
  506. 2625  LINE  (MPXL+20,MPYL+1)-STEP(MPXE-38,14),PSET,%BCL(1),BF
  507. 2630  IF BCL(9)=BCL(6) THEN CL=BCL(12)   ELSE CL=BCL(6)
  508. 2635  LINE  (MPXL+17,MPYL+1)-STEP(LEN(FILS$)*8*.9!+4,14),PSET,%CL,BF
  509. 2640  SYMBOL(MPXL+20,MPYL+2),FILS$,.9!,.8!,%BCL(9)
  510. 2645  RETURN
  511. 2650 '
  512. 2655 *RET
  513. 2660  RETURN
  514. 2665 '
  515. 2670 *SET_XYD
  516. 2675  XF=0  :XE=11  :X=16  :Y=16
  517. 2680  MXY(0,0)=MPXL   :MXY(0,1)=MPYL   :MXY(0,2)=MPXL+X :MXY(0,3)=MPYL+Y
  518. 2685  MXY(1,0)=MPXF-X :MXY(1,1)=MPYL   :MXY(1,2)=MPXF   :MXY(1,3)=MPYL+Y
  519. 2690  MXY(2,0)=MPXF-X :MXY(2,1)=MPYF-Y :MXY(2,2)=MPXF   :MXY(2,3)=MPYF
  520. 2695  MXY(3,0)=MPXF-X :MXY(3,1)=MPYF-Y*2 :MXY(3,2)=MPXF :MXY(3,3)=MPYF-Y
  521. 2700  MXY(4,0)=MPXF-X :MXY(4,1)=MPYF-Y*3 :MXY(4,2)=MPXF :MXY(4,3)=MPYF-Y*2
  522. 2705  MXY(5,0)=MPXF-X*2 :MXY(5,1)=MPYF-Y :MXY(5,2)=MPXF-X   :MXY(5,3)=MPYF
  523. 2710  MXY(6,0)=MPXF-X*3 :MXY(6,1)=MPYF-Y :MXY(6,2)=MPXF-X*2 :MXY(6,3)=MPYF
  524. 2715  MXY(7,0)=MPXL+X   :MXY(7,1)=MPYL   :MXY(7,2)=MPXF-X :MXY(7,3)=MPYL+Y
  525. 2720  MXY(8,0)=MPXL   :MXY(8,1)=MPYL+Y   :MXY(8,2)=MPXF-X :MXY(8,3)=MPYF-Y
  526. 2725  MXY(9,0)=MPXF-X :MXY(9,1)=MPYL+Y   :MXY(9,2)=MPXF :MXY(9,3)=MPYF-Y*3
  527. 2730  MXY(10,0)=MPXL :MXY(10,1)=MPYF-Y :MXY(10,2)=MPXF-X*3 :MXY(10,3)=MPYF
  528. 2735  MXY(11,0)=MPXL  :MXY(11,1)=MPYL    :MXY(11,2)=MPXF   :MXY(11,3)=MPYF
  529. 2740  RETURN
  530. 2745 '
  531. 2750 *SET_XYD3
  532. 2755  XF=0  :XE=18  :X=20  :Y=20
  533. 2760  MXY(0,0)=MPXL   :MXY(0,1)=MPYL   :MXY(0,2)=MPXL+10 :MXY(0,3)=MPYL+10
  534. 2765  MXY(1,0)=MPXL+X :MXY(1,1)=MPYL   :MXY(1,2)=MPXF-X  :MXY(1,3)=MPYL+Y
  535. 2770  MXY(2,0)=MPXL+10  :MXY(2,1)=MPYL+60 :                                                          MXY(2,2)=MXY(2,0)+X*3  :MXY(2,3)=MXY(2,1)+Y*3
  536. 2775  MXY(3,0)=MPXL+10  :MXY(3,1)=MXY(2,1)+Y*3  :                                                    MXY(3,2)=MXY(3,0)+X    :MXY(3,3)=MXY(3,1)+Y
  537. 2780  MXY(4,0)=MXY(3,2) :MXY(4,1)=MXY(3,1)      :                                                    MXY(4,2)=MXY(4,0)+X    :MXY(4,3)=MXY(4,1)+Y
  538. 2785  MXY(5,0)=MXY(4,2) :MXY(5,1)=MXY(3,1)      :                                                    MXY(5,2)=MXY(5,0)+X    :MXY(5,3)=MXY(5,1)+Y
  539. 2790  B=0  :C=0
  540. 2795  FOR A=6 TO 17
  541. 2800      MXY(A,0)=MPXL+(B+3)*X+10
  542. 2805      MXY(A,1)=MPYL+C*Y+60
  543. 2810      MXY(A,2)=MXY(A,0)+X
  544. 2815      MXY(A,3)=MXY(A,1)+Y
  545. 2820      B=B+1
  546. 2825      IF B>2 THEN B=0  :C=C+1
  547. 2830  NEXT A
  548. 2835  MXY(18,0)=MPXL :MXY(18,1)=MPYL :MXY(18,2)=MPXF  :MXY(18,3)=MPYF
  549. 2840  RETURN
  550. 2845 '--------------------------------------------------------------------
  551. 2850 *ﾄﾞﾗｯｸﾞA
  552. 2855  MUXZ=MUX  :MUYZ=MUY  :XA=MPXF-MUXZ :YA=MPYF-MUYZ
  553. 2860  LINE (MPXL,MPYL)-(MUXZ+XA,MUYZ+YA),XOR,%BCL(2),B
  554. 2865  WHILE MOUSE(2,0)=-1
  555. 2870      IF MOUSE(9)=0 AND MOUSE(10)=0 THEN 2905
  556. 2875      LINE (MPXL,MPYL)-(MUXZ+XA,MUYZ+YA),XOR,%BCL(2),B
  557. 2880      MUXZ=MOUSE(0)    :MUYZ=MOUSE(1)
  558. 2885      IF MOUSE(0)-MPXL<200 THEN  MUXZ=MPXL+200
  559. 2890      IF MOUSE(1)-MPYL<100 THEN  MUYZ=MPYL+100
  560. 2895      LINE (MPXL,MPYL)-(MUXZ+XA,MUYZ+YA),XOR,%BCL(2),B
  561. 2900      MOUSE 1,MUXZ,MUYZ,1
  562. 2905  WEND
  563. 2910  LINE (MPXL,MPYL)-(MUXZ+XA,MUYZ+YA),XOR,%BCL(2),B
  564. 2915  MUX=MOUSE(0) :MUY=MOUSE(1)
  565. 2920  MOUSE 5
  566. 2925  RETURN
  567. 2930 ' -------------------------------------------------------------------
  568. 2935 *ﾄﾞﾗｯｸﾞB
  569. 2940  MUXW=MOUSE(9) :MUYW=MOUSE(10) :MUXW=0 :MUYW=0
  570. 2945  LINE (MPXL,MPYL)-(MPXF,MPYF),XOR,%BCL(2),B
  571. 2950  WHILE MOUSE(2,0)=-1
  572. 2955      MUXQ=MOUSE(9) :MUYQ=MOUSE(10)
  573. 2960      IF MUXQ=0 AND MUYQ=0 THEN 3010
  574. 2965      LINE (MPXL+MUXW,MPYL+MUYW)-(MPXF+MUXW,MPYF+MUYW),XOR,%BCL(2),B
  575. 2970      MUXW=MUXW+MUXQ :MUYW=MUYW+MUYQ
  576. 2975      XA=MPXL+MUXW   :YA=MPYL+MUYW   :XB=XA+MPXE  :YB=YA+MPYE
  577. 2980      IF XA<0   THEN MUXW=MPXL*(-1)
  578. 2985      IF YA<0   THEN MUYW=MPYL*(-1)
  579. 2990      IF XB>639 THEN MUXW=639-MPXF
  580. 2995      IF YB>479 THEN MUYW=479-MPYF
  581. 3000      MOUSE 1,MUX+MUXW,MUY+MUYW,1
  582. 3005      LINE (MPXL+MUXW,MPYL+MUYW)-(MPXF+MUXW,MPYF+MUYW),XOR,%BCL(2),B
  583. 3010  WEND
  584. 3015  LINE (MPXL+MUXW,MPYL+MUYW)-(MPXF+MUXW,MPYF+MUYW),XOR,%BCL(2),B
  585. 3020  MUX=MOUSE(0)   :MUY=MOUSE(1)
  586. 3025  MOUSE 5
  587. 3030  MPXL=MPXL+MUXW :MPYL=MPYL+MUYW
  588. 3035  IF MPXL<0 THEN MPXL=0
  589. 3040  IF MPYL<0 THEN MPYL=0
  590. 3045  RETURN
  591. 3050 '--------------------------------------------------------------------
  592. 3055 *SWAP_XY
  593. 3060  SWAP MPXL,XLS(A)   :SWAP MPXE,XES(A)     :SWAP MPXF,XFS(A)
  594. 3065  SWAP MPYL,YLS(A)   :SWAP MPYE,YES(A)     :SWAP MPYF,YFS(A)
  595. 3070  SWAP BDP ,BPS(A)   :SWAP BPQ ,BQS(A)
  596. 3075  SWAP REW_X,REWX(A) :SWAP REW_Y,REWY(A)
  597. 3080  RETURN
  598. 3085 '--------------------------------------------------------------------
  599. 3090 *SEL_WAKP
  600. 3095  BCL(1)=BCL(18)    :BCL(9)=BCL(19)    :BCL(17)=BCL(13)    :JPQ=0
  601. 3100  REW_X=PXE%(BDP-1) :REW_Y=PYE%(BDP-1) :NEXP=NEXP+1
  602. 3105  GOSUB *BOLD_P
  603. 3110  GOSUB *SET_XYD
  604. 3115  IF WKST=1 THEN INTERVAL ON   :TIMX$=""  :GOSUB *CLOCK_P
  605. 3120  GOSUB *SEL_MXY
  606. 3125  IF WKST=1 THEN INTERVAL OFF
  607. 3130  IF BDP=8  THEN
  608. 3135     IF ER=1 OR (VAL(K$)>0 AND REF_SW=0) THEN 3115
  609. 3140     IF VAL(K$)>0 AND REF_SW=1 THEN
  610. 3145                                   A=VAL(K$)  :JP=9  :XL=1  :YL=0
  611. 3150                                   IF CORP=0 THEN
  612. 3155                                                 COXP=A
  613. 3160                                                 GOSUB *BSCR_P8X
  614. 3165                                             ELSE
  615. 3170                                                 P=A
  616. 3175                                                 GOSUB *BSCR_P8XB
  617. 3180                                             ENDIF
  618. 3185                                   GOTO 3255
  619. 3190                             ENDIF
  620. 3195     ENDIF
  621. 3200  IF ER=1 THEN 3115
  622. 3205  IF JP=0 AND REF_SW=0 THEN
  623. 3210               GOSUB *NEX_XY
  624. 3215               IF JP>0 THEN
  625. 3220                  IF JP=10 THEN PXL%(BDP-1)=MPXL :PYL%(BDP-1)=MPYL :                                        PXE%(BDP-1)=MPXE :PYE%(BDP-1)=MPYE
  626. 3225                           A=NP(NEXP-1) :GOSUB *SWAP_XY  :JPQ=1
  627. 3230                           RETURN
  628. 3235                       ENDIF
  629. 3240               GOTO 3110
  630. 3245          ENDIF
  631. 3250  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN,*YL_UP,*XL_RIGHT,                            *XL_LEFT,*DRAG_B,*BSCR_P,*CSL_S,*CSL_D,*RET_W
  632. 3255  IF JP=1 THEN
  633. 3260               PXL%(BDP-1)=MPXL :PYL%(BDP-1)=MPYL :                                        PXE%(BDP-1)=MPXE :PYE%(BDP-1)=MPYE
  634. 3265               IF BDP=4 THEN IF MEM_EXS=1 THEN GOSUB *MEMO_SAVE
  635. 3270               GOSUB *CLOSE_P
  636. 3275               IF REF_SW>0 THEN A=NP(NEXP) :GOSUB *SWAP_XY :RETURN
  637. 3280               IF NEXP=0   THEN RETURN                                                                 ELSE JP=BPS(NP(NEXP-1))  :NX=0  :JPQ=1 :                                         RETURN
  638. 3285          ENDIF
  639. 3290 GOTO 3115
  640. 3295 '
  641. 3300 *BSCR_P
  642. 3305  ON BDP GOSUB *BSCR_P1,*BSCR_P2,*BSCR_P3,*BSCR_P4,*BSCR_P5,                               *BSCR_P6,*RET    ,*BSCR_P8,*BSCR_P9
  643. 3310  RETURN
  644. 3315 '
  645. 3320 *YL_DOWN
  646. 3325  ON BDP GOSUB *YL_DOWN1,*YL_DOWN2,*YL_DOWN3,*YL_DOWN4,*YL_DOWN5,                          *YL_DOWN6,*RET     ,*YL_DOWN8,*YL_DOWN9
  647. 3330  RETURN
  648. 3335 '
  649. 3340 *YL_UP
  650. 3345  ON BDP GOSUB *YL_UP1,*YL_UP2,*YL_UP3,*YL_UP4,*YL_UP5,                                    *YL_UP6,*RET   ,*YL_UP8,*YL_UP9
  651. 3350  RETURN
  652. 3355 '
  653. 3360 *XL_RIGHT
  654. 3365  ON BDP GOSUB *XL_RIGHT1,*XL_RIGHT2,*XL_RIGHT3,*XL_RIGHT4,*XL_RIGHT5,                     *XL_RIGHT6,*RET      ,*XL_RIGHT8,*XL_RIGHT9
  655. 3370  RETURN
  656. 3375  '
  657. 3380 *XL_LEFT
  658. 3385  ON BDP GOSUB *XL_LEFT1,*XL_LEFT2,*XL_LEFT3,*XL_LEFT4,*XL_LEFT5,                          *XL_LEFT6,*RET     ,*XL_LEFT8,*XL_LEFT9
  659. 3390  RETURN
  660. 3395  '
  661. 3400 *CSL_S
  662. 3405  ON BDP GOSUB *CSL_S1,*CSL_S2,*CSL_S3,*CSL_S4,*CSL_S5,                                    *CSL_S6,*RET   ,*CSL_S8,*CSL_S9
  663. 3410  RETURN
  664. 3415  '
  665. 3420 *CSL_D
  666. 3425  ON BDP GOSUB *CSL_D1,*RET_W ,*CSL_D3,*RET_W ,*RET_W ,                                    *RET_W ,*RET   ,*CSL_D8,*RET_W
  667. 3430  RETURN
  668. 3435  '
  669. 3440 '--------------------------------------------------------------------
  670. 3445 *CALENDER
  671. 3450  A=NP(NEXP)    :GOSUB *SWAP_XY
  672. 3455  MPXL=PXL%(0)  :MPYL=PYL%(0)  :MPXE=PXE%(0)  :MPYE=PYE%(0)  :CSP=1
  673. 3460  GOSUB *SWAP_MD
  674. 3465  A=0           :GOSUB *OPEN_P
  675. 3470  *CALENDER2
  676. 3475  BDP=1 :BPQ=0  :WKST=0
  677. 3480  GOSUB *SEL_WAKP
  678. 3485  IF JPQ=1 THEN GOTO *NEX_P
  679. 3490  RETURN
  680. 3495 '
  681. 3500 *RET_P
  682. 3505  NEXP=NEXP-1
  683. 3510 *RET_W
  684. 3515  WHILE MOUSE(2,0)=-1   :WEND
  685. 3520  MOUSE 5
  686. 3525  RETURN
  687. 3530 '
  688. 3535 *DRAG_A
  689. 3540  GOSUB *ﾄﾞﾗｯｸﾞA
  690. 3545  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  691. 3550  MPXE=MUXZ-MPXL+XA  :MPYE=MUYZ-MPYL+YA
  692. 3555  IF BDP=3 THEN A=0 :GOSUB *GRAP_ZOOM
  693. 3560  GOSUB *BOLD_P
  694. 3565  GOSUB *SET_XYD
  695. 3570  RETURN
  696. 3575 '
  697. 3580 *DRAG_B
  698. 3585  MPXLS=MPXL      :MPYLS=MPYL
  699. 3590  GOSUB *ﾄﾞﾗｯｸﾞB
  700. 3595  SWAP MPXL,MPXLS :SWAP MPYL,MPYLS
  701. 3600  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  702. 3605  SWAP MPXL,MPXLS :SWAP MPYL,MPYLS
  703. 3610  GOSUB *BOLD_P
  704. 3615  IF BPQ=0 THEN GOSUB *SET_XYD
  705. 3620  IF BPQ=2 THEN GOSUB *SET_XYD3
  706. 3625  RETURN
  707. 3630 '
  708. 3635 *REW_P
  709. 3640  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  710. 3645  SWAP MPXE,REW_X   :SWAP MPYE,REW_Y
  711. 3650  MPXL=MPXF-MPXE
  712. 3655  IF MPXL<0 THEN MPXL=0
  713. 3660  IF MPYL+MPYE>479 THEN MPYL=479-MPYE
  714. 3665  MOUSE 1,,,0
  715. 3670  GOSUB *BOLD_P
  716. 3675  GOSUB *SET_XYD
  717. 3680  GOSUB *RET_W
  718. 3685  RETURN
  719. 3690 '
  720. 3695 *BD_1P
  721. 3700  YMD$=LEFT$(DATE$,2)+"年"+MID$(DATE$,4,2)+"月"+RIGHT$(DATE$,2)+"日"
  722. 3705  IF MID$(YMD$,5,1)="0" THEN MID$(YMD$,5,1)=" "
  723. 3710  IF MID$(YMD$,9,1)="0" THEN MID$(YMD$,9,1)=" "
  724. 3715  FILS$="calender  "+YMD$
  725. 3720  YX$=RIGHT$(" "+STR$(YY),2)+"年"+RIGHT$(" "+STR$(MM),2)+"月"
  726. 3725  SYMBOL(MPXL+10,MPYL+20),YX$,1,1,%BCL(0)
  727. 3730  IF CSP=1 THEN
  728. 3735                IF DP=1 THEN XL=MPXL+40  ELSE XL=MPXL+60+(7-DP)*20
  729. 3740           ELSE
  730. 3745                XL=MPXL+40
  731. 3750           ENDIF
  732. 3755  YL=MPYL+40   :IF DP=7 THEN P=0   ELSE P=DP
  733. 3760  FOR A=CSP TO MONT(MM)
  734. 3765      IF (A MOD 7)=P THEN CL=BCL(15)    ELSE  CL=BCL(0)
  735. 3770      SYMBOL(XL,YL),RIGHT$(" "+STR$(A),2),1,1,%CL
  736. 3775      IF RXD=A AND RXM=MM AND RXY=YY                                                 THEN CIRCLE (XL+8,YL+7),10,%BCL(7),,,,F,XOR
  737. 3780      IF GXD=A AND GXM=MM AND GXY=YY                                                 THEN CIRCLE (XL+8,YL+7),10,%BCL(21),,,,F,XOR
  738. 3785      IF GZD=A AND GZM=MM AND GZY=YY                                                 THEN CIRCLE (XL+8,YL+7),10,%BCL(2),,,,F,XOR
  739. 3790      XL=XL+20 :IF XL>MPXF-31 THEN YL=YL+20  :XL=MPXL+40
  740. 3795      IF YL>MPYF-30 THEN 3805
  741. 3800  NEXT A
  742. 3805  GOSUB *CASOL_P1  :GOSUB *CASOL_P1B
  743. 3810  RETURN
  744. 3815 '
  745. 3820 *YL_DOWN1
  746. 3825  P=INT((MPXE-50)/20)
  747. 3830  IF CSP=<1 THEN IF DP=1 THEN P=8-DP  ELSE P=DP-1
  748. 3835  CSP=CSP+P
  749. 3840  IF CSP>MONT(MM) THEN CSP=CSP-INT((MPXE-50)/20)
  750. 3845  GOSUB *BD_SUBP
  751. 3850  RETURN
  752. 3855 '
  753. 3860 *YL_UP1
  754. 3865  CSP=CSP-INT((MPXE-50)/20)
  755. 3870  IF CSP<1 THEN CSP=1
  756. 3875  GOSUB *BD_SUBP
  757. 3880  RETURN
  758. 3885 '
  759. 3890 *XL_LEFT1
  760. 3895  MM=MM-1
  761. 3900  IF MM<1 THEN MM=12
  762. 3905  M=MM  :B=YOBI  :GOSUB *YOBI_P  :DP=C  :CSP=1
  763. 3910  GOSUB *BD_SUBP
  764. 3915  RETURN
  765. 3920 '
  766. 3925 *XL_RIGHT1
  767. 3930  MM=MM+1
  768. 3935  IF MM>12 THEN MM=1
  769. 3940  M=MM  :B=YOBI  :GOSUB *YOBI_P  :DP=C  :CSP=1
  770. 3945  GOSUB *BD_SUBP
  771. 3950  RETURN
  772. 3955 '
  773. 3960 *CSL_S1
  774. 3965  A=MONT(MM)
  775. 3970  GOSUB *ｶｰｿﾙ_SET1
  776. 3975  CSP=P
  777. 3980  GOSUB *BD_SUBP
  778. 3985  RETURN
  779. 3990  '
  780. 3995 *CSL_D1
  781. 4000  A=12
  782. 4005  GOSUB *ｶｰｿﾙ_SET2
  783. 4010  MM=P
  784. 4015  M=MM  :B=YOBI  :GOSUB *YOBI_P  :DP=C  :CSP=1
  785. 4020  GOSUB *BD_SUBP
  786. 4025  RETURN
  787. 4030  '
  788. 4035 *ｶｰｿﾙ_SET1
  789. 4040  P=INT((MUY-MPYL-16)/(MPYE-64)*A)+1
  790. 4045  *ｶｰｿﾙ_SET3
  791. 4050  IF P>A THEN P=A
  792. 4055  IF P<1 THEN P=1
  793. 4060  RETURN
  794. 4065 '
  795. 4070 *ｶｰｿﾙ_SET2
  796. 4075  P=INT((MUX-MPXL)/(MPXE-48)*A)+1
  797. 4080  GOTO *ｶｰｿﾙ_SET3
  798. 4085  '
  799. 4090 *CASOL_P1
  800. 4095  A=MONT(MM)   :B=CSP
  801. 4100  GOSUB *CASOL_PX1
  802. 4105  RETURN
  803. 4110 '
  804. 4115 *CASOL_P1B
  805. 4120  A=MPXE   :B=((MPXE-48)/12)*(MM-1)
  806. 4125  GOSUB *CASOL_PX2
  807. 4130  RETURN
  808. 4135 '
  809. 4140 *BD_SUBP
  810. 4145  GOSUB *BOLD_BACK
  811. 4150  WHILE MOUSE(2,0)=-1 :WEND
  812. 4155  MOUSE 5
  813. 4160  RETURN
  814. 4165 '
  815. 4170 *BSCR_P1
  816. 4175  XL=MPXL+40   :YL=MPYL+40
  817. 4180  IF CSP=1 THEN IF DP=1 THEN P=0  ELSE P=8-DP  ELSE P=0
  818. 4185  IF MUX<XL OR MUY<YL THEN RETURN
  819. 4190  B=INT((MPXE-50)/20)
  820. 4195  X=INT((MUX-XL)/20)+INT((MUY-YL)/20)*B-P+CSP
  821. 4200  IF X=<MONT(MM) AND X>0 THEN
  822. 4205     IF REF_SW<2 THEN  D=X    :M=MM   :GOSUB *PDX_SET  :                                           RXD=X  :RXY=YY :RXM=MM  :DEXE_SW=1
  823. 4210     IF REF_SW=2 THEN  GXD=X  :GXY=YY :GXM=MM  :REF_SW=3  :GOTO 4220
  824. 4215     IF REF_SW=3 THEN  GZD=X  :GZY=YY :GZM=MM  :REF_SW=2
  825. 4220     ENDIF
  826. 4225  GOSUB *BD_SUBP
  827. 4230  RETURN
  828. 4235 '-------------------------------------------------------------------
  829. 4240 *FIL_P
  830. 4245  A=NP(NEXP)   :GOSUB *SWAP_XY
  831. 4250  MPXL=PXL%(1) :MPYL=PYL%(1)  :MPXE=PXE%(1)  :MPYE=PYE%(1)
  832. 4255  A=1          :GOSUB *OPEN_P
  833. 4260 *FIL_P2
  834. 4265  BDP=2  :BPQ=0  :WKST=1  :REF_SW=0
  835. 4270  GOSUB *SEL_WAKP
  836. 4275  IF JPQ=1 THEN GOTO *NEX_P
  837. 4280  RETURN
  838. 4285 '
  839. 4290 *BD_2P
  840. 4295  FILS$="[ﾌｧｲﾙ登録]"
  841. 4300  WINDOW (MPXL+VXU+1,MPYL+17)-(MPXF+VXU-17,MPYF-17)   :                          VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  842. 4305  GOSUB *BD2_LINE
  843. 4310  IF FOX=0 THEN WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479) :RETURN
  844. 4315  XL=MPXL+5  :YL=MPYL+60  :X=(FLX+FLZ+2)*8
  845. 4320  FOR A=CSP2 TO FOX
  846. 4325      IF SET_FX=A THEN CL=BCL(8)    ELSE CL=BCL(0)
  847. 4330      SYMBOL(XL,YL),LEFT$(FSI$(A-1),FLZ),1,1,%CL
  848. 4335      SYMBOL(XL+FLZ*8+8,YL),RIGHT$(FSN$(A-1),FLX),1,1,%BCL(0)
  849. 4340      SYMBOL(XL+X,YL),FSD$(A-1),1,1,%BCL(0)
  850. 4345      IF KFXP=A   THEN LINE (XL,YL)-STEP(X-8,16),XOR,%BCL(2),BF
  851. 4350      YL=YL+18
  852. 4355      IF YL>MPYF-32 THEN 4365
  853. 4360  NEXT A
  854. 4365  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  855. 4370  GOSUB *CASOL_P2  :GOSUB *CASOL_P2B
  856. 4375  RETURN
  857. 4380 '
  858. 4385 *BD2_LINE
  859. 4390  IF FLZ=0 THEN FLZ=8
  860. 4395  IF FLX=0 THEN FLX=12
  861. 4400  IF FSW_P=0 THEN CL1=BCL(0) :CL2=BCL(3) :CL3=BCL(4) :CL4=BCL(2)                         ELSE CL1=BCL(3) :CL2=BCL(0) :CL3=BCL(2) :CL4=BCL(4)
  862. 4405  LINE (MPXL+10,MPYL+19)-STEP(7*8,18),PSET,%CL1,BF,%CL3
  863. 4410  SYMBOL(MPXL+10,MPYL+20),"[保 存]",1,1,%CL1
  864. 4415  LINE (MPXL+80,MPYL+19)-STEP(7*8,18),PSET,%CL2,BF,%CL4
  865. 4420  SYMBOL(MPXL+80,MPYL+20),"[読 込]",1,1,%CL2
  866. 4425  LINE (MPXL+150,MPYL+19)-STEP(8*8,18),PSET,%BCL(0),BF,%BCL(4)
  867. 4430  SYMBOL(MPXL+150,MPYL+20),"[set.up]",1,1,%BCL(8)
  868. 4435  LINE (MPXL+228,MPYL+19)-STEP(6*8,18),PSET,%BCL(0),BF,%BCL(4)
  869. 4440  SYMBOL(MPXL+228,MPYL+20),"[新規]",1,1,%BCL(8)
  870. 4445  XL=MPXL+5  :YL=MPYL+55  :X=(FLX+FLZ+2)*8
  871. 4450  SYMBOL(MPXL+5,YL-10),STR$(FLZ),.7!,.7!,%BCL(0)
  872. 4455  SYMBOL(MPXL+FLZ*8+5,YL-10),STR$(FLX),.7!,.7!,%BCL(0)
  873. 4460      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  874. 4465      LINE (XL+FLZ*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  875. 4470      LINE (XL+(FLX+FLZ)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  876. 4475      LINE (XL,YL  )-STEP(X-16,0),PSET,%BCL(0)
  877. 4480  RETURN
  878. 4485 '
  879. 4490 *YL_DOWN2
  880. 4495  CSP2=CSP2+1
  881. 4500  IF CSP2>FOX THEN CSP2=FOX
  882. 4505  GOSUB *BD_SUBP
  883. 4510  RETURN
  884. 4515 '
  885. 4520 *YL_UP2
  886. 4525  CSP2=CSP2-1
  887. 4530  IF CSP2<1 THEN CSP2=1
  888. 4535  GOSUB *BD_SUBP
  889. 4540  RETURN
  890. 4545 '
  891. 4550 *XL_LEFT2
  892. 4555  VXU=VXU-100
  893. 4560  GOSUB *BD_SUBP
  894. 4565  RETURN
  895. 4570 '
  896. 4575 *XL_RIGHT2
  897. 4580  VXU=VXU+100
  898. 4585  GOSUB *BD_SUBP
  899. 4590  RETURN
  900. 4595 '
  901. 4600 *CSL_S2
  902. 4605  A=FOX
  903. 4610  GOSUB *ｶｰｿﾙ_SET1
  904. 4615  CSP2=P
  905. 4620  GOSUB *BD_SUBP
  906. 4625  RETURN
  907. 4630 '
  908. 4635 *CASOL_P2
  909. 4640  A=FOX :B=CSP2
  910. 4645  GOSUB *CASOL_PX1
  911. 4650  RETURN
  912. 4655 '
  913. 4660 *CASOL_P2B
  914. 4665  A=(FLX+FLZ+2)*8 :B=VXU
  915. 4670  GOSUB *CASOL_PX2
  916. 4675  RETURN
  917. 4680 '
  918. 4685 *CASOL_PX1
  919. 4690  IF A<1 THEN A=1
  920. 4695  YL=INT((MPYE-80)/A)
  921. 4700  IF A>1 THEN YR=(MPYE-80-YL)/(A-1)
  922. 4705  Y =(B-1)*YR+MPYL+16
  923. 4710  LINE (MPXF,MPYL+16)-STEP(-16,MPYE-64),PSET,%BCL(0),BF,%BCL(5)
  924. 4715  LINE (MPXF,Y)-STEP(-16,YL+16),PSET,%BCL(0),BF,%BCL(17)
  925. 4720  CONNECT(MPXF-16,Y+YL+16)-STEP(2,-2)-STEP(12,0)-STEP(0,-YL-12)-                     STEP(2,-2)-STEP(0,YL+16)-STEP(-16,0),%BCL(0),PSET,F,%BCL(0)
  926. 4725  RETURN
  927. 4730 '
  928. 4735 *BSCR_P2
  929. 4740  INTERVAL ON
  930. 4745  YL=INT((MUY-MPYL-75)/18)+1
  931. 4750  IF YL<0 THEN *LINE_EXE2
  932. 4755  FOXP=YL+CSP2
  933. 4760  IF FOXP>FOX THEN *FILN_INP
  934. 4765  GOSUB *FILN_EXE
  935. 4770  RETURN
  936. 4775 '
  937. 4780 *LINE_EXE2
  938. 4785  IF MUY<MPYL+40 THEN *FSW_EXE
  939. 4790  IF MUX>MPXL-VXU+FLZ*8+5 THEN *LINE_EXE2B
  940. 4795  GOSUB *LINE_EXEP
  941. 4800  IF CAR_END=1 THEN FLZ=VAL(MX$)
  942. 4805  GOSUB *SCR_BACK
  943. 4810  RETURN
  944. 4815 '
  945. 4820 *LINE_EXE2B
  946. 4825  IF MUX>MPXL-VXU+(FLX+FLZ)*8+5 THEN RETURN
  947. 4830  GOSUB *LINE_EXEP
  948. 4835  IF CAR_END=1 THEN FLX=VAL(MX$)
  949. 4840  GOSUB *SCR_BACK
  950. 4845  RETURN
  951. 4850 '
  952. 4855 *FILN_EXE
  953. 4860  IF MUX>MPXL-VXU+FLZ*8+5 THEN *FILN_EXE2
  954. 4865  CRXF=MPXL+5-VXU      :CRXE=CRXF+FLZ*8
  955. 4870  CRYF=MPYL+YL*18+60   :CRYE=CRYF+18
  956. 4875  CAR_END=0            :CRLEN=FLZ+1   :CRB=BCL(5)
  957. 4880  MX$=FSI$(FOXP-1)     :XLP=LEN(MX$)  :GOSUB *KEY_CR
  958. 4885  WAIT WAIX    :MJ=MOUSE(3,0)  :IF MJ>0 THEN *FIL_ACSES
  959. 4890  GOSUB *INKEY_W
  960. 4895  IF RCLICK>0  THEN CRB=BCL(10) :GOSUB *KEY_CR  :GOSUB *KILL_P2 :                               GOSUB *FILN_SAVE  :GOTO 4910
  961. 4900  IF GET_POINT=1 THEN IF MUX>MPXL-VXU+150 AND MUX<MPXL-VXU+206                   THEN CAR_END=1 :IF SET_FX=FOXP THEN SET_FX=0   ELSE SET_FX=FOXP
  962. 4905  IF CAR_END=1 THEN FSI$(FOXP-1)=MX$  :GOSUB *FILN_SAVE
  963. 4910  GOSUB *BOLD_P2  :RCLICK=0
  964. 4915  RETURN
  965. 4920 '
  966. 4925 *FILN_INP
  967. 4930  IF FOX>=CDX THEN GOSUB *FLL_CORD  :RETURN
  968. 4935  FSI$(FOX)=""   :FSN$(FOX)=""
  969. 4940  IF MUX>MPXL-VXU+FLZ*8+5 THEN *FILN_INP2
  970. 4945  CRXF=MPXL+5-VXU      :CRXE=CRXF+FLZ*8
  971. 4950  CRYF=MPYL+YL*18+60   :CRYE=CRYF+18
  972. 4955  CAR_END=0            :CRLEN=FLZ+1
  973. 4960  MX$=""               :XLP=1           :CRB=BCL(5)
  974. 4965  GOSUB *INKEY_WP
  975. 4970  IF GET_POINT=1 THEN IF MUX>MPXL-VXU+150 AND MUX<MPXL-VXU+206                   THEN CAR_END=1 :IF SET_FX=FOXP THEN SET_FX=0   ELSE SET_FX=FOXP
  976. 4975  IF CAR_END=1 THEN GOSUB *FILN_SET
  977. 4980  GOSUB *BOLD_P2  :RCLICK=0
  978. 4985  RETURN
  979. 4990 '
  980. 4995 *FILN_EXE2
  981. 5000  CRXF=MPXL+(FLZ+1)*8+5-VXU           :CRXE=CRXF+FLX*8
  982. 5005  CRYF=MPYL+YL*18+60                  :CRYE=CRYF+18
  983. 5010  CAR_END=0            :CRLEN=FLX+1   :CRB=BCL(5)
  984. 5015  IF FSN$(FOXP-1)="" THEN  MX$=FIL$(3)      ELSE  MX$=FSN$(FOXP-1)
  985. 5020  XLP=LEN(MX$) :GOSUB *KEY_CR
  986. 5025  WAIT WAIX    :MJ=MOUSE(3,0)  :IF MJ>0 THEN *FIL_ACSES
  987. 5030  GOSUB *INKEY_W
  988. 5035  IF RCLICK>0  THEN CRB=BCL(10) :GOSUB *KEY_CR  :GOSUB *KILL_P2 :                               GOSUB *FILN_SAVE  :GOTO 5050
  989. 5040  IF GET_POINT=1 THEN IF MUX>MPXL-VXU+150 AND MUX<MPXL-VXU+206                   THEN CAR_END=1 :IF SET_FX=FOXP THEN SET_FX=0   ELSE SET_FX=FOXP
  990. 5045  IF CAR_END=1 THEN FSN$(FOXP-1)=MX$  :GOSUB *FILN_SAVE
  991. 5050  GOSUB *BOLD_P2  :RCLICK=0
  992. 5055  RETURN
  993. 5060 '
  994. 5065 *FILN_INP2
  995. 5070  CRXF=MPXL+(FLZ+1)*8+5-VXU           :CRXE=CRXF+FLX*8
  996. 5075  CRYF=MPYL+YL*18+60                  :CRYE=CRYF+18
  997. 5080  CAR_END=0            :CRLEN=FLX+1   :CRB=BCL(5)
  998. 5085  MX$=FIL$(3)          :XLP=LEN(MX$)
  999. 5090  GOSUB *INKEY_WP
  1000. 5095  IF GET_POINT=1 THEN IF MUX>MPXL-VXU+150 AND MUX<MPXL-VXU+206                   THEN CAR_END=1 :IF SET_FX=FOXP THEN SET_FX=0   ELSE SET_FX=FOXP
  1001. 5100  IF CAR_END=1 THEN FOX=FOX+1 :FSN$(FOX-1)=MX$ :GOSUB *FILN_SAVE
  1002. 5105  GOSUB *BOLD_P2  :RCLICK=0
  1003. 5110  RETURN
  1004. 5115 '
  1005. 5120 *FILN_LOAD
  1006. 5125  ON ERROR GOTO *FILN_LERR
  1007. 5130  OPEN "I",#1,FIL$(10)
  1008. 5135       INPUT #1,FOX,FLZ,FLX,SET_FX
  1009. 5140       FOR A=0 TO FOX-1
  1010. 5145           LINE INPUT #1,FSI$(A)    :B=LEN(FSI$(A))
  1011. 5150           IF B>2 THEN   FSI$(A)=MID$(FSI$(A),2,B-2)
  1012. 5155           LINE INPUT #1,FSN$(A)    :B=LEN(FSN$(A))
  1013. 5160           IF B>2 THEN   FSN$(A)=MID$(FSN$(A),2,B-2)
  1014. 5165           LINE INPUT #1,FSD$(A)    :B=LEN(FSD$(A))
  1015. 5170           IF B>2 THEN   FSD$(A)=MID$(FSD$(A),2,B-2)
  1016. 5175           IF EOF(1)=-1 THEN *FNLOAD_RET
  1017. 5180       NEXT A
  1018. 5185  *FNLOAD_RET
  1019. 5190  CLOSE #1
  1020. 5195  ON ERROR GOTO 0
  1021. 5200  CSP2=1
  1022. 5205  RETURN
  1023. 5210 '
  1024. 5215 *FILN_LERR
  1025. 5220  IF ERR<>63 THEN *ERR_MESE
  1026. 5225  FOX=0
  1027. 5230  RESUME *FNLOAD_RET
  1028. 5235 '
  1029. 5240 *FILN_SAVE
  1030. 5245  ON ERROR GOTO *FILN_SERR
  1031. 5250  OPEN "O",#1,FIL$(10)
  1032. 5255       PRINT #1,FOX,FLZ,FLX,SET_FX
  1033. 5260       FOR A=0 TO FOX-1
  1034. 5265           WRITE #1,FSI$(A)
  1035. 5270           WRITE #1,FSN$(A)
  1036. 5275           WRITE #1,FSD$(A)
  1037. 5280       NEXT A
  1038. 5285  *FNSAVE_RET
  1039. 5290  CLOSE #1
  1040. 5295  ON ERROR GOTO 0
  1041. 5300  RETURN
  1042. 5305 '
  1043. 5310 *FILN_SERR
  1044. 5315  IF ERR<>64 THEN *ERR_MESE
  1045. 5320  KILL  FIL$(10)
  1046. 5325  RESUME
  1047. 5330 '
  1048. 5335 *FILN_SET
  1049. 5340  FOX=FOX+1
  1050. 5345  FSI$(FOX-1)=MX$
  1051. 5350  IF FSN$(FOX-1)="" THEN
  1052. 5355                         A=INSTR(MX$,".")
  1053. 5360                         IF A=0 OR A>8 THEN A=8    ELSE A=A-1
  1054. 5365                         FSN$(FOX-1)=FIL$(3)+LEFT$(MX$,A)+".dat"
  1055. 5370            ENDIF
  1056. 5375  GOSUB *FILN_SAVE
  1057. 5380  RETURN
  1058. 5385 ' 
  1059. 5390 *KILL_P2
  1060. 5395  IF FOX>=CDX  THEN 5425
  1061. 5400  FOR A=FOXP-1 TO FOX-2
  1062. 5405      SWAP FSI$(A),FSI$(A+1)
  1063. 5410      SWAP FSN$(A),FSN$(A+1)
  1064. 5415      SWAP FSD$(A),FSD$(A+1)
  1065. 5420  NEXT A
  1066. 5425  IF FOX>0 THEN FOX=FOX-1
  1067. 5430  RETURN
  1068. 5435 '
  1069. 5440 *FSW_EXE
  1070. 5445  IF MUX>MPXL-VXU+10  AND MUX<MPXL-VXU+66  THEN FSW_P=0
  1071. 5450  IF MUX>MPXL-VXU+80  AND MUX<MPXL-VXU+136 THEN FSW_P=1
  1072. 5455  IF MUX>MPXL-VXU+228 AND MUX<MPXL-VXU+276 THEN *NEW_DAT
  1073. 5460  MOUSE 1,,,0
  1074. 5465  GOSUB *BD_2P
  1075. 5470  RETURN
  1076. 5475 '
  1077. 5480 *NEW_DAT
  1078. 5485  RESTORE *NEW_MESD     :GOSUB *ERMD_SET   :ERP=1
  1079. 5490  GOSUB *MESSAGE_P      :ERP=0
  1080. 5495  IF MESJ=1 THEN 
  1081. 5500     YM$=DATE$  :GOSUB *SET_RXY  :FSW_P=1  :KFXP=0  :KFX$=""
  1082. 5505     GRAP_SW=0  :PDF=0  :PDE=365 :GRAP_CSW=0
  1083. 5510     ERASE KMAX,ZAN&,KIN&,KMI%,KSU%,KNE$
  1084. 5515     DIM   KMAX(365),ZAN&(366),KIN&(365,NSX)
  1085. 5520     DIM   KMI%(365,NSX),KSU%(365,NSX),KNE$(365,NSX)
  1086. 5525  ENDIF
  1087. 5530  GOSUB *SCR_BACK
  1088. 5535  RETURN
  1089. 5540  '
  1090. 5545 *NEW_MESD
  1091. 5550  DATA 2
  1092. 5555  DATA "現在のデータを消去し",0
  1093. 5560  DATA "新規ファイルを作成します",0
  1094. 5565  '
  1095. 5570 *FIL_ACSES
  1096. 5575  MOUSE 5
  1097. 5580  CRB=BCL(10) :GOSUB *KEY_CR
  1098. 5585  IF FSW_P=0 THEN GOSUB *FILD_SAVE :FSW_P=1                                              ELSE GOSUB *FILD_LOAD :FSW_P=0
  1099. 5590  GOSUB *SCR_BACK
  1100. 5595  RETURN
  1101. 5600 '
  1102. 5605 *FILD_LOAD
  1103. 5610  IF FSN$(FOXP-1)="" THEN RETURN
  1104. 5615  F$=FSN$(FOXP-1)  :KFX$=FSI$(FOXP-1)  :KFXP=FOXP  :EXPS=0
  1105. 5620  ON ERROR GOTO *FILD_LERR
  1106. 5625  OPEN "I",#1,F$
  1107. 5630      INPUT #1,YM$
  1108. 5640      FOR A=0 TO 365
  1109. 5645          INPUT #1,KMAX(A)
  1110. 5650          INPUT #1,KIN&(A,0),KMI%(A,0),KSU%(A,0)
  1111. 5655          INPUT #1,KNE$(A,0)
  1112. 5660      NEXT A
  1113. 5665      FOR A=0 TO 365
  1114. 5670          FOR B=1 TO NSX
  1115. 5675              INPUT #1,KIN&(A,B),KMI%(A,B),KSU%(A,B)
  1116. 5680              INPUT #1,KNE$(A,B)
  1117. 5685          NEXT B
  1118. 5690      NEXT A
  1119. 5695      GOSUB *SET_RXY
  1120. 5700  *LERR_BACK
  1121. 5705  CLOSE #1 :X=0  :PDXS=PDX :GOSUB *ZAN_P2
  1122. 5710  ON ERROR GOTO 0
  1123. 5715  RETURN
  1124. 5720 '
  1125. 5725 *FILD_LERR
  1126. 5730  IF ERR<>63 THEN *ERR_MESE
  1127. 5735  RESUME *LERR_BACK
  1128. 5740 '
  1129. 5745 *FILD_SAVE
  1130. 5750  IF FSN$(FOXP-1)="" THEN RETURN
  1131. 5755  F$=FSN$(FOXP-1)  :KFX$=FSI$(FOXP-1)  :KFXP=FOXP  :EXPS=0
  1132. 5760  A$=RIGHT$(" "+STR$(RXY),2)+"/"+RIGHT$(" "+STR$(RXM),2)+"/"+                    RIGHT$(" "+STR$(RXD),2)
  1133. 5765  IF ZCALK_SW=1 AND DEXE_SW=1 THEN GOSUB *ZAN_P
  1134. 5770  ON ERROR GOTO *FILD_SERR
  1135. 5775  OPEN "O",#1,F$
  1136. 5780      PRINT #1,A$
  1137. 5790      FOR A=0 TO 365
  1138. 5795          PRINT #1,KMAX(A)
  1139. 5800          PRINT #1,KIN&(A,0),KMI%(A,0),KSU%(A,0)
  1140. 5805          PRINT #1,KNE$(A,0)
  1141. 5810      NEXT A
  1142. 5815      FOR A=0 TO 365
  1143. 5820          FOR B=1 TO NSX
  1144. 5825              PRINT #1,KIN&(A,B),KMI%(A,B),KSU%(A,B)
  1145. 5830              PRINT #1,KNE$(A,B)
  1146. 5835          NEXT B
  1147. 5840      NEXT A
  1148. 5845      FSD$(FOXP-1)=DATE$+"_"+TIME$
  1149. 5850  *SERR_BACK
  1150. 5855  CLOSE #1
  1151. 5860  ON ERROR GOTO 0
  1152. 5865  IF ER=0 THEN GOSUB *FILN_SAVE
  1153. 5870  RETURN
  1154. 5875 '
  1155. 5880 *FILD_SERR
  1156. 5885  IF ERR<>64 THEN *ERR_MESE
  1157. 5890  KILL F$
  1158. 5895  RESUME
  1159. 5900 '-------------------------------------------------------------------
  1160. 5905 *CORD_P
  1161. 5910  A=NP(NEXP)    :GOSUB *SWAP_XY
  1162. 5915  MPXL=PXL%(7)  :MPYL=PYL%(7)  :MPXE=PXE%(7)  :MPYE=PYE%(7)
  1163. 5920  GOSUB *SWAP_MD
  1164. 5925  A=7           :GOSUB *OPEN_P
  1165. 5930  *CORD_P2
  1166. 5935  BDP=8  :CRB=BCL(5) :BPQ=0  :WKST=0
  1167. 5940  GOSUB *SEL_WAKP
  1168. 5945  IF JPQ=1 THEN GOTO *NEX_P
  1169. 5950  RETURN
  1170. 5955 '
  1171. 5960 *CORD_LOAD
  1172. 5965  ON ERROR GOTO *ERR_P8L
  1173. 5970  OPEN "I",#1,FIL$(8)
  1174. 5975      INPUT #1,COX,CLX
  1175. 5980      FOR A=0 TO COX-1
  1176. 5985          INPUT #1,CORD$(A)
  1177. 5990          INPUT #1,CORDN%(A)
  1178. 5995          IF EOF(1)=-1 THEN *CLOAD_RET
  1179. 6000      NEXT A
  1180. 6005  *CLOAD_RET
  1181. 6010  CLOSE #1
  1182. 6015  ON ERROR GOTO 0
  1183. 6020  CSP8=1
  1184. 6025  RETURN
  1185. 6030 '
  1186. 6035 *ERR_P8L
  1187. 6040  IF ERR<>63 THEN *ERR_MESE
  1188. 6045  COX=0
  1189. 6050  RESUME *CLOAD_RET
  1190. 6055 '
  1191. 6060 *CORD_SAVE
  1192. 6065  ON ERROR GOTO *ERR_P8S
  1193. 6070  OPEN "O",#1,FIL$(8)
  1194. 6075       PRINT #1,COX,CLX
  1195. 6080       FOR A=0 TO COX-1
  1196. 6085           PRINT #1,CORD$(A)
  1197. 6090           PRINT #1,CORDN%(A)
  1198. 6095       NEXT A
  1199. 6100  *CSAVE_RET
  1200. 6105  CLOSE #1
  1201. 6110  ON ERROR GOTO 0
  1202. 6115  RETURN
  1203. 6120 '
  1204. 6125 *ERR_P8S
  1205. 6130  IF ERR<>64 THEN *ERR_MESE
  1206. 6135  KILL FIL$(8)
  1207. 6140  RESUME
  1208. 6145 '
  1209. 6150 *BD_8P
  1210. 6155  IF CORP=0  THEN  A$="[ 項 目 ]"     ELSE  A$="[ 名 称 ]"
  1211. 6160  FILS$="名称コード "+A$
  1212. 6165  WINDOW (MPXL+VXU+1,MPYL+17)-(MPXF+VXU-17,MPYF-17)   :                          VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  1213. 6170  IF CORP>0 THEN  *BD_8PB
  1214. 6175  GOSUB *BD8A_LINE
  1215. 6180  SYMBOL(MPXL+45,MPYL+20),STR$(CLX-4),.7!,.7!,%BCL(0)
  1216. 6185  IF COX=0 THEN WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479) :RETURN
  1217. 6190  XL=MPXL+10  :YL=MPYL+35  :X=(CLX+2)*8
  1218. 6195  FOR A=CSP8 TO COX
  1219. 6200      SYMBOL(XL,YL),RIGHT$("  "+STR$(A),3),1,1,%BCL(0)
  1220. 6205      SYMBOL(XL+35,YL),LEFT$(CORD$(A-1),CLX-4),1,1,%BCL(0)
  1221. 6210      YL=YL+18
  1222. 6215      IF YL>MPYF-48 THEN XL=XL+X  :YL=MPYL+35  :L=L-1 :                                              IF L<0  THEN  6225
  1223. 6220  NEXT A
  1224. 6225  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  1225. 6230  LINE (MPXL+1,MPYF-33)-STEP(MPXE-18,16),XOR,%BCL(3),BF
  1226. 6235  SYMBOL(MPXL+10,MPYF-33),"[編集]",1,1,%BCL(0)
  1227. 6240  GOSUB *CASOL_P8  :GOSUB *CASOL_P8Z
  1228. 6245  RETURN
  1229. 6250 '
  1230. 6255 *BD_8PB
  1231. 6260  L=INT((MPXE-30)/8)  :P1=KLEN(LEFT$(CORD$(CORP-1),L))
  1232. 6265  IF LEN(CORD$(CORP-1))>L THEN B$=KLEFT$(CORD$(CORP-1),P1)                                              ELSE B$=CORD$(CORP-1)
  1233. 6270  SYMBOL(MPXL+10,MPYL+20),B$,1,1,%BCL(0)
  1234. 6275  GOSUB *BD8B_LINE
  1235. 6280  SYMBOL(MPXL+45,MPYL+40),STR$(CSX-13),.7!,.7!,%BCL(0)
  1236. 6285  IF COZ=0 THEN WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479) :RETURN
  1237. 6290  XL=MPXL+10  :YL=MPYL+60  :X=(CSX+2)*8
  1238. 6295  FOR A=CSL8 TO COZ
  1239. 6300      SYMBOL(XL,YL),RIGHT$("  "+STR$(CONX(A-1)),4),1,1,%BCL(0)
  1240. 6305      SYMBOL(XL+36,YL),LEFT$(COFX$(A-1),CSX-13),1,1,%BCL(0)
  1241. 6310      B$="\"+STR$(COMX(A-1))
  1242. 6315      SYMBOL(XL+(CSX-LEN(B$))*8,YL),B$,1,1,%BCL(0)
  1243. 6320      YL=YL+18
  1244. 6325      IF YL>MPYF-48 THEN  XL=XL+X  :YL=MPYL+60  :L=L-1 :                                              IF L<0  THEN  6335
  1245. 6330  NEXT A
  1246. 6335  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  1247. 6340  LINE (MPXL+1,MPYF-33)-STEP(MPXE-18,16),XOR,%BCL(3),BF
  1248. 6345  SYMBOL(MPXL+10,MPYF-33),"[編集] <-.A.ｱ.ｻ.ﾅ.ﾏ.ﾗ.->",1,1,%BCL(0)
  1249. 6350  GOSUB *CASOL_P8B  :GOSUB *CASOL_P8BZ
  1250. 6355  RETURN
  1251. 6360 '
  1252. 6365 *BD8A_LINE
  1253. 6370  IF CLX=0 THEN CLX=20
  1254. 6375  XL=MPXL+5  :YL=MPYL+30  :X=(CLX+2)*8  :L=INT((MPXE-25)/X)+1
  1255. 6380  IF ((MPXE-25) MOD X)>0 THEN L=L+1
  1256. 6385  FOR A=1 TO L
  1257. 6390      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  1258. 6395      IF XL+(X-2*8)>MPXF-16                                                          THEN XB=MPXF-XL-16                                                          ELSE XB=X-2*8  :LINE (XL+CLX*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1259. 6400      LINE (XL,YL  )-STEP(XB,0),PSET,%BCL(0)
  1260. 6405      LINE (XL+4*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1261. 6410      XL=XL+X
  1262. 6415  NEXT A
  1263. 6420  RETURN
  1264. 6425 '
  1265. 6430 *BD8B_LINE
  1266. 6435  IF CSX=0 THEN CSX=23
  1267. 6440  XL=MPXL+5  :YL=MPYL+50  :X=(CSX+2)*8  :L=INT((MPXE-25)/X)+1
  1268. 6445  IF ((MPXE-25) MOD X)>0 THEN L=L+1
  1269. 6450  FOR A=1 TO L
  1270. 6455      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  1271. 6460      LINE (XL+CSX*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1272. 6465      LINE (XL,YL  )-STEP(X-2*8,0),PSET,%BCL(0)
  1273. 6470      LINE (XL+5*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1274. 6475      LINE (XL+(CSX-8)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1275. 6480      LINE (XL+CSX*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  1276. 6485      XL=XL+X
  1277. 6490  NEXT A
  1278. 6495  RETURN
  1279. 6500 '
  1280. 6505 *YL_DOWN8
  1281. 6510  IF CORP>0 THEN *YL_DOWN8B
  1282. 6515  CSP8=CSP8+1
  1283. 6520  IF CSP8>COX THEN CSP8=COX
  1284. 6525  GOSUB *BD_SUBP
  1285. 6530  RETURN
  1286. 6535 '
  1287. 6540 *YL_UP8
  1288. 6545  IF CORP>0 THEN *YL_UP8B
  1289. 6550  CSP8=CSP8-1
  1290. 6555  IF CSP8<1 THEN CSP8=1
  1291. 6560  GOSUB *BD_SUBP
  1292. 6565  RETURN
  1293. 6570 '
  1294. 6575 *YL_DOWN8B
  1295. 6580  CSL8=CSL8+1
  1296. 6585  IF CSL8>COZ THEN CSL8=COZ
  1297. 6590  GOSUB *BD_SUBP
  1298. 6595  RETURN
  1299. 6600 '
  1300. 6605 *YL_UP8B
  1301. 6610  CSL8=CSL8-1
  1302. 6615  IF CSL8<1 THEN CSL8=1
  1303. 6620  GOSUB *BD_SUBP
  1304. 6625  RETURN
  1305. 6630 '
  1306. 6635 *XL_RIGHT8
  1307. 6640  IF CORP>0 THEN *XL_LEFT8B
  1308. 6645  L=INT((MPYE-67)/18)
  1309. 6650  CSP8=CSP8+L
  1310. 6655  IF CSP8>COX THEN CSP8=CSP8-L
  1311. 6660  GOSUB *BD_SUBP
  1312. 6665  RETURN
  1313. 6670 '
  1314. 6675 *XL_LEFT8
  1315. 6680  IF CORP>0 THEN *XL_RIGHT8B
  1316. 6685  L=INT((MPYE-67)/18)
  1317. 6690  CSP8=CSP8-L
  1318. 6695  IF CSP8<1 THEN CSP8=1
  1319. 6700  GOSUB *BD_SUBP
  1320. 6705  RETURN
  1321. 6710 '
  1322. 6715 *XL_LEFT8B
  1323. 6720  L=INT((MPYE-92)/18)
  1324. 6725  CSL8=CSL8+L
  1325. 6730  IF CSL8>COZ THEN CSL8=CSL8-L
  1326. 6735  GOSUB *BD_SUBP
  1327. 6740  RETURN
  1328. 6745 '
  1329. 6750 *XL_RIGHT8B
  1330. 6755  L=INT((MPYE-92)/18)
  1331. 6760  CSL8=CSL8-L
  1332. 6765  IF CSL8<1 THEN CSL8=1
  1333. 6770  GOSUB *BD_SUBP
  1334. 6775  RETURN
  1335. 6780 '
  1336. 6785 *CASOL_P8
  1337. 6790  A=COX :B=CSP8
  1338. 6795  GOSUB *CASOL_PX1
  1339. 6800  RETURN
  1340. 6805 '
  1341. 6810 *CASOL_P8Z
  1342. 6815  A=MPXE :B=((MPXE-48)/COX)*(CSP8-1)
  1343. 6820  GOSUB *CASOL_PX2
  1344. 6825  RETURN
  1345. 6830 '
  1346. 6835 *CASOL_P8B
  1347. 6840  A=COZ :B=CSL8
  1348. 6845  GOSUB *CASOL_PX1
  1349. 6850  RETURN
  1350. 6855 '
  1351. 6860 *CASOL_P8BZ
  1352. 6865  A=MPXE :B=((MPXE-48)/COZ)*(CSL8-1)
  1353. 6870  GOSUB *CASOL_PX2
  1354. 6875  RETURN
  1355. 6880 '
  1356. 6885 *CSL_S8
  1357. 6890  IF CORP>0 THEN *CSL_S8B
  1358. 6895  A=COX
  1359. 6900  GOSUB *ｶｰｿﾙ_SET1
  1360. 6905  CSP8=P
  1361. 6910  GOSUB *BD_SUBP
  1362. 6915  RETURN
  1363. 6920 '
  1364. 6925 *CSL_D8
  1365. 6930  IF CORP>0 THEN *CSL_D8B
  1366. 6935  A=COX
  1367. 6940  GOSUB *ｶｰｿﾙ_SET2
  1368. 6945  CSP8=P
  1369. 6950  GOSUB *BD_SUBP
  1370. 6955  RETURN
  1371. 6960 '
  1372. 6965 *CSL_S8B
  1373. 6970  A=COZ
  1374. 6975  GOSUB *ｶｰｿﾙ_SET1
  1375. 6980  CSL8=P
  1376. 6985  GOSUB *BD_SUBP
  1377. 6990  RETURN
  1378. 6995 '
  1379. 7000 *CSL_D8B
  1380. 7005  A=COZ
  1381. 7010  GOSUB *ｶｰｿﾙ_SET2
  1382. 7015  CSL8=P
  1383. 7020  GOSUB *BD_SUBP
  1384. 7025  RETURN
  1385. 7030 '
  1386. 7035 *BSCR_P8
  1387. 7040  IF CORP>0 THEN *BSCR_P8B
  1388. 7045  IF MUY>MPYF-32 AND MUY<MPYF-16 THEN
  1389. 7050          IF MUX>MPXL+10 AND MUX<MPXL+58 THEN  GOSUB *CORD_EDIT
  1390. 7055          RETURN
  1391. 7060     ENDIF
  1392. 7065  Y=INT((MPYE-67)/18)
  1393. 7070  XL=INT((MUX-MPXL-10)/((CLX+2)*8))
  1394. 7075  IF ((MUX-MPXL-10) MOD ((CLX+2)*8))>0 THEN XL=XL+1
  1395. 7080  YL=INT((MUY-MPYL-35)/18)
  1396. 7085  IF YL<0 THEN *LINE_EXE8
  1397. 7090  COXP=(XL-1)*Y+YL+CSP8
  1398. 7095  *BSCR_P8X
  1399. 7100  IF COXP>COX THEN *CORD_INPUT
  1400. 7105  GOSUB *CORD_EXE
  1401. 7110  RETURN
  1402. 7115 '
  1403. 7120 *BSCR_P8B
  1404. 7125  IF MUY>MPYF-32 AND MUY<MPYF-16 THEN
  1405. 7130         IF MUX>MPXL+10 AND MUX<MPXL+58 THEN  GOSUB *CORD_EDIT
  1406. 7135         IF MUX>MPXL+66 AND MUX<MPXF-16 THEN  GOSUB *CORD_REFP
  1407. 7140         RETURN
  1408. 7145     ENDIF
  1409. 7150  IF MUY<MPYL+40 THEN *RET_CORDP
  1410. 7155  Y=INT((MPYE-92)/18)
  1411. 7160  XL=INT((MUX-MPXL-10)/((CSX+2)*8))
  1412. 7165  IF ((MUX-MPXL-10) MOD ((CSX+2)*8))>0 THEN XL=XL+1
  1413. 7170  YL=INT((MUY-MPYL-78)/18)+1
  1414. 7175  IF YL<0 THEN *LINE_EXE8B
  1415. 7180  COZP=(XL-1)*Y+YL+CSL8
  1416. 7185  IF COZP>COZ THEN *CORDNO_INPUT
  1417. 7190  GOSUB *CORDNO_EXE
  1418. 7195  RETURN
  1419. 7200 '
  1420. 7205 *LINE_EXEP
  1421. 7210  XL=MPXE/2-4*8
  1422. 7215  LINE (MPXL+XL-5,MPYL+35)-STEP(8*8+10,28),PSET,%BCL(0),BF,%BCL(6)
  1423. 7220  LINE (MPXL+XL,MPYL+40)-STEP(8*8,18),PSET,%BCL(0),BF,%BCL(5)
  1424. 7225  MX$="" :CRXF=MPXL+XL :CRYF=MPYL+41 :CRXE=CRXF+8*8 :CRYE=CRYF+16
  1425. 7230  CRLEN=7  :XLP=0  :CAR_END=0  :CRB=BCL(5)
  1426. 7235  GOSUB *INKEY_W
  1427. 7240  RETURN
  1428. 7245 '
  1429. 7250 *INKEY_WP
  1430. 7255  GOSUB *KEY_CR
  1431. 7260 *INKEY_W
  1432. 7265  WHILE MOUSE(2,0)=-1  :WEND
  1433. 7270  GOSUB *INKEY_P
  1434. 7275  MOUSE 5
  1435. 7280  RETURN 
  1436. 7285 '
  1437. 7290 *LINE_EXE8
  1438. 7295  GOSUB *LINE_EXEP
  1439. 7300  IF CAR_END=1 THEN CLX=VAL(MX$)+4
  1440. 7305  GOSUB *BOLD_P2
  1441. 7310  RETURN
  1442. 7315 '
  1443. 7320 *CORD_EXE
  1444. 7325  CRXF=MPXL+(XL-1)*((CLX+2)*8)+42 :CRXE=CRXF+CLX*8
  1445. 7330  CRYF=MPYL+YL*18+35              :CRYE=CRYF+18
  1446. 7335  IF CRXE>MPXF-16 AND (MPXE-16)>CLX*8                                            THEN VXU=CRXE-MPXF+16 :GOSUB *BOLD_BACK :                                          CRXF=CRXF-VXU :CRXE=CRXE-VXU
  1447. 7340  CAR_END=0            :CRLEN=CLX-3
  1448. 7345  IF REF_SW=1 THEN CRB=BCL(10)      ELSE CRB=BCL(5)
  1449. 7350  MX$=CORD$(COXP-1)    :XLP=LEN(MX$)
  1450. 7355  IF K$="" THEN GOSUB *KEY_CR     :WAIT WAIX    ELSE K$=""
  1451. 7360  MJ=MOUSE(3,0)
  1452. 7365  IF MJ>0 AND REF_SW=0 THEN VXU=0 :GOTO *CORDNO_INP
  1453. 7370  IF MJ=0 AND REF_SW=1 THEN VXU=0 :GOTO *CORDNO_INP
  1454. 7375  CRB=BCL(5)
  1455. 7380  GOSUB *INKEY_WP
  1456. 7385  IF RCLICK>0  THEN CRB=BCL(10) :GOSUB *KEY_CR  :GOSUB *KILL_P8  :                              GOSUB *CORD_SAVE  :GOTO 7395
  1457. 7390  IF CAR_END=1 THEN CORD$(COXP-1)=MX$ :GOSUB *CORD_SAVE
  1458. 7395  VXU=0  :GOSUB *BOLD_P2   :RCLICK=0
  1459. 7400  RETURN
  1460. 7405 '
  1461. 7410 *CORD_INPUT
  1462. 7415  IF COXP>=CDX THEN *FLL_CORD
  1463. 7420  CORD$(COXP)=""
  1464. 7425  CRXF=MPXL+(XL-1)*((CLX+2)*8)+42 :CRXE=CRXF+CLX*8
  1465. 7430  CRYF=MPYL+YL*18+35              :CRYE=CRYF+18
  1466. 7435  IF CRXE>MPXF-16 AND (MPXE-16)>CLX*8                                            THEN  VXU=CRXE-MPXF+16 :GOSUB *BOLD_P2 :                                          CRXF=CRXF-VXU :CRXE=CRXE-VXU
  1467. 7440  CAR_END=0            :CRLEN=CLX-3   :CRB=BCL(5)
  1468. 7445  MX$=""               :XLP=0
  1469. 7450  GOSUB *INKEY_WP
  1470. 7455  IF CAR_END=1 THEN GOSUB *CORD_SP_SET
  1471. 7460  VXU=0   :GOSUB *BOLD_P2  :RCLICK=0
  1472. 7465  RETURN
  1473. 7470 '
  1474. 7475 *CORDNO_INP
  1475. 7480  CRB=BCL(10)  :GOSUB *KEY_CR
  1476. 7485  CORP=COXP
  1477. 7490  CFX$=FIL$(9)+RIGHT$("00"+MID$(STR$(CORDN%(CORP-1)),2),3)+".dat"
  1478. 7495  GOSUB *CORDNO_LOAD
  1479. 7500  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  1480. 7505  MOUSE 1,,,0
  1481. 7510  GOSUB *BOLD_P
  1482. 7515  GOSUB *RET_W
  1483. 7520  RETURN
  1484. 7525 '
  1485. 7530 *LINE_EXE8B
  1486. 7535  GOSUB *LINE_EXEP
  1487. 7540  IF CAR_END=1 THEN CSX=VAL(MX$)+13
  1488. 7545  GOSUB *BOLD_P2
  1489. 7550  RETURN
  1490. 7555 '
  1491. 7560 *CORDNO_EXE
  1492. 7565  CRXF=MPXL+(XL-1)*((CSX+2)*8)+5 :CRXE=CRXF+CSX*8
  1493. 7570  CRYF=MPYL+YL*18+60             :CRYE=CRYF+18
  1494. 7575  IF CRXE>MPXF-16 AND (MPXE-16)>CSX*8                                            THEN  VXU=CRXE-MPXF+32 :GOSUB *BOLD_P2 :                                          CRXF=CRXF-VXU    :CRXE=CRXE-VXU
  1495. 7580  MX$=MID$(STR$(CONX(COZP-1)),2)+" "+COFX$(COZP-1)+"\"+                           MID$(STR$(COMX(COZP-1)),2)
  1496. 7585  XLP=LEN(MX$)    :CAR_END=0     :CRLEN=CSX+1
  1497. 7590  IF REF_SW=1 THEN CRB=BCL(10)    ELSE CRB=BCL(5)
  1498. 7595  GOSUB *KEY_CR
  1499. 7600  WAIT WAIX
  1500. 7605  IF MOUSE(3,0)=0 AND REF_SW=1  THEN VXU=0  :GOTO *CORDNO_PUT
  1501. 7610  CRB=BCL(5)
  1502. 7615  GOSUB *INKEY_WP
  1503. 7620  IF RCLICK>0  THEN CRB=BCL(10) :GOSUB *KEY_CR    :GOSUB *KILL_P8B  :                           GOSUB *CORDNO_SAVE  :GOTO 7630
  1504. 7625  IF CAR_END=1 THEN COZP=COZP-1 :GOSUB *SET_CORDNO :GOSUB *CORDNO_SAVE
  1505. 7630  VXU=0   :GOSUB *BOLD_P2   :RCLICK=0
  1506. 7635  RETURN
  1507. 7640 '
  1508. 7645 *CORDNO_INPUT
  1509. 7650  IF COZP>=CDZ THEN *FLL_CORDNO
  1510. 7655  CRXF=MPXL+(XL-1)*((CSX+2)*8)+5 :CRXE=CRXF+CSX*8
  1511. 7660  CRYF=MPYL+YL*18+60             :CRYE=CRYF+18
  1512. 7665  IF CRXE>MPXF-16 AND (MPXE-16)>CSX*8                                            THEN  VXU=CRXE-MPXF+32  :GOSUB *BOLD_P2 :                                         CRXF=CRXF-VXU     :CRXE=CRXE-VXU
  1513. 7670  MX$=MID$(STR$(CONX(COZP-1)),2)+" "+COFX$(COZP-1)+"\"+                           MID$(STR$(COMX(COZP-1)),2)
  1514. 7675  MX$=""   :XLP=0    :CAR_END=0   :CRLEN=CSX+1    :CRB=BCL(5)
  1515. 7680  GOSUB *INKEY_WP
  1516. 7685  IF CAR_END=1 THEN COZ=COZ+1 :COZP=COZ-1 :GOSUB *SET_CORDNO :                                    GOSUB *CORDNO_SAVE
  1517. 7690  VXU=0   :GOSUB *BOLD_P2   :RCLICK=0
  1518. 7695  RETURN
  1519. 7700 '
  1520. 7705 *SET_CORDNO
  1521. 7710  N=VAL(MX$)
  1522. 7715  IF N>0 THEN
  1523. 7720              P=INSTR(MX$," ")
  1524. 7725              IF P=0 THEN CONX(COZP)=N                                                           ELSE CONX(COZP)=VAL(LEFT$(MX$,P-1))
  1525. 7730              P=P+1
  1526. 7735         ELSE
  1527. 7740              P=1
  1528. 7745         ENDIF
  1529. 7750  A=INSTR(MX$,"\")
  1530. 7755  IF A=0 THEN A$=MID$(MX$,P)   ELSE A$=MID$(MX$,P,A-P) :                                                        COMX(COZP)=VAL(MID$(MX$,A+1))
  1531. 7760  IF A$<>"" THEN COFX$(COZP)=A$
  1532. 7765  RETURN
  1533. 7770 '
  1534. 7775 *EXE_NOP
  1535. 7780  FOR A=0 TO COZ-1
  1536. 7785      IF CONX(A)>N THEN *EXE_NOP2
  1537. 7790  NEXT A
  1538. 7795  RETURN
  1539. 7800 '
  1540. 7805 *EXE_NOP2
  1541. 7810  FOR B=COZ-1 TO A STEP -1
  1542. 7815      SWAP CONX(B),CONX(B-1)
  1543. 7820      SWAP COFX$(B),COFX$(B-1)
  1544. 7825      SWAP COMX(B),COMX(B-1)
  1545. 7830  NEXT B
  1546. 7835  RETURN
  1547. 7840 '
  1548. 7845 *CORDNO_PUT
  1549. 7850  CODN$=COFX$(COZP-1) :CODX=COMX(COZP-1)
  1550. 7855  JP=1   :GET_ON=1
  1551. 7860  NEXP=NEXP-1
  1552. 7865  MOUSE 5
  1553. 7870  RETURN
  1554. 7875 '
  1555. 7880 *BSCR_P8XB
  1556. 7885  FOR A=1 TO COZ
  1557. 7890      IF CONX(A-1)=P THEN  COZP=A  :GOTO *CORDNO_PUT
  1558. 7895  NEXT A
  1559. 7900  RETURN
  1560. 7905  '
  1561. 7910 *RET_CORDP
  1562. 7915  CORP=0
  1563. 7920  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  1564. 7925  MOUSE 1,,,0
  1565. 7930  GOSUB *BOLD_P
  1566. 7935  GOSUB *RET_W
  1567. 7940  RETURN
  1568. 7945 '
  1569. 7950 *KILL_P8
  1570. 7955  IF COXP>=CDX  THEN 7980
  1571. 7960  FOR A=COXP-1 TO COX-2
  1572. 7965      SWAP CORD$(A) ,CORD$(A+1)
  1573. 7970      SWAP CORDN%(A),CORDN%(A+1)
  1574. 7975  NEXT A
  1575. 7980  IF COX>0 THEN COX=COX-1
  1576. 7985  RETURN
  1577. 7990 '
  1578. 7995 *KILL_P8B
  1579. 8000  IF COZP>=CDZ  THEN 8030
  1580. 8005  FOR A=COZP-1 TO COZ-2
  1581. 8010       SWAP CONX(A) ,CONX(A+1)
  1582. 8015       SWAP COFX$(A),COFX$(A+1)
  1583. 8020       SWAP COMX(A) ,COMX(A+1)
  1584. 8025  NEXT A
  1585. 8030  IF COZ>0 THEN COZ=COZ-1
  1586. 8035  RETURN
  1587. 8040 '
  1588. 8045 *CORD_SP_SET
  1589. 8050  COX=COX+1
  1590. 8055  CORD$(COX-1)=MX$
  1591. 8060  FOR A=1 TO CDX
  1592. 8065      FOR B=0 TO COX-2
  1593. 8070          IF CORDN%(B)=A THEN 8085
  1594. 8075      NEXT B
  1595. 8080      GOTO 8095
  1596. 8085  NEXT A
  1597. 8090  A=0
  1598. 8095  CORDN%(COX-1)=A
  1599. 8100  GOSUB *CORD_SAVE
  1600. 8105  RETURN
  1601. 8110 '
  1602. 8115 *CORD_REFP
  1603. 8120  P=INT((MUX-MPXL-66)/8)               :'[編集] <-.A.ｱ.ｻ.ﾅ.ﾏ.ﾗ.->
  1604. 8125  IF P>16 THEN GOSUB *RET_W  :RETURN
  1605. 8130  IF P<2  THEN *MOVE_F
  1606. 8135  IF P>14 THEN *MOVE_E
  1607. 8140  IF P=2  THEN A$=" " :B$="@"
  1608. 8145  IF P=3  THEN A$="A" :B$="Z"
  1609. 8150  IF P=4  THEN A$="a" :B$="z"
  1610. 8155  IF P>4  AND  P<12 OR P=13 THEN                                                           A$=CHR$(ASC("ｱ")+(P-5)*5) :B$=CHR$(ASC(A$)+4)
  1611. 8160  IF P=12 THEN A$="ﾔ" :B$="ﾖ"
  1612. 8165  IF P=14 THEN A$="ﾜ" :B$="ﾝ"
  1613. 8170  GOSUB *REF_IND
  1614. 8175  IF P>0 THEN CSL8=P  :GOSUB *BOLD_BACK
  1615. 8180  RETURN
  1616. 8185  '
  1617. 8190 *REF_IND
  1618. 8195  P=0
  1619. 8200  FOR A=CSL8 TO COZ-1
  1620. 8205      C$=LEFT$(COFX$(A),1)
  1621. 8210      IF C$>=A$ AND C$=<B$ THEN P=A+1 :RETURN
  1622. 8215  NEXT A
  1623. 8220  RETURN
  1624. 8225  '
  1625. 8230 *MOVE_F
  1626. 8235  CSL8=1
  1627. 8240  GOSUB *BD_SUBP
  1628. 8245  RETURN
  1629. 8250  '
  1630. 8255 *MOVE_E
  1631. 8260  CSL8=COZ
  1632. 8265  GOSUB *BD_SUBP
  1633. 8270  RETURN
  1634. 8275 '
  1635. 8280 *CORDNO_LOAD
  1636. 8285  ON ERROR GOTO *ERR_NOP8L
  1637. 8290  OPEN "I",#1,CFX$
  1638. 8295       INPUT #1,COZ,CSX
  1639. 8300       FOR A=0 TO COZ-1
  1640. 8305           INPUT #1,CONX(A)
  1641. 8310           INPUT #1,COFX$(A)
  1642. 8315           INPUT #1,COMX(A)
  1643. 8320           IF EOF(1)=-1 THEN *CLIN_RET
  1644. 8325       NEXT A
  1645. 8330  *CLIN_RET
  1646. 8335  CLOSE #1
  1647. 8340  ON ERROR GOTO 0
  1648. 8345  CSL8=1
  1649. 8350  RETURN
  1650. 8355  '
  1651. 8360 *ERR_NOP8L
  1652. 8365  IF ERR<>63 THEN *ERR_MESE
  1653. 8370  COZ=0
  1654. 8375  RESUME *CLIN_RET
  1655. 8380  '
  1656. 8385 *CORDNO_SAVE
  1657. 8390  ON ERROR GOTO *ERR_NOP8S
  1658. 8395  OPEN "O",#1,CFX$
  1659. 8400        PRINT #1,COZ,CSX
  1660. 8405        FOR A=0 TO COZ-1
  1661. 8410            PRINT #1,CONX(A)
  1662. 8415            PRINT #1,COFX$(A)
  1663. 8420            PRINT #1,COMX(A)
  1664. 8425       NEXT A
  1665. 8430 *CSNO_RET
  1666. 8435  CLOSE #1
  1667. 8440  ON ERROR GOTO 0
  1668. 8445  RETURN
  1669. 8450  '
  1670. 8455 *ERR_NOP8S
  1671. 8460  IF ERR<>64 THEN *ERR_MESE
  1672. 8465  KILL CFX$
  1673. 8470  RESUME
  1674. 8475  '
  1675. 8480 *FLL_CORD
  1676. 8485  RESTORE *ERM_D1   :GOSUB *ERMD_SET
  1677. 8490  GOSUB *MESSAGE_P
  1678. 8495  RETURN
  1679. 8500 '
  1680. 8505 *FLL_CORDNO
  1681. 8510  RESTORE *ERM_D2   :GOSUB *ERMD_SET
  1682. 8515  GOSUB *MESSAGE_P
  1683. 8520  RETURN
  1684. 8525 '
  1685. 8530 *ERMD_SET
  1686. 8535  READ ERMX
  1687. 8540  FOR A=1 TO ERMX
  1688. 8545      READ ERM$(A-1),ERC(A-1)
  1689. 8550  NEXT A
  1690. 8555  RETURN
  1691. 8560  '
  1692. 8565 *ERM_D1
  1693. 8570  DATA 3
  1694. 8575  DATA "登録領域が一杯です",0
  1695. 8580  DATA "これ以上名称を登録する事は出来ません" ,10
  1696. 8585  DATA "不要な名称を削除してから登録し直してください",10
  1697. 8590  '
  1698. 8595 *ERM_D2
  1699. 8600  DATA 3
  1700. 8605  DATA "登録領域が一杯です",0
  1701. 8610  DATA "これ以上名称コードを登録する事は出来ません" ,10
  1702. 8615  DATA "不要な名称コードを削除してから登録し直してください",10
  1703. 8620  '
  1704. 8625  '------------------------------------------------------------------
  1705. 8630 *CORD_EDIT
  1706. 8635  X1=MPXL      :Y1=MPYL    :X2=MPXF    :Y2=MPYF
  1707. 8640  A=9          :GOSUB *SWAP_XY
  1708. 8645  MPXL=PXL%(13):MPYL=PYL%(13) :MPXE=PXE%(13) :MPYE=PYE%(13)
  1709. 8650  IF CORP>0 THEN EC(1)=CORP   ELSE EC(1)=CSP8
  1710. 8655  P=EC(1)    :GOSUB *PUT_COD
  1711. 8660  GOSUB *OPEN_P2
  1712. 8665  BCL(1)=BCL(18)  :BCL(9)=BCL(19)   :EC(2)=0   :EC(3)=0  :EC(0)=1
  1713. 8670  REW_X=MPXE :REW_Y=MPYE  :BDP=17   :BPQ=0     :EDCS=1   :EDX=COZ
  1714. 8675  MUX_S=MUX  :MUY_S=MUY   :EDSW=0   :SEP_SW=0  :EDCX=1
  1715. 8680  GOSUB *BOLD_P
  1716. 8685  GOSUB *SET_XYD
  1717. 8690  GOSUB *SEL_MXY
  1718. 8695  IF ER=1 THEN 8715
  1719. 8700  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN8I,*YL_UP8I,*XL_RIGHT8I,                      *XL_LEFT8I,*DRAG_B,*BSCR_P8I,*CSL_S8I,*CSL_D8I,*RET_W
  1720. 8705  IF JP<>1 THEN 8690
  1721. 8710  NEXP=NEXP+1
  1722. 8715  GOSUB *CLOSE_P2
  1723. 8720  PXL%(13)=MPXL :PYL%(13)=MPYL :PXE%(13)=MPXE :PYE%(13)=MPYE
  1724. 8725  A=9   :GOSUB *SWAP_XY  :MUX=MUX_S  :MUY=MUY_S
  1725. 8730  GOSUB *SET_XYD         :GOSUB *SCR_BACK
  1726. 8735  JP=9  :REW_X=PXE%(7)   :REW_Y=PYE%(7)
  1727. 8740  RETURN
  1728. 8745 '
  1729. 8750 *BD_17P
  1730. 8755  FILS$="名称コード [項目編集]"
  1731. 8760  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)   :                                 VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  1732. 8765  GOSUB *BD17_LINE
  1733. 8770  XL=MPXL :YL=MPYL+55
  1734. 8775  IF EC(1)>0 THEN
  1735. 8780          SYMBOL(XL,YL),RIGHT$("  "+STR$(EC(1)),3),1,1,%BCL(0)
  1736. 8785          SYMBOL(XL+35,YL),LEFT$(CORD$(EC(1)-1),CLX-4),1,1,%BCL(0)
  1737. 8790          X=XL+CLX*8+120  :Y=YL
  1738. 8795          FOR A=EC(0) TO COZ
  1739. 8800              SYMBOL(X,Y),RIGHT$("  "+STR$(CONX(A-1)),4),1,1,%BCL(0)
  1740. 8805              SYMBOL(X+36,Y),LEFT$(COFX$(A-1),CSX-13),1,1,%BCL(0)
  1741. 8810              B$="\"+STR$(COMX(A-1))
  1742. 8815              SYMBOL(X+(CSX-LEN(B$))*8,Y),B$,1,1,%BCL(0)
  1743. 8820              IF EDX%(A-1)=1 THEN LINE (X,Y)-STEP(CSX*8,16),                                                  XOR,%BCL(8),BF
  1744. 8825              Y=Y+18
  1745. 8830              IF Y>YL+160 THEN 8840
  1746. 8835              NEXT A
  1747. 8840     ENDIF
  1748. 8845  IF EC(2)>0 THEN
  1749. 8850          SYMBOL(XL,YL+54),RIGHT$("  "+STR$(EC(2)),3),1,1,%CL3
  1750. 8855          SYMBOL(XL+35,YL+54),LEFT$(CORD$(EC(2)-1),CLX-4),1,1,%CL3
  1751. 8860     ENDIF
  1752. 8865  IF EC(3)>0 THEN
  1753. 8870          SYMBOL(XL,YL+107),RIGHT$("  "+STR$(EC(3)),3),1,1,%BCL(0)
  1754. 8875          SYMBOL(XL+35,YL+107),LEFT$(CORD$(EC(3)-1),CLX-4),1,1,%BCL(0)
  1755. 8880     ENDIF
  1756. 8885  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  1757. 8890  GOSUB *CASOL_P8I  :GOSUB *CASOL_P8IB
  1758. 8895  RETURN
  1759. 8900 '
  1760. 8905 *BD17_LINE
  1761. 8910  IF CSX=0 THEN CSX=23
  1762. 8915  XL=MPXL+5  :YL=MPYL+50  :X=(CLX+2)*8
  1763. 8920  LINE (XL,YL+2)-STEP(X,20),PSET,%BCL(0),B
  1764. 8925  SYMBOL(XL,YL-20),"[編集項目]",1,1,%BCL(0)
  1765. 8930  IF SEP_SW=0 THEN CL1=BCL(10) :CL2=BCL(2)  :CL3=BCL(0) :CL4=BCL(3)                       ELSE CL1=BCL(2)  :CL2=BCL(10) :CL3=BCL(3) :CL4=BCL(0)
  1766. 8935  LINE (XL+INT(X/2),YL+23)-STEP(0,6),PSET,%CL3
  1767. 8940  LINE (XL+INT(X/2)-30,YL+29)-STEP(60,20),PSET,%CL3,BF,%CL1
  1768. 8945  SYMBOL(XL+INT(X/2)-20,YL+31),"結 合",1,1,%CL3
  1769. 8950  LINE (XL+INT(X/2),YL+50)-STEP(0,6),PSET,%CL3
  1770. 8955  LINE (XL,YL+56)-STEP(X,20),PSET,%CL3,B
  1771. 8960  LINE (XL+INT(X/2)+31,YL+39)-STEP(INT(X/2)-22,0),PSET,%CL3
  1772. 8965  LINE -STEP(0,44),PSET,%BCL(0)
  1773. 8970  LINE -STEP(-INT(X/2)-10,0),PSET,%BCL(0)
  1774. 8975  LINE -STEP(0,27),PSET,%BCL(0)
  1775. 8980  SYMBOL STEP(-INT(X/2),-18),"[保存先名称]",1,1,%BCL(0)
  1776. 8985  LINE STEP(0,18)-STEP(X,20),PSET,%BCL(0),B
  1777. 8990  CONNECT STEP(5,0)-STEP(0,-20)-STEP(17,0)-STEP(3,3)-STEP(0,17)-                       STEP(-20,0),%BCL(0),PSET,F,%BCL(2)
  1778. 8995  CONNECT STEP(2,-2)-STEP(0,-16)-STEP(2,0)-STEP(0,4)-STEP(12,0)-                      STEP(0,-4)-STEP(2,2)-STEP(0,14)-STEP(-2,0)-STEP(0,-4)-                      STEP(-12,0)-STEP(0,4)-STEP(-2,0),%BCL(0),PSET,F,%BCL(0)
  1779. 9000  LINE STEP(10,-16)-STEP(2,2),PSET,%BCL(0),BF
  1780. 9005  LINE STEP(-INT(X/2)-19,17)-STEP(0,7),PSET,%BCL(0)
  1781. 9010  LINE STEP(-30,0)-STEP(60,20),PSET,%BCL(0),B
  1782. 9015  SYMBOL STEP(-50,-18),"実 行",1,1,%BCL(0)
  1783. 9020  LINE (XL+X,YL+12)-STEP(100,0),PSET,%BCL(0),B
  1784. 9025  LINE STEP(0,-10)-STEP(CSX*8,162),PSET,%BCL(0),B
  1785. 9030  LINE (XL+X+10,YL+39)-STEP(15,0),PSET,%CL4
  1786. 9035  LINE STEP(0,-10)-STEP(60,20),PSET,%CL4,BF,%CL2
  1787. 9040  SYMBOL STEP(-50,-18),"分 離",1,1,%CL4
  1788. 9045  LINE STEP(50,8)-STEP(14,0),PSET,%CL4
  1789. 9050  SYMBOL (XL+X+100,YL-20),"[編集名称]",1,1,%BCL(0)
  1790. 9055  LINE (XL+X+200,YL-20)-STEP(32,16),PSET,%BCL(0),B
  1791. 9060  SYMBOL (XL+X+204,YL-19),"ALL",1,1,%BCL(0)
  1792. 9065  LINE (XL+X+25,YL+56)-STEP(60,20),PSET,%BCL(0),B
  1793. 9070  SYMBOL STEP(-55,-18),"123 順",1,1,%BCL(0)
  1794. 9075  LINE STEP(55,8)-STEP(15,0),PSET,%BCL(0)
  1795. 9080  LINE (XL+X+25,YL+83)-STEP(60,20),PSET,%BCL(0),B
  1796. 9085  SYMBOL STEP(-55,-18),"ｱｲｳ 順",1,1,%BCL(0)
  1797. 9090  LINE STEP(55,8)-STEP(15,0),PSET,%BCL(0)
  1798. 9095  RETURN
  1799. 9100  '
  1800. 9105 *YL_DOWN8I
  1801. 9110  EC(0)=EC(0)+1
  1802. 9115  IF EC(0)>EDX THEN EC(0)=EDX
  1803. 9120  GOSUB *BD_SUBP
  1804. 9125  RETURN
  1805. 9130  '
  1806. 9135 *YL_UP8I
  1807. 9140  EC(0)=EC(0)-1
  1808. 9145  IF EC(0)<1 THEN EC(0)=1
  1809. 9150  GOSUB *BD_SUBP
  1810. 9155  RETURN
  1811. 9160 '
  1812. 9165 *XL_RIGHT8I
  1813. 9170  L=INT((MPYE-71)/18)+1
  1814. 9175  EC(0)=EC(0)+L
  1815. 9180  IF EC(0)>EDX THEN EC(0)=EC(0)-L
  1816. 9185  GOSUB *BD_SUBP
  1817. 9190  RETURN
  1818. 9195 '
  1819. 9200 *XL_LEFT8I
  1820. 9205  L=INT((MPYE-71)/18)+1
  1821. 9210  EC(0)=EC(0)-L
  1822. 9215  IF EC(0)<1 THEN EC(0)=1
  1823. 9220  GOSUB *BD_SUBP
  1824. 9225  RETURN
  1825. 9230 '
  1826. 9235 *CASOL_P8I
  1827. 9240  A=EDX :B=EC(0)
  1828. 9245  GOSUB *CASOL_PX1
  1829. 9250  RETURN
  1830. 9255 '
  1831. 9260 *CASOL_P8IB
  1832. 9265  IF EDX<1 THEN C=1    ELSE C=EDX
  1833. 9270  A=MPXE-80 :B=((MPXE-80)/C)*(EC(0)-1)
  1834. 9275  GOSUB *CASOL_PX2
  1835. 9280  RETURN
  1836. 9285 '
  1837. 9290 *CSL_S8I
  1838. 9295  IF EC(0)=0 THEN GOSUB *RET_W :RETURN
  1839. 9300  A=EDX
  1840. 9305  GOSUB *ｶｰｿﾙ_SET1
  1841. 9310  EC(0)=P
  1842. 9315  GOSUB *BD_SUBP
  1843. 9320  RETURN
  1844. 9325 '
  1845. 9330 *CSL_D8I
  1846. 9335  IF EC(0)=0 THEN GOSUB *RET_W :RETURN
  1847. 9340  A=EDX
  1848. 9345  GOSUB *ｶｰｿﾙ_SET2
  1849. 9350  EC(0)=P
  1850. 9355  GOSUB *BD_SUBP
  1851. 9360  RETURN
  1852. 9365 '
  1853. 9370 *BSCR_P8I
  1854. 9375  XL=MPXL+5  :YL=MPYL+52  :X=(CLX+2)*8
  1855. 9380  IF MUX>XL+INT(X/2)-30 AND MUX<XL+INT(X/2)+30 THEN
  1856. 9385        IF MUY>YL+29 AND MUY<YL+49   THEN
  1857. 9390                                          MOUSE 1,,,0
  1858. 9395                                          SEP_SW=0  :GOSUB *BD_17P
  1859. 9400                                          GOTO 9515
  1860. 9405                                     ENDIF
  1861. 9410        IF MUY>YL+134 AND MUY<YL+154 THEN  GOSUB *EDIT_SP :GOTO 9515
  1862. 9415    ENDIF
  1863. 9420  IF MUX>XL AND MUX<XL+X THEN
  1864. 9425         IF MUY>YL     AND MUY<YL+20  THEN EDSW=1 :GOSUB *SUB_BSCRP8I
  1865. 9430         IF MUY>YL+54  AND MUY<YL+74  THEN EDSW=2 :GOSUB *SUB_BSCRP8I
  1866. 9435         IF MUY>YL+107 AND MUY<YL+127 THEN GOSUB *IK_EDP
  1867. 9440         RETURN
  1868. 9445     ENDIF
  1869. 9450  IF MUX>XL+X+5 AND MUX<XL+X+25 AND MUY>YL+107 AND MUY<YL+127 THEN               EDSW=3 :GOSUB *SUB_BSCRP8I :RETURN
  1870. 9455  IF MUX>XL+CLX*8+120 AND MUX<XL+(CLX+CSX)*8+120 AND MUY>YL AND                  MUY<YL+160 THEN  GOSUB *EDIT_NP
  1871. 9460  IF MUX>XL+X+25 AND MUX<XL+X+85 THEN
  1872. 9465         IF MUY>YL+29 AND MUY<YL+49  THEN  SEP_SW=1  :GOSUB *BACK_B17
  1873. 9470         IF MUY>YL+56 AND MUY<YL+76  THEN  GOSUB *RSAVE_ED1
  1874. 9475         IF MUY>YL+83 AND MUY<YL+103 THEN  GOSUB *RSAVE_ED2
  1875. 9480     ENDIF
  1876. 9485  IF MUX>XL+X+200 AND MUX<XL+X+232 AND MUY>YL-20 AND MUY<YL-4                    THEN
  1877. 9490          FOR A=0 TO 99 :IF EDX%(A)=1 THEN EDXP=0 :GOTO 9505
  1878. 9495          NEXT A
  1879. 9500          EDXP=1
  1880. 9505          GOSUB *SET_EDX  :GOSUB *BACK_B17
  1881. 9510     ENDIF
  1882. 9515  GOSUB *RET_W
  1883. 9520  RETURN
  1884. 9525 '
  1885. 9530 *BACK_B17
  1886. 9535  MOUSE 1,,,0 :GOSUB *BD_17P  :MOUSE 1,,,1
  1887. 9540  RETURN
  1888. 9545 '
  1889. 9550 *SUB_BSCRP8I
  1890. 9555  IF EDSW=2 THEN YL=YL+54  :SEP_SW=0
  1891. 9560  IF EDSW=3 THEN YL=YL+107
  1892. 9565  LINE (XL,YL)-STEP(X,20),XOR,%BCL(8),BF
  1893. 9570  EDX=COX
  1894. 9575  GOSUB *EDP_PUT
  1895. 9580  WHILE MOUSE(2,0)=-1   :WEND
  1896. 9585  GOSUB *EDP_MUS
  1897. 9590  EDCS=EC(0)  :GOSUB *BACK_B17
  1898. 9595  EDX=COZ     :EDSW=0
  1899. 9600  RETURN
  1900. 9605 '
  1901. 9610 *EDP_PUT
  1902. 9615  XL=MPXL+INT(MPXE/2)-INT(X/2)
  1903. 9620  YL=MPYL+25
  1904. 9625  LINE (XL,YL-5)-STEP(X+14,MPYE-38),PSET,%BCL(4),BF
  1905. 9630  LINE (XL,YL-5)-STEP(X,MPYE-40),PSET,%BCL(0),BF,%BCL(2)
  1906. 9635  FOR A=EDCX TO COX
  1907. 9640      SYMBOL(XL,YL+(A-EDCX)*18),RIGHT$("  "+STR$(A),3),1,1,%BCL(0)
  1908. 9645      SYMBOL(XL+35,YL+(A-EDCX)*18),LEFT$(CORD$(A-1),CLX-4),1,1,%BCL(0)
  1909. 9650      IF A=EC(EDSW) THEN LINE (XL,YL+(A-EDCX)*18)-STEP(X,18),                                              XOR,%BCL(8),BF
  1910. 9655      IF (A-EDCX)*18>MPYF-YL-50 THEN 9665
  1911. 9660  NEXT A
  1912. 9665  A=EDX :B=EDCX :GOSUB *ED_CSP
  1913. 9670  RETURN
  1914. 9675 '
  1915. 9680 *ED_CSP
  1916. 9685  XA=MPXL+INT(MPXE/2)+INT(X/2)
  1917. 9690  YA=MPYL+20
  1918. 9695  LINE (XA,YA)-STEP(12,MPYE-45),PSET,%BCL(0),BF,%BCL(5)
  1919. 9700  LINE (XA,YA)-STEP(12,12),PSET,%BCL(0),BF,%BCL(2)
  1920. 9705  CONNECT (XA+2,YA+9)-STEP(8,0)-STEP(-4,-6)-STEP(-4,6),                                %BCL(0),PSET,F,%BCL(0)
  1921. 9710  LINE (XA,YA+MPYE-52)-STEP(12,12),PSET,%BCL(0),BF,%BCL(2)
  1922. 9715  CONNECT STEP(-10,-9)-STEP(4,6)-STEP(4,-6)-STEP(-8,0),                                %BCL(0),PSET,F,%BCL(0)
  1923. 9720  IF A<1 THEN A=1
  1924. 9725  YL=INT((MPYE-76)/A)
  1925. 9730  IF A>1 THEN YR=(MPYE-76-YL)/(A-1)
  1926. 9735  Y =(B-1)*YR+YA+12
  1927. 9740  LINE (XA,Y)-STEP(12,YL+12),PSET,%BCL(0),BF,%BCL(1)
  1928. 9745  RETURN
  1929. 9750  '
  1930. 9755 *EDP_MUS
  1931. 9760  MX1=MPXL+INT(MPXE/2)-INT(X/2)
  1932. 9765  MY1=MPYL+20
  1933. 9770  MX2=MX1+X+12
  1934. 9775  MY2=MY1+MPYE-45
  1935. 9780  GOSUB *SEL_MXY
  1936. 9785  IF ER=1 THEN MOUSE 0 :GOTO 9825
  1937. 9790  IF MUX>MX2-12 AND MUX<MX2 THEN
  1938. 9795     IF MUY>MY1 AND MUY<MY1+12 THEN GOSUB *DW_EDC
  1939. 9800     IF MUY>MY2-12 AND MUY<MY2 THEN GOSUB *UP_EDC
  1940. 9805     GOTO 9780
  1941. 9810    ENDIF
  1942. 9815  EC(EDSW)=INT((MUY-MPYL-25)/18)+EDCX
  1943. 9820  IF EDSW=1 THEN P=EC(EDSW)  :GOSUB *PUT_COD  :EC(0)=1
  1944. 9825  MX1=0  :MY1=0  :MX2=639  :MY2=479
  1945. 9830  RETURN
  1946. 9835  '
  1947. 9840 *UP_EDC
  1948. 9845  WHILE MOUSE(2,0)=-1
  1949. 9850  EDCX=EDCX+1
  1950. 9855  IF EDCX>EDX THEN EDCX=EDX
  1951. 9860  GOSUB *EDP_PUT
  1952. 9865  WEND
  1953. 9870  RETURN
  1954. 9875  '
  1955. 9880 *DW_EDC
  1956. 9885  WHILE MOUSE(2,0)=-1
  1957. 9890  EDCX=EDCX-1
  1958. 9895  IF EDCX<1 THEN EDCX=1
  1959. 9900  GOSUB *EDP_PUT
  1960. 9905  WEND
  1961. 9910  RETURN
  1962. 9915 '
  1963. 9920 *PUT_COD
  1964. 9925  CFX$=FIL$(9)+RIGHT$("00"+MID$(STR$(CORDN%(P-1)),2),3)+".dat"
  1965. 9930  GOSUB *CORDNO_LOAD
  1966. 9935  EDXP=0  :GOSUB *SET_EDX
  1967. 9940  RETURN
  1968. 9945  '
  1969. 9950 *SET_EDX
  1970. 9955  FOR A=0 TO CDZ :EDX%(A)=EDXP :NEXT A
  1971. 9960  RETURN
  1972. 9965 '
  1973. 9970 *IK_EDP
  1974. 9975  CRXF=XL+5 :CRXE=XL+X  :CRYF=YL+110  :CRYE=YL+18   :CRLEN=CLX
  1975. 9980  EXE_SW=0  :XLP=0      :CRB=BCL(5)   :MX$=""
  1976. 9985  GOSUB *INKEY_WP
  1977. 9990  IF INK_END=1 OR MX$="" THEN 10010
  1978. 9995  IF CAR_END=1 THEN
  1979. 10000                    IF COX<CDX THEN GOSUB *CORD_SP_SET :EC(3)=COX
  1980. 10005               ENDIF
  1981. 10010  GOSUB *BD_17P
  1982. 10015  RETURN
  1983. 10020  '
  1984. 10025 *EDIT_NP
  1985. 10030  P=INT((MUY-MPYL-55)/18)+EC(0)
  1986. 10035  IF P>CDZ THEN RETURN
  1987. 10040  IF EDX%(P-1)=0 THEN EDX%(P-1)=1   ELSE EDX%(P-1)=0
  1988. 10045  GOSUB *BACK_B17
  1989. 10050  RETURN
  1990. 10055  '
  1991. 10060 *EDIT_SP
  1992. 10065  IF EC(3)=0 THEN RETURN
  1993. 10070  B=0
  1994. 10075  FOR A=0 TO COZ-1 :IF EDX%(A)=1 THEN B=B+1
  1995. 10080  NEXT A
  1996. 10085  IF B=0 THEN RETURN
  1997. 10090  IF SEP_SW=0 THEN IF EC(2)=0 THEN RETURN                                                                 ELSE GOSUB *EDIT_SAVE2  :GOTO 10105
  1998. 10095  CFX$=FIL$(9)+RIGHT$("00"+MID$(STR$(CORDN%(EC(3)-1)),2),3)+".dat"
  1999. 10100  GOSUB *EDIT_SAVE  :P=EC(1)  :GOSUB *PUT_COD
  2000. 10105  LINE (MPXL+INT(MPXE/2)-65,MPYL+INT(MPYE/2)-15)-STEP(130,30),                                  PSET,%BCL(0),BF,%BCL(3)
  2001. 10110  IF ER=0 THEN A$="正常終了しました"   ELSE A$="over end !!"
  2002. 10115  SYMBOL STEP(-128,-25),A$,1,1,%BCL(0)
  2003. 10120  X=MOUSE(9) :Y=MOUSE(10)
  2004. 10125  IF  MOUSE(9)=0 AND MOUSE(10)=0  THEN 10125
  2005. 10130  GOSUB *BACK_B17
  2006. 10135  RETURN
  2007. 10140  '
  2008. 10145 *EDIT_SAVE
  2009. 10150  ON ERROR GOTO *ERR_EDSV
  2010. 10155  OPEN "O",#1,CFX$
  2011. 10160        PRINT #1,B,CSX
  2012. 10165        FOR A=0 TO COZ-1
  2013. 10170            IF EDX%(A)=0 THEN 10190
  2014. 10175            PRINT #1,CONX(A)
  2015. 10180            PRINT #1,COFX$(A)
  2016. 10185            PRINT #1,COMX(A)
  2017. 10190       NEXT A
  2018. 10195 *EDSV_RET
  2019. 10200  CLOSE #1
  2020. 10205  ON ERROR GOTO 0
  2021. 10210  RETURN
  2022. 10215  '
  2023. 10220 *ERR_EDSV
  2024. 10225  IF ERR<>64 THEN *ERR_MESE
  2025. 10230  KILL CFX$
  2026. 10235  RESUME
  2027. 10240 '
  2028. 10245 *EDIT_SAVE2
  2029. 10250  CFX$=FIL$(9)+"wk1.dat"
  2030. 10255  GOSUB *EDIT_SAVE
  2031. 10260  P=EC(2)
  2032. 10265  GOSUB *PUT_COD
  2033. 10270  ER=0
  2034. 10275  CFX$=FIL$(9)+RIGHT$("00"+MID$(STR$(CORDN%(EC(3)-1)),2),3)+".dat"
  2035. 10280  CFX1$=FIL$(9)+"wk1.dat"
  2036. 10285  ON ERROR GOTO *ERR_EDSV
  2037. 10290  OPEN "O",#1,CFX$
  2038. 10295  OPEN "I",#2,CFX1$
  2039. 10300        INPUT #2,B,CSX
  2040. 10305        E=COZ+B  :IF E>CDZ THEN E=CDZ :ER=1
  2041. 10310        PRINT #1,E,CSX
  2042. 10315        FOR A=0 TO B-1
  2043. 10320            INPUT #2,C
  2044. 10325            PRINT #1,C
  2045. 10330            INPUT #2,A$
  2046. 10335            PRINT #1,A$
  2047. 10340            INPUT #2,D
  2048. 10345            PRINT #1,D
  2049. 10350        NEXT A
  2050. 10355        B=B+1
  2051. 10360        FOR A=B TO E
  2052. 10365            PRINT #1,CONX(A-B)
  2053. 10370            PRINT #1,COFX$(A-B)
  2054. 10375            PRINT #1,COMX(A-B)
  2055. 10380        NEXT A
  2056. 10385  *EDSV_RET2
  2057. 10390  CLOSE #1,#2  :B$=FIL$(9)+"wk1.dat" :KILL B$
  2058. 10395  ON ERROR GOTO 0
  2059. 10400  P=EC(1) :GOSUB *PUT_COD
  2060. 10405  RETURN
  2061. 10410  '
  2062. 10415 *RSAVE_ED1
  2063. 10420  LINE (XL+X+26,YL+55)-STEP(58,18),XOR,%BCL(8),BF
  2064. 10425  GOSUB *RSAVE_MSP
  2065. 10430  FOR A=0 TO COZ-2
  2066. 10435      C=CONX(A)
  2067. 10440      FOR B=A+1 TO COZ-1
  2068. 10445          IF C>CONX(B) THEN GOSUB *SWAP_CNX :C=CONX(A)
  2069. 10450      NEXT B
  2070. 10455  NEXT A
  2071. 10460  EC(3)=EC(1)  :SEP_SW=1  :EDXP=0  :GOSUB *SET_EDX
  2072. 10465  GOSUB *BACK_B17
  2073. 10470  RETURN
  2074. 10475  '
  2075. 10480 *RSAVE_ED2
  2076. 10485  LINE (XL+X+26,YL+82)-STEP(58,18),XOR,%BCL(8),BF
  2077. 10490  GOSUB *RSAVE_MSP
  2078. 10495  FOR A=0 TO COZ-2
  2079. 10500      A$=COFX$(A)
  2080. 10505      FOR B=A+1 TO COZ-1
  2081. 10510          IF A$>COFX$(B) THEN GOSUB *SWAP_CNX :A$=COFX$(A)
  2082. 10515      NEXT B
  2083. 10520  NEXT A
  2084. 10525  EC(3)=EC(1)  :SEP_SW=1  :EDXP=0  :GOSUB *SET_EDX
  2085. 10530  GOSUB *BACK_B17
  2086. 10535  RETURN
  2087. 10540 '
  2088. 10545 *SWAP_CNX
  2089. 10550  SWAP CONX(A),CONX(B)
  2090. 10555  SWAP COFX$(A),COFX$(B)
  2091. 10560  SWAP COMX(A),COMX(B)
  2092. 10565  RETURN
  2093. 10570  '
  2094. 10575 *RSAVE_MSP
  2095. 10580  LINE (XL+X+25,YL+27)-STEP(60,20),PSET,%BCL(0),BF,%BCL(10)
  2096. 10585  SYMBOL STEP(-55,-18),"実行中",1,1,%BCL(0)
  2097. 10590  RETURN
  2098. 10595  '------------------------------------------------------------------
  2099. 10600 *INKEY_P
  2100. 10605  INK_END=0  :CAR_END=0  :GET_POINT=0  :LCLICK=0  :RCLICK=0  :TW=0
  2101. 10610  WHILE MOUSE(2,0)=0
  2102. 10615        B$=""
  2103. 10620        A$=INKEY$+INKEY$
  2104. 10625        IF A$<>"" THEN B$=B$+A$ :GOTO 10620
  2105. 10630        IF B$<>"" THEN
  2106. 10635                       IF EXE_SW=1 AND B$="@" THEN LCLICK=1 :RETURN
  2107. 10640                       GOSUB *CAR_PUT
  2108. 10645                       IF CAR_END=1 THEN RETURN
  2109. 10650                  ENDIF
  2110. 10655        IF MOUSE(2,1)=-1 THEN
  2111. 10660                              MUX=MOUSE(4,1)  :MUY=MOUSE(5,1)
  2112. 10665                              INK_END=1
  2113. 10670                              RETURN
  2114. 10675                         ENDIF
  2115. 10680        IF (TIME MOD 2)=TW THEN GOSUB *CR_POINT  :                                                          IF TW=0 THEN TW=1   ELSE TW=0
  2116. 10685  WEND
  2117. 10690  MUX=MOUSE(4,0)  :MUY=MOUSE(5,0)     :RCLICK=MOUSE(3,1)
  2118. 10695  WHILE MOUSE(2,0)=-1
  2119. 10700  WEND
  2120. 10705  WAIT WAIX       :LCLICK=MOUSE(3,0)  :RCLICK=MOUSE(3,1)
  2121. 10710  IF MUX>CRXF AND MUX<CRXE AND MUY>CRYF AND MUY<CRYE                             THEN
  2122. 10715         GOSUB *KEY_CR
  2123. 10720         XLP=INT((MUX-CRXF)/8)
  2124. 10725         YLP=INT((MUY-CRYF)/18)
  2125. 10730         IF LCLICK>0 OR RCLICK>0 THEN  RETURN    ELSE  *INKEY_P
  2126. 10735     ENDIF
  2127. 10740  GET_POINT=1
  2128. 10745  RETURN
  2129. 10750 '  
  2130. 10755 *CAR_PUT
  2131. 10760  IF LEN(B$)>1 THEN IF LEN(B$) MOD 2 THEN                                        IF ASC(RIGHT$(B$,1))<32 THEN B$=LEFT$(B$,LEN(B$)-1)
  2132. 10765  IF JIS(B$)>31  AND  JIS(B$)<>&H7F THEN
  2133. 10770                       P=LEN(MX$)
  2134. 10775                       IF P>XLP THEN
  2135. 10780                                      MX$=LEFT$(MX$,XLP)+                                                             B$+MID$(MX$,XLP+1)
  2136. 10785                                      XLP=XLP+LEN(B$)
  2137. 10790                                ELSE
  2138. 10795                                      MX$=MX$+B$
  2139. 10800                                      XLP=LEN(MX$)
  2140. 10805                                ENDIF
  2141. 10810                       GOSUB *KEY_CR
  2142. 10815                  ENDIF
  2143. 10820  IF B$<>"" THEN E=JIS(B$)   ELSE  RETURN
  2144. 10825  IF (E<32 AND E>0) OR E=&H7F THEN *SUBKEY 
  2145. 10830  RETURN
  2146. 10835  '
  2147. 10840 *SUBKEY
  2148. 10845  IF E=&H7F THEN A=KLEN(MID$(MX$,XLP+1,2))  :XLP=XLP+3-A :E=8
  2149. 10850  IF E=13   THEN CAR_END=1 :RETURN
  2150. 10855  IF E=8    THEN GOSUB *BAKSP
  2151. 10860  IF E=29 AND XLP>0 THEN
  2152. 10865                        GOSUB *BAKSP_SUB
  2153. 10870                        XLP=XLP-F
  2154. 10875                        IF XLP<0 THEN XLP=0
  2155. 10880                    ENDIF
  2156. 10885  IF E=28 AND XLP<LEN(MX$)+1 THEN
  2157. 10890                        GOSUB *BAKSP_SUB
  2158. 10895                        XLP=XLP+F
  2159. 10900                        IF XLP>LEN(MX$) THEN XLP=XLP-A
  2160. 10905                    ENDIF
  2161. 10910  GOSUB *KEY_CR
  2162. 10915  RETURN
  2163. 10920 '
  2164. 10925 *BAKSP
  2165. 10930  GOSUB *BAKSP_SUB
  2166. 10935  IF XLP-F>0 THEN A$=LEFT$(MX$,XLP-F)         ELSE A$=""
  2167. 10940  IF XLP=<LEN(MX$) THEN B$=MID$(MX$,XLP+1)    ELSE B$=""
  2168. 10945  MX$=A$+B$
  2169. 10950  XLP=XLP-F
  2170. 10955  IF XLP<0 THEN XLP=0
  2171. 10960  RETURN
  2172. 10965 '
  2173. 10970 *BAKSP_SUB
  2174. 10975  IF XLP>1 THEN
  2175. 10980               A=KLEN(MID$(MX$,XLP-1,2))
  2176. 10985               IF A=1 THEN F=2    ELSE F=1
  2177. 10990           ELSE
  2178. 10995               F=1
  2179. 11000           ENDIF
  2180. 11005  RETURN
  2181. 11010  '
  2182. 11015 *KEY_CR
  2183. 11020  LINE (CRXF,CRYF)-STEP(CRLEN*8,16),PSET,%CRB,BF
  2184. 11025  IF MX$="" THEN RETURN
  2185. 11030  IF XLP>CRLEN-1 AND LEN(MX$)>CRLEN-1                                                    THEN C$=MID$(MX$,(XLP-CRLEN+2),CRLEN-1)                                     ELSE C$=LEFT$(MX$,CRLEN-1)
  2186. 11035  SYMBOL (CRXF,CRYF),C$,1,1,%BCL(0)
  2187. 11040  RETURN
  2188. 11045 '
  2189. 11050 *CR_POINT
  2190. 11055  IF CRLEN=<XLP THEN  CSW=CRLEN-1   ELSE  CSW=XLP
  2191. 11060  IF MX$="" THEN CSW=0
  2192. 11065  LINE (CRXF+CSW*8+1,CRYF+14)-STEP(6,0),XOR,%BCL(7)
  2193. 11070  RETURN
  2194. 11075 '-------------------------------------------------------------------
  2195. 11080 *NOTO_P 
  2196. 11085  A=NP(NEXP)   :GOSUB *SWAP_XY
  2197. 11090  MPXL=PXL%(5) :MPYL=PYL%(5)  :MPXE=PXE%(5)  :MPYE=PYE%(5)
  2198. 11095  A=5          :GOSUB *OPEN_P
  2199. 11100  *NOTO_P2
  2200. 11105  BDP=6  :YLW=75  :YU=28  :BPQ=0  :WKST=1  :REF_SW=0
  2201. 11110  GOSUB *SEL_WAKP
  2202. 11115  IF JPQ=1 THEN GOTO *NEX_P
  2203. 11120  RETURN
  2204. 11125 '
  2205. 11130 *KOMOK_LOAD
  2206. 11135  ON ERROR GOTO *ERR_P6L
  2207. 11140  OPEN "I",#1,FIL$(7)
  2208. 11145      INPUT #1,KOZ,KOML
  2209. 11150      FOR A=1 TO KOZ
  2210. 11155          INPUT #1,KOM$(A)
  2211. 11160          INPUT #1,KMT%(A)
  2212. 11165          IF EOF(1)=-1 THEN *KLOAD_RET
  2213. 11170      NEXT A
  2214. 11175  *KLOAD_RET
  2215. 11180  CLOSE #1
  2216. 11185  ON ERROR GOTO 0
  2217. 11190  KMCS=1
  2218. 11195  RETURN
  2219. 11200 '
  2220. 11205 *ERR_P6L
  2221. 11210  IF ERR<>63 THEN *ERR_MESE
  2222. 11215  KOZ=0  :KOML=12
  2223. 11220  RESUME *KLOAD_RET
  2224. 11225 '
  2225. 11230 *KOMOK_SAVE
  2226. 11235  ON ERROR GOTO *ERR_P6S
  2227. 11240  OPEN "O",#1,FIL$(7)
  2228. 11245       PRINT #1,KOZ,KOML
  2229. 11250       FOR A=1 TO KOZ
  2230. 11255           PRINT #1,KOM$(A)
  2231. 11260           PRINT #1,KMT%(A)
  2232. 11265       NEXT A
  2233. 11270  *KSAVE_RET
  2234. 11275  CLOSE #1
  2235. 11280  ON ERROR GOTO 0
  2236. 11285  RETURN
  2237. 11290 '
  2238. 11295 *ERR_P6S
  2239. 11300  IF ERR<>64 THEN *ERR_MESE
  2240. 11305  KILL FIL$(7)
  2241. 11310  RESUME
  2242. 11315 '
  2243. 11320 *BD_6P
  2244. 11325  WINDOW (MPXL+VXL+1,MPYL+17)-(MPXF+VXL-17,MPYF-17)
  2245. 11330  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  2246. 11335  B=(((RXY-84)+INT((RXY-84)/4)) MOD 7) :M=RXM :GOSUB *YOBI_P
  2247. 11340  DPZ=((7-C+RXD) MOD 7)
  2248. 11345  FILS$="家 計 簿 [登録] "+KFX$
  2249. 11350  YMD$=RIGHT$(" "+STR$(RXY),2)+"年"+RIGHT$(" "+STR$(RXM),2)+"月"+                    RIGHT$(" "+STR$(RXD),2)+"日 ↑↓ ["+YOBI$(DPZ)+"曜日]"
  2250. 11355  SYMBOL(MPXL+10,MPYL+20),YMD$,1,1,%BCL(0)
  2251. 11360  SYMBOL(MPXL-50,MPYL+YLW-20),"No",1,1,%BCL(0)
  2252. 11365  GOSUB *SYOKEI_P  :GOSUB *BD6_LINE
  2253. 11370  SYMBOL(MPXL+110,MPYL+YLW-15),STR$(KSX-64),.7!,.7!,%BCL(0)
  2254. 11375  IF KMAX(PDX)=0  THEN 11680
  2255. 11380  XL=MPXL+5  :YL=MPYL+YLW  :E=12  :CL=BCL(0)
  2256. 11385  FOR A=CSP6 TO KMAX(PDX)
  2257. 11390      SYMBOL(XL-10-LEN(STR$(A))*8,YL),STR$(A)+".",1,1,%BCL(0)
  2258. 11395      A$=KOM$(KMI%(PDX,A-1))  :P=KOML   :PL=0  :GOSUB *PUT_DAT
  2259. 11400      A$=KNE$(PDX,A-1) :P=KSX-64 :PL=12*8 :GOSUB *PUT_DAT
  2260. 11405      T=KMT%(KMI%(PDX,A-1))
  2261. 11410      IF T=1 OR T=5 THEN *NEXT_P1N
  2262. 11415      IF T=2        THEN *NEXT_P4N
  2263. 11420      IF T=3        THEN *NEXT_P3N
  2264. 11425                      TA&=KIN&(PDX,A-1)         :TB=KSU%(PDX,A-1)
  2265. 11430                      IF T=4                     THEN  *NEXT_P7N
  2266. 11435                      IF TA&*TB>=10^8            THEN  *NEXT_P7N 
  2267. 11440                      A$=STR$(TA&)                              :'金額
  2268. 11445                      P=KSX-42  :PL=(KSX-50)*8  :GOSUB *CONMA_P
  2269. 11450                      GOSUB *PUT_DAT
  2270. 11455 '                                                              :'数
  2271. 11460                      A$=STR$(TB)
  2272. 11465                      P=KSX-36  :PL=(KSX-42)*8  :GOSUB *CONMA_P
  2273. 11470                      GOSUB *PUT_DAT
  2274. 11475      *NEXT_P7N                                                 :'支出
  2275. 11480                      TC#=TA&*TB  :A$=STR$(TC#)
  2276. 11485                      P=KSX-24  :PL=(KSX-36)*8  :GOSUB *CONMA_P
  2277. 11490                      GOSUB *PUT_DAT
  2278. 11495                      GOTO *NEXT_P2N
  2279. 11500      *NEXT_P1N                                                 :'収入
  2280. 11505                      A$=STR$(KIN&(PDX,A-1))
  2281. 11510                      P=KSX-12  :PL=(KSX-24)*8  :GOSUB *CONMA_P
  2282. 11515                      GOSUB *PUT_DAT
  2283. 11520      *NEXT_P2N                                                 :'残高
  2284. 11525                      ZANX#=ZANX#-(KIN&(PDX,A-1)*KSU%(PDX,A-1))
  2285. 11530                      A$=STR$(ZANX#)
  2286. 11535                      P=KSX     :PL=(KSX-12)*8  :GOSUB *CONMA_P
  2287. 11540                      GOSUB *PUT_DAT
  2288. 11545                      IF T=5  THEN *NEXT_P8N
  2289. 11550                      IF T<>4 THEN *NEXT_P5N
  2290. 11555      *NEXT_P3N
  2291. 11560                      A$=STR$(KIN&(PDX,A-1))
  2292. 11565                      P=KSX+18   :PL=(KSX+6)*8  :GOSUB *CONMA_P
  2293. 11570                      GOSUB *PUT_DAT
  2294. 11575                      SYMBOL(XL+(KSX-50)*8,YL),"口座振込",1,1,%BCL(0)
  2295. 11580                      IF T=4 THEN *NEXT_P6N
  2296. 11585                      P=KSX-12   :PL=(KSX-24)*8
  2297. 11590                      GOSUB *PUT_DAT
  2298. 11595                      GOTO  *NEXT_P6N
  2299. 11600      *NEXT_P4N
  2300. 11605                      SYMBOL(XL+(KSX-50)*8,YL),"口座払い",1,1,%BCL(0)
  2301. 11610                      A$=STR$(KIN&(PDX,A-1))
  2302. 11615                      P=KSX-24   :PL=(KSX-36)*8  :GOSUB *CONMA_P
  2303. 11620                      GOSUB *PUT_DAT
  2304. 11625      *NEXT_P8N
  2305. 11630                      A$=STR$(KIN&(PDX,A-1))
  2306. 11635                      P=KSX+30   :PL=(KSX+18)*8  :GOSUB *CONMA_P
  2307. 11640                      GOSUB *PUT_DAT
  2308. 11645      *NEXT_P6N
  2309. 11650                      A$=LEFT$(KNE$(PDX,A-1),12)
  2310. 11655                      SYMBOL(XL+(KSX+30)*8+4,YL),A$,1,1,%BCL(0)
  2311. 11660      *NEXT_P5N
  2312. 11665                      YL=YL+18
  2313. 11670                      IF YL>MPYF-52 THEN 11680
  2314. 11675  NEXT A
  2315. 11680  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  2316. 11685  GOSUB *CASOL_P6  :GOSUB *CASOL_P6B
  2317. 11690  RETURN
  2318. 11695 '
  2319. 11700 *PUT_DAT
  2320. 11705  B$=LEFT$(A$,P)
  2321. 11710  IF PL>E*8 THEN PL=PL+((P-INT(PL/8))-LEN(B$))*8
  2322. 11715  SYMBOL(XL+PL,YL),B$,1,1,%CL
  2323. 11720  RETURN
  2324. 11725 '
  2325. 11730 *BD6_LINE
  2326. 11735  IF KSX=0 THEN KSX=76
  2327. 11740  XL=MPXL+5  :YL=MPYL+YLW-5
  2328. 11745  '
  2329. 11750      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  2330. 11755      LINE (XL+KSX*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2331. 11760      LINE (XL,YL  )-STEP((KSX+2)*8-16,0),PSET,%BCL(0)
  2332. 11765      SYMBOL(XL,YL-YU),"[項 目]",1,1,%BCL(0)
  2333. 11770      LINE (XL+12*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2334. 11775      SYMBOL(XL+12*8,YL-YU),"[名 称]",1,1,%BCL(0)
  2335. 11780      LINE (XL+(KSX-52)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2336. 11785      SYMBOL(XL+(KSX-52)*8,YL-YU),"[金 額]",1,1,%BCL(0)
  2337. 11790      LINE (XL+(KSX-42)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2338. 11795      SYMBOL(XL+(KSX-42)*8,YL-YU),"[数量]",1,1,%BCL(0)
  2339. 11800      LINE (XL+(KSX-36)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2340. 11805      SYMBOL(XL+(KSX-36)*8,YL-YU),"[支 出]",1,1,%BCL(0)
  2341. 11810      LINE (XL+(KSX-24)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2342. 11815      SYMBOL(XL+(KSX-24)*8,YL-YU),"[収 入]",1,1,%BCL(0)
  2343. 11820      LINE (XL+(KSX-12)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2344. 11825      SYMBOL(XL+(KSX-12)*8,YL-YU),"[残 高]  →",1,1,%BCL(0)
  2345. 11830      LINE (XL+(KSX-42)*8,YL-34)-STEP(42*8,0),PSET,%BCL(0)
  2346. 11835      LINE (XL+(KSX-42)*8,YL-52)-STEP(42*8,18),XOR,%BCL(24),BF
  2347. 11840      SYMBOL(XL+(KSX-42)*8+4,YL-50),"小 計",1,1,%BCL(0)
  2348. 11845      LINE (XL+(KSX-36)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  2349. 11850      A$=STR$(ZAN1#)  :GOSUB *CONMA_P  :P=LEN(A$)
  2350. 11855      SYMBOL(XL+(KSX-24-P)*8,YL-50),A$,1,1,%BCL(0)
  2351. 11860      LINE (XL+(KSX-24)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  2352. 11865      A$=STR$(ZAN2#)  :GOSUB *CONMA_P  :P=LEN(A$)
  2353. 11870      SYMBOL(XL+(KSX-12-P)*8,YL-50),A$,1,1,%BCL(0)
  2354. 11875      LINE (XL+(KSX-12)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  2355. 11880      A$=STR$(ZAN3#)  :GOSUB *CONMA_P  :P=LEN(A$)
  2356. 11885      SYMBOL(XL+(KSX-P)*8,YL-50),A$,1,1,%BCL(0)
  2357. 11890      LINE (XL+KSX*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  2358. 11895      LINE  (XL+(KSX+6 )*8,YL-51)-STEP(64,18),PSET,%BCL(0),BF,%BCL(10)
  2359. 11900      SYMBOL(XL+(KSX+6 )*8,YL-50),"取扱銀行",1,1,%BCL(0)
  2360. 11905      LINE  (XL+(KSX+6 )*8,YL   )-STEP(36*8,0),PSET,%BCL(0)
  2361. 11910      LINE  (XL+(KSX+6 )*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2362. 11915      LINE  (XL+(KSX+18)*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2363. 11920      LINE  (XL+(KSX+30)*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2364. 11925      LINE  (XL+(KSX+42)*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2365. 11930      SYMBOL(XL+(KSX+ 2)*8,YL-28)," ← [口座振込]",1,1,%BCL(0)
  2366. 11935      SYMBOL(XL+(KSX+18)*8,YL-28),"[口座払い]",1,1,%BCL(0)
  2367. 11940      SYMBOL(XL+(KSX+30)*8,YL-28),"[名 目]",1,1,%BCL(0)
  2368. 11945      LINE  (XL+(KSX+48)*8,YL   )-STEP(16*8,0),PSET,%BCL(0)
  2369. 11950      LINE  (XL+(KSX+48)*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2370. 11955      LINE  (XL+(KSX+64)*8,YL-5 )-STEP(0,7),PSET,%BCL(0)
  2371. 11960      SYMBOL(XL+(KSX+48)*8,YL-28),"[銀行名]  ↑ ↓",1,1,%BCL(0)
  2372. 11965      YL=MPYF-36
  2373. 11970      LINE (XL+(KSX-42)*8,YL   )-STEP(42*8,0),PSET,%BCL(0)
  2374. 11975      LINE (XL+(KSX-36)*8,YL-2 )-STEP(0,7),PSET,%BCL(0)
  2375. 11980      LINE (XL+(KSX-24)*8,YL-2 )-STEP(0,7),PSET,%BCL(0)
  2376. 11985      LINE (XL+(KSX-12)*8,YL-2 )-STEP(0,7),PSET,%BCL(0)
  2377. 11990      LINE (XL+ KSX*8    ,YL-2 )-STEP(0,7),PSET,%BCL(0)
  2378. 11995      LINE (XL-4,YL+1)-STEP((KSX-42)*8+4,18),XOR,%BCL(29),BF
  2379. 12000      LINE (XL+(KSX-42)*8,YL+1)-STEP(42*8,18),XOR,%BCL(21),BF
  2380. 12005      SYMBOL(XL+10,YL+2),"[文頭] [文末] [挿入]",1,1,%BCL(0)
  2381. 12010      SYMBOL(XL+(KSX-42)*8+4,YL+2),"合 計",1,1,%BCL(0)
  2382. 12015      A$=STR$(ZAN4#+ZAN1#)  :GOSUB *CONMA_P  :P=LEN(A$)
  2383. 12020      SYMBOL(XL+(KSX-24-P)*8,YL+3),A$,1,1,%BCL(0)
  2384. 12025      A$=STR$(ZAN5#+ZAN2#)  :GOSUB *CONMA_P  :P=LEN(A$)
  2385. 12030      SYMBOL(XL+(KSX-12-P)*8,YL+3),A$,1,1,%BCL(0)
  2386. 12035      A$=STR$(BZAN1#+ZAN3#) :GOSUB *CONMA_P  :P=LEN(A$)
  2387. 12040      SYMBOL(XL+(KSX-P)*8,YL+3),A$,1,1,%BCL(0)
  2388. 12045      IF BANKP>0 THEN SYMBOL(XL+(KSX+18)*8,MPYL+20),                                                LEFT$(BNAME$(BANKP-1),16),1,1,%BCL(0)
  2389. 12050      XL=XL+(KSX+48)*8  :YL=MPYL+YLW  :GOSUB *BANKN_PUT
  2390. 12055  RETURN
  2391. 12060 '
  2392. 12065 *YL_DOWN6
  2393. 12070  CSP6=CSP6+1
  2394. 12075  IF CSP6>KMAX(PDX) THEN CSP6=KMAX(PDX)
  2395. 12080  GOSUB *BD_SUBP
  2396. 12085  RETURN
  2397. 12090 '
  2398. 12095 *YL_UP6
  2399. 12100  CSP6=CSP6-1
  2400. 12105  IF CSP6<1 THEN CSP6=1
  2401. 12110  GOSUB *BD_SUBP
  2402. 12115  RETURN
  2403. 12120 '
  2404. 12125 *XL_LEFT6
  2405. 12130  VXL=VXL-100
  2406. 12135  GOSUB *BD_SUBP
  2407. 12140  RETURN
  2408. 12145 '
  2409. 12150 *XL_RIGHT6
  2410. 12155  VXL=VXL+100
  2411. 12160  GOSUB *BD_SUBP
  2412. 12165  RETURN
  2413. 12170 '
  2414. 12175 *CASOL_P6
  2415. 12180  A=KMAX(PDX) :B=CSP6
  2416. 12185  GOSUB *CASOL_PX1
  2417. 12190  RETURN
  2418. 12195 '
  2419. 12200 *CASOL_P6B
  2420. 12205  A=(KSX+2)*8 :B=VXL
  2421. 12210  GOSUB *CASOL_PX2
  2422. 12215  RETURN
  2423. 12220 '
  2424. 12225 *CASOL_PX2
  2425. 12230  XL=INT((MPXE-80)/A)
  2426. 12235  IF B=0 THEN X=MPXL                                                                 ELSE X=MPXL+(ABS(B) MOD A)
  2427. 12240  IF X>MPXF-64 THEN X=MPXF-64
  2428. 12245  LINE (MPXL,MPYF)-STEP(MPXE-48,-16),PSET,%BCL(0),BF,%BCL(5)
  2429. 12250  LINE (X,MPYF)-STEP(XL+16,-16),PSET,%BCL(0),BF,%BCL(17)
  2430. 12255  CONNECT(X+XL,MPYF)-STEP(2,-2)-STEP(12,0)-STEP(0,-12)-                                STEP(2,-2)-STEP(0,16)-STEP(-16,0),%BCL(0),PSET,F,%BCL(0)
  2431. 12260  RETURN
  2432. 12265  '
  2433. 12270 *CSL_S6
  2434. 12275  IF KMAX(PDX)=0 THEN GOSUB *RET_W :RETURN
  2435. 12280  A=KMAX(PDX)
  2436. 12285  GOSUB *ｶｰｿﾙ_SET1
  2437. 12290  CSP6=P
  2438. 12295  GOSUB *BD_SUBP
  2439. 12300  RETURN
  2440. 12305 '
  2441. 12310 *BSCR_P6
  2442. 12315  VXP=VXL     :INTERVAL ON
  2443. 12320 *BSCR_P6B
  2444. 12325  CRB=BCL(5)  :TIMX$=""   :GOSUB *CLOCK_P
  2445. 12330  IF MUX>MPXL+(KSX+30)*8+5-VXL THEN 12385
  2446. 12335  YL=INT((MUY-MPYL-YLW)/18)
  2447. 12340  IF MUY>MPYF-36 THEN GOSUB *SEL_6P :RETURN
  2448. 12345  IF YL<0 THEN
  2449. 12350              IF MUY<MPYL+YLW-5-YU  THEN *YMD_EXE
  2450. 12355              IF MUY<MPYL+YLW+11-YU THEN *KMD_EXE
  2451. 12360              GOTO *LINE_EXE6
  2452. 12365          ENDIF
  2453. 12370  KOXP=YL+CSP6
  2454. 12375  IF KOXP>KMAX(PDX) THEN *KMN_INPUT
  2455. 12380  IF KOXP>0   THEN *KMN_EXE
  2456. 12385  GOSUB *RET_W
  2457. 12390  RETURN
  2458. 12395 '
  2459. 12400 *LINE_EXE6
  2460. 12405  GOSUB *LINE_EXEP
  2461. 12410  IF CAR_END=1 THEN KSX=VAL(MX$)+64
  2462. 12415  GOSUB *SCR_BACK
  2463. 12420  RETURN
  2464. 12425 '
  2465. 12430 *SEL_6P
  2466. 12435  IF MUY>MPYF-16 THEN GOSUB *RET_W :RETURN
  2467. 12440  IF MUX>MPXL+10 AND MUX<MPXL+6*8+10                                             THEN CSP6=1         :GOSUB *BD_SUBP :RETURN
  2468. 12445  IF MUX>MPXL+7*8+10 AND MUX<MPXL+13*8+10                                        THEN CSP6=KMAX(PDX) :GOSUB *BD_SUBP :RETURN
  2469. 12450  IF MUX>MPXL+14*8+10 AND MUX<MPXL+20*8+10                                       THEN P=CSP6-1 :GOSUB *INST_P6 :GOSUB *BOLD_P2 :RETURN
  2470. 12455  GOSUB *RET_W
  2471. 12460  RETURN
  2472. 12465  '
  2473. 12470 *KMN_EXE
  2474. 12475  WHILE MOUSE(2,0)=-1  :WEND
  2475. 12480  GOSUB *CRD_SET  :IF ER=1 THEN ER=0 :GOTO 12620
  2476. 12485  GOSUB *CRP_SET  :XLP=LEN(MX$)
  2477. 12490  GOSUB *KEY_CR
  2478. 12495  IF KPS=1 THEN
  2479. 12500                CRB=BCL(10)    :GOSUB *KEY_CR    :CRB=BCL(5)
  2480. 12505                INTERVAL OFF   :MOUSE 5
  2481. 12510                GOSUB *KMD_IP  :JP=9
  2482. 12515                INTERVAL ON    :TIMX$=""  :GOSUB *CLOCK_P
  2483. 12520                IF ER=0 THEN INK_END=0    :CAR_END=1   ELSE 12625
  2484. 12525           ELSE
  2485. 12530                EXE_SW=1
  2486. 12535                GOSUB *INKEY_P
  2487. 12540                EXE_SW=0
  2488. 12545                IF RCLICK>0 THEN  CRB=BCL(10)      :GOSUB *KEY_CR   :                                         GOSUB *KILL_P6   :GOTO 12625
  2489. 12550                IF LCLICK>0 THEN
  2490. 12555                    CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  2491. 12560                    IF KPS=2 THEN GOSUB *GET_CORD  :                                                          IF GET_ON=0 THEN *BSCR_P6B
  2492. 12565                    IF KPS>2 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P6B
  2493. 12570                   ENDIF
  2494. 12575           ENDIF
  2495. 12580  IF INK_END=0 THEN
  2496. 12585                    GOSUB *KMX_SET    :GOSUB *KEY_CR
  2497. 12590                    IF CAR_END=1 THEN  GOSUB *CRD_NSET
  2498. 12595                    GOSUB *BOLD_BACK
  2499. 12600                    GOTO  *BSCR_P6B
  2500. 12605               ELSE
  2501. 12610                    WHILE MOUSE(2,0)=-1  :WEND
  2502. 12615               ENDIF
  2503. 12620  MOUSE 5
  2504. 12625  VXL=VXP  :GOSUB *SCR_BACK
  2505. 12630  RETURN
  2506. 12635 '
  2507. 12640 *BOLD_BACK
  2508. 12645  MOUSE 1,,,0
  2509. 12650  GOSUB *BOLD_P2
  2510. 12655  MOUSE 1,,,1
  2511. 12660  RETURN
  2512. 12665 ' 
  2513. 12670 *KMN_INPUT
  2514. 12675  KOXP=KMAX(PDX)+1  :IF KOXP>=NSX THEN GOSUB *FLL_KMN :GOTO 12825
  2515. 12680  GOSUB *CRD_SET    :IF ER=1 THEN ER=0 :GOTO 12820
  2516. 12685  MX$=""   :GOSUB *KEY_CR
  2517. 12690  WHILE MOUSE(2,0)=-1  :WEND
  2518. 12695  IF KPS=1 THEN
  2519. 12700                CRB=BCL(10)    :GOSUB *KEY_CR    :CRB=BCL(5)
  2520. 12705                INTERVAL OFF   :MOUSE 5
  2521. 12710                GOSUB *KMD_IP  :JP=9
  2522. 12715                INTERVAL ON    :TIMX$=""  :GOSUB *CLOCK_P
  2523. 12720                IF ER=0 THEN INK_END=0    :CAR_END=1   ELSE  12825
  2524. 12725           ELSE
  2525. 12730                EXE_SW=1
  2526. 12735                GOSUB *INKEY_P
  2527. 12740                EXE_SW=0
  2528. 12745                IF LCLICK>0 THEN
  2529. 12750                   CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  2530. 12755                   IF KPS=2 THEN GOSUB *GET_CORD  :                                                          IF GET_ON=0 THEN *BSCR_P6B
  2531. 12760                   IF KPS>2 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P6B
  2532. 12765                  ENDIF
  2533. 12770           ENDIF
  2534. 12775  IF INK_END=0 THEN
  2535. 12780                    KMAX(PDX)=KMAX(PDX)+1 :KOXP=KMAX(PDX)
  2536. 12785                    GOSUB *KMX_SET    :GOSUB *KEY_CR
  2537. 12790                    IF CAR_END=1 THEN  GOSUB *CRD_NSET
  2538. 12795                    GOSUB *BOLD_BACK
  2539. 12800                    GOTO *BSCR_P6B
  2540. 12805               ELSE
  2541. 12810                    WHILE MOUSE(2,0)=-1  :WEND
  2542. 12815               ENDIF
  2543. 12820  MOUSE 5
  2544. 12825  VXL=VXP  :GOSUB *SCR_BACK
  2545. 12830  RETURN
  2546. 12835 '
  2547. 12840 *CRD_SET
  2548. 12845  P=INT((MUX-MPXL-5+VXL)/8)
  2549. 12850  IF P<0 OR P>(KSX+30)     THEN ER=1  :RETURN
  2550. 12855  IF P>=(KSX-12) AND P<KSX THEN ER=1  :RETURN
  2551. 12860  IF P>=0  AND P<12        THEN CRXF=MPXL :CRXE=CRXF+12*8 :                                                 CRLEN=13  :KPS=1
  2552. 12865  IF P>=12 AND P<(KSX-52)  THEN CRXF=MPXL+12*8  :CRXE=CRXF+(KSX-64)*8 :                                     CRLEN=KSX-63    :KPS=2
  2553. 12870  IF P>=(KSX-52) AND P<(KSX-42) THEN CRXF=MPXL+(KSX-52)*8 :                                                      CRXE=CRXF+10*8  :CRLEN=11 :KPS=3
  2554. 12875  IF P>=(KSX-42) AND P<(KSX-36) THEN CRXF=MPXL+(KSX-42)*8 :                                                      CRXE=CRXF+6*8   :CRLEN=7  :KPS=4
  2555. 12880  IF P>=(KSX-36) AND P<(KSX-24) THEN CRXF=MPXL+(KSX-36)*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=5
  2556. 12885  IF P>=(KSX-24) AND P<(KSX-12) THEN CRXF=MPXL+(KSX-24)*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=6
  2557. 12890  IF P>=(KSX+6 ) AND P<(KSX+18) THEN CRXF=MPXL+(KSX+6 )*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=7
  2558. 12895  IF P>=(KSX+18) AND P<(KSX+30) THEN CRXF=MPXL+(KSX+18)*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=8
  2559. 12900  CRXF=CRXF+5-VXL   :CRXE=CRXE+5-VXL
  2560. 12905  CRYF=MPYL+YLW+(KOXP-CSP6)*18  :CRYE=CRYF+18
  2561. 12910  IF CRYF>MPYF-50 THEN
  2562. 12915                       CSP6=CSP6+1  :MOUSE 1,,,0
  2563. 12920                       GOSUB *BD_6P :MOUSE 1,,,1
  2564. 12925                       GOTO 12905
  2565. 12930                  ENDIF
  2566. 12935  XLP=0
  2567. 12940  RETURN
  2568. 12945 '
  2569. 12950 *CRP_SET
  2570. 12955  MX$=""
  2571. 12960  IF KPS=1  THEN  MX$=KOM$(KMI%(PDX,KOXP-1))
  2572. 12965  IF KPS=2  THEN  MX$=KNE$(PDX,KOXP-1)
  2573. 12970  IF KPS=3  THEN  IF KIN&(PDX,KOXP-1)>0                                                          THEN MX$=MID$(STR$(KIN&(PDX,KOXP-1)),2)
  2574. 12975  IF KPS=4  THEN  IF KSU%(PDX,KOXP-1)>0                                                          THEN MX$=MID$(STR$(KSU%(PDX,KOXP-1)),2)
  2575. 12980  IF KPS=5  THEN  IF KIN&(PDX,KOXP-1)>0                                                          THEN MX$=MID$(STR$(KIN&(PDX,KOXP-1)                                              *KSU%(PDX,KOXP-1)),2)
  2576. 12985  IF KPS>=6 THEN  IF KIN&(PDX,KOXP-1)>0                                                          THEN MX$=MID$(STR$(KIN&(PDX,KOXP-1)),2)
  2577. 12990  RETURN
  2578. 12995 '
  2579. 13000 *KMX_SET
  2580. 13005  P=KMT%(KMI%(PDX,KOXP-1))
  2581. 13010  IF KPS=1  THEN  IF KPJ>=0 THEN KMI%(PDX,KOXP-1)=KPJ
  2582. 13015  IF KPS=2  THEN  KNE$(PDX,KOXP-1)=MX$
  2583. 13020  IF KPS=3  THEN  KIN&(PDX,KOXP-1)=VAL(MX$)
  2584. 13025  IF KPS=4  THEN  KSU%(PDX,KOXP-1)=VAL(MX$)
  2585. 13030  IF KPS=5  THEN
  2586. 13035                  IF P=0 OR P=2 THEN
  2587. 13040                       IF KSU%(PDX,KOXP-1)=0 THEN KSU%(PDX,KOXP-1)=1
  2588. 13045                       KIN&(PDX,KOXP-1)=VAL(MX$)/KSU%(PDX,KOXP-1)
  2589. 13050                  ELSE
  2590. 13055                       KIN&(PDX,KOXP-1)=VAL(MX$)
  2591. 13060                  ENDIF
  2592. 13065            ENDIF
  2593. 13070  IF KPS=6  THEN  KIN&(PDX,KOXP-1)=VAL(MX$) :KSU%(PDX,KOXP-1)=-1
  2594. 13075  IF KPS=8  THEN  KIN&(PDX,KOXP-1)=VAL(MX$) :KSU%(PDX,KOXP-1)=-1
  2595. 13080  IF KPS=7  THEN  KIN&(PDX,KOXP-1)=VAL(MX$) :KSU%(PDX,KOXP-1)=1
  2596. 13085  IF P=1 OR P=3 OR P=5 THEN  KSU%(PDX,KOXP-1)=-1
  2597. 13090  IF P=0 OR P=2 OR P=4 THEN  IF KIN&(PDX,KOXP-1)>0 AND KSU%(PDX,KOXP-1)                                     <1  THEN KSU%(PDX,KOXP-1)=1
  2598. 13095  IF KPS>2 THEN ZCALK_SW=1
  2599. 13100  RETURN
  2600. 13105 '
  2601. 13110 *CRD_NSET
  2602. 13115  IF KPS>6 THEN GOSUB *BANK_SUB
  2603. 13120  EXPS=1
  2604. 13125  IF KPS=1 THEN BLEN=12*8  :MUX=MPXL+5+BLEN  :NLEN=KSX-58
  2605. 13130  IF KPS=2 THEN
  2606. 13135                P=KMT%(KMI%(PDX,KOXP-1))
  2607. 13140                IF P=0        THEN BLEN=(KSX-58)*8  :NLEN=10
  2608. 13145                IF P=1        THEN BLEN=(KSX-32)*8  :NLEN=10
  2609. 13150                IF P=2 OR P=5 THEN BLEN=(KSX+6 )*8  :NLEN=12  :VXL=515
  2610. 13155                IF P=3 OR P=4 THEN BLEN=(KSX-6 )*8  :NLEN=12  :VXL=515
  2611. 13160                MUX=MPXL+12*8+BLEN+5
  2612. 13165           ENDIF
  2613. 13170  IF KPS=3 THEN  BLEN=10*8  :MUX=MPXL+(KSX-48)*8+BLEN+5  :NLEN=6
  2614. 13175  IF KPS=4 THEN  KPS=6
  2615. 13180  IF KPS=5 THEN  IF P=0 OR P=2 THEN  KPS=6
  2616. 13185  IF KPS>5 THEN  MUX=MPXL+20   :MUY=CRYF+20  :NLEN=12    :VXL=0
  2617. 13190  IF MUX>MPXF-16-NLEN*8+VXL THEN  VXL=VXL+NLEN*8
  2618. 13195  IF MUX<MPXL+5  THEN  MUX=MPXL+20
  2619. 13200  IF MUY>MPYF-50 THEN  CSP6=CSP6+1  :MUY=MUY-20
  2620. 13205  MUX=MUX-VXL
  2621. 13210  RETURN
  2622. 13215 '
  2623. 13220 *BANK_SUB
  2624. 13225  IF BNMAX<1 THEN RETURN
  2625. 13230  VXL=515 :GOSUB *BOLD_BACK
  2626. 13235  SYMBOL(MPXL+(KSX+7)*8-VXL,MPYF-34),                                                "銀行名を選択して下さい",1,1,%BCL(10)
  2627. 13240  B$=""
  2628. 13245  WHILE MOUSE(2,0)=0
  2629. 13250        IF MOUSE(2,1)=-1 THEN 13320
  2630. 13255        A$=INKEY$
  2631. 13260        IF A$<>"" THEN B$=B$+A$  :GOTO 13255
  2632. 13265        IF B$<>"" THEN
  2633. 13270                       IF B$=CHR$(13) AND BANKP>0 THEN *BNAME_SET3
  2634. 13275                       P=VAL(LEFT$(B$,LEN(B$)-1))
  2635. 13280                       IF P>0 THEN *BNAME_SET2
  2636. 13285                  ENDIF
  2637. 13290  WEND
  2638. 13295  MUX=MOUSE(4,0)  :MUY=MOUSE(5,0)
  2639. 13300  IF MUX>MPXL+(KSX+59)*8-VXL AND MUX<MPXL+(KSX+61)*8-VXL                             THEN  GOSUB *BNAME_UP    :GOTO 13235
  2640. 13305  IF MUX>MPXL+(KSX+61)*8-VXL AND MUX<MPXL+(KSX+63)*8-VXL                             THEN  GOSUB *BNAME_DOWN  :GOTO 13235
  2641. 13310  IF MUX>MPXL+(KSX+40)*8-VXL AND MUX<MPXL+(KSX+61)*8-VXL  AND                    MUY>MPYL+YLW  AND  MUY<MPYF-16  THEN *BNAME_SET
  2642. 13315  WHILE MOUSE(2,0)=-1   :WEND
  2643. 13320  WHILE MOUSE(2,1)=-1   :WEND
  2644. 13325  RETURN
  2645. 13330  '
  2646. 13335 *BNAME_SET
  2647. 13340  YL=INT((MUY-MPYL-75)/18)
  2648. 13345  P=YL+BNL
  2649. 13350  *BNAME_SET2
  2650. 13355  IF P>BNMAX THEN 13435
  2651. 13360  BANKP=P
  2652. 13365  *BNAME_SET3
  2653. 13370  GOSUB *BOLD_BACK
  2654. 13375  GOSUB *BANK_DLOAD
  2655. 13380  PAGE1S=PAGE1(BANKP)  :PAGE2S=PAGE2(BANKP)
  2656. 13385  GOSUB *YMD_SET
  2657. 13390  GOSUB *BANK_SARCH
  2658. 13395  IF ER=1 THEN MOUSE 5 :GOSUB *FLL_6P :RETURN
  2659. 13400  IF P=0 THEN BMAX=BMAX+1 :P=BMAX
  2660. 13405  BYM$(P-1)=YD$
  2661. 13410  BME$(P-1)=KNE$(PDX,KOXP-1)
  2662. 13415  A=KMT%(KMI%(PDX,KOXP-1))
  2663. 13420  IF A=2 OR A=5 THEN BOUT#(P-1)=KIN&(PDX,KOXP-1)
  2664. 13425  IF A=3 OR A=4 THEN BIN#(P-1) =KIN&(PDX,KOXP-1)
  2665. 13430  GOSUB *BANK_SAVE
  2666. 13435  WHILE MOUSE(2,0)=-1   :WEND
  2667. 13440  RETURN
  2668. 13445  '
  2669. 13450 *BANK_SARCH
  2670. 13455  ER=0
  2671. 13460  FOR A=1 TO BMAX
  2672. 13465      IF BYM$(A-1)>YD$ THEN P=A :GOSUB *INST_P9 :RETURN
  2673. 13470      IF INSTR(BYM$(A-1),YD$)>0 AND INSTR(BME$(A-1),KNE$(PDX,KOXP-1))>0                   THEN P=A  :RETURN
  2674. 13475  NEXT A
  2675. 13480  P=0  :IF BMAX>=BNZ THEN ER=1
  2676. 13485  RETURN
  2677. 13490  '
  2678. 13495 *YMD_SET
  2679. 13500  Y$=RIGHT$("0"+MID$(STR$(RXY),2),2)
  2680. 13505  M$=RIGHT$("0"+MID$(STR$(RXM),2),2)
  2681. 13510  D$=RIGHT$("0"+MID$(STR$(RXD),2),2)
  2682. 13515  YD$=Y$+"-"+M$+"-"+D$
  2683. 13520  RETURN
  2684. 13525  '
  2685. 13530 *YMD_EXE
  2686. 13535  IF MUX>MPXL-VXL+(KSX-42)*8 AND MUX<MPXL-VXL+(KSX-36)*8                         THEN X=0 :PDXS=PDX :ERASE ZAN& :DIM ZAN&(366) :                                  GOSUB *ZAN_P2 :GOSUB *BOLD_BACK :RETURN
  2687. 13540  IF MUX>MPXL-VXL+106 THEN *SEL_SWP
  2688. 13545  REF_SW=1    :PDS=PDX
  2689. 13550  GOSUB *CALENDER       :CSP6=1
  2690. 13555  GOSUB *SCR_BACK
  2691. 13560  GOSUB *SET_XYD
  2692. 13565  REF_SW=0  :REW_X=PXE%(5)  :REW_Y=PYE%(5)  :JP=9
  2693. 13570  IF ZCALK_SW=1 AND DEXE_SW=1 THEN SWAP PDX,PDS :GOSUB *ZAN_P :                                                SWAP PDX,PDS
  2694. 13575  RETURN
  2695. 13580 '
  2696. 13585 *GET_CORD
  2697. 13590  INTERVAL OFF  :MOUSE 5
  2698. 13595  REF_SW=1      :CRXF_S=CRXF     :CRYF_S=CRYF   :GET_ON=0
  2699. 13600  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :MUX_Q=MUX     :MUY_Q=MUY
  2700. 13605  GOSUB *CORD_P
  2701. 13610  A=NP(NEXP-1)  :GOSUB *SWAP_XY
  2702. 13615  GOSUB *SCR_BACK
  2703. 13620  GOSUB *SET_XYD
  2704. 13625  INTERVAL ON   :TIMX$=""      :GOSUB *CLOCK_P
  2705. 13630  REW_X=PXE%(5) :REW_Y=PYE%(5) :JP=9
  2706. 13635  IF GET_ON=1 THEN
  2707. 13640                  MX$=CODN$
  2708. 13645                  IF KIN&(PDX,KOXP-1)=0 THEN
  2709. 13650                         KIN&(PDX,KOXP-1)=CODX
  2710. 13655                         P=KMT%(KMI%(PDX,KOXP-1))
  2711. 13660                         IF (P MOD 2)=0 THEN T=1    ELSE T=-1
  2712. 13665                         KSU%(PDX,KOXP-1)=T
  2713. 13670                    ENDIF
  2714. 13675              ENDIF
  2715. 13680  INK_END=0   :CAR_END=1   :REF_SW=0
  2716. 13685  CRXF=CRXF_S :CRYF=CRYF_S :MUX=MUX_Q :MUY=MUY_Q
  2717. 13690  MOUSE 0 :MOUSE 1,MUX,MUY,1
  2718. 13695  WHILE MOUSE(2,0)=-1      :WEND
  2719. 13700  RETURN
  2720. 13705 '
  2721. 13710 *SYOKEI_P
  2722. 13715  ZANX#=ZAN&(PDX) :ZAN1#=0 :ZAN2#=0 :ZAN3#=ZANX# :ZAN4#=0 :ZAN5#=0
  2723. 13720  IF KMAX(PDX)<1 THEN RETURN
  2724. 13725  FOR A=0 TO KMAX(PDX)-1
  2725. 13730      P=KMT%(KMI%(PDX,A))
  2726. 13735      IF P>1 THEN
  2727. 13740          IF P=2 OR P=5 THEN ZAN4#=ZAN4#+KIN&(PDX,A)
  2728. 13745          IF P=3 OR P=4 THEN ZAN5#=ZAN5#+KIN&(PDX,A)
  2729. 13750          IF P<4 THEN GOTO 13775
  2730. 13755       ENDIF
  2731. 13760      ZAN3#=ZAN3#-KIN&(PDX,A)*KSU%(PDX,A)
  2732. 13765      IF A<CSP6-1 THEN ZANX#=ZAN3#
  2733. 13770      IF KSU%(PDX,A)>0 THEN ZAN1#=ZAN1#+KIN&(PDX,A)*KSU%(PDX,A)                                    ELSE ZAN2#=ZAN2#+KIN&(PDX,A)
  2734. 13775  NEXT A
  2735. 13780  RETURN
  2736. 13785 '
  2737. 13790 *KMD_EXE
  2738. 13795  IF MUX>MPXL+(KSX+59)*8-VXL AND MUX<MPXL+(KSX+61)*8-VXL                             THEN  GOSUB *BNAME_UP          :RETURN
  2739. 13800  IF MUX>MPXL+(KSX+61)*8-VXL AND MUX<MPXL+(KSX+63)*8-VXL                             THEN  GOSUB *BNAME_DOWN        :RETURN
  2740. 13805  IF MUX>MPXL+(KSX-3)*8-VXL AND MUX<MPXL+KSX*8-VXL                                   THEN  VXL=515 :GOSUB *BD_SUBP  :RETURN
  2741. 13810  IF MUX>MPXL+(KSX+4)*8-VXL AND MUX<MPXL+(KSX+6)*8-VXL                               THEN  VXL=0   :GOSUB *BD_SUBP  :RETURN
  2742. 13815  IF MUX>MPXL-VXL+100 THEN WHILE MOUSE(2,0)=-1  :WEND  :RETURN
  2743. 13820  REF_SW=1
  2744. 13825  MOUSE 5  :GOSUB *KMD_IP
  2745. 13830  REF_SW=0
  2746. 13835  MOUSE 1,,,0   :GOSUB *SCR_BACK   :MOUSE 1,,,1
  2747. 13840  REW_X=PXE%(5) :REW_Y=PYE%(5) :JP=9
  2748. 13845  RETURN
  2749. 13850 '
  2750. 13855 *KILL_P6
  2751. 13860  IF KOXP>=NSX  THEN 13895
  2752. 13865  FOR A=KOXP-1 TO KMAX(PDX)-2
  2753. 13870      SWAP KIN&(PDX,A),KIN&(PDX,A+1)
  2754. 13875      SWAP KMI%(PDX,A),KMI%(PDX,A+1)
  2755. 13880      SWAP KSU%(PDX,A),KSU%(PDX,A+1)
  2756. 13885      SWAP KNE$(PDX,A),KNE$(PDX,A+1)
  2757. 13890  NEXT A
  2758. 13895  IF KMAX(PDX)>0 THEN KMAX(PDX)=KMAX(PDX)-1
  2759. 13900  RETURN
  2760. 13905 '
  2761. 13910 *INST_P6
  2762. 13915  GOSUB *RET_W
  2763. 13920  IF KMAX(PDX)=0 THEN RETURN
  2764. 13925  IF P>NSX-2  THEN GOSUB *FLL_KMN :RETURN
  2765. 13930  FOR A=KMAX(PDX)-1 TO P STEP-1
  2766. 13935      KIN&(PDX,A+1)=KIN&(PDX,A)
  2767. 13940      KMI%(PDX,A+1)=KMI%(PDX,A)
  2768. 13945      KSU%(PDX,A+1)=KSU%(PDX,A)
  2769. 13950      KNE$(PDX,A+1)=KNE$(PDX,A)
  2770. 13955  NEXT A
  2771. 13960      KIN&(PDX,P)=0
  2772. 13965      KMI%(PDX,P)=0
  2773. 13970      KSU%(PDX,P)=0
  2774. 13975      KNE$(PDX,P)=""
  2775. 13980  KMAX(PDX)=KMAX(PDX)+1
  2776. 13985  RETURN
  2777. 13990 '
  2778. 13995 *ZAN_P
  2779. 14000  X=PDX  :PDXS=PDX
  2780. 14005 *ZAN_P2
  2781. 14010  GOSUB *ZAN_PX
  2782. 14015  PDX=PDXS
  2783. 14020  RETURN
  2784. 14025 '
  2785. 14030 *ZAN_PX
  2786. 14035  FOR PDX=X TO 365+URY
  2787. 14040      GOSUB *SYOKEI_P
  2788. 14045      ZAN&(PDX+1)=ZAN3#
  2789. 14050  NEXT PDX
  2790. 14055  ZCALK_SW=0    :DEXE_SW=0
  2791. 14060  RETURN
  2792. 14065  '
  2793. 14070 *CALK_BOD
  2794. 14075  MOUSE 5       :INTERVAL OFF    :REW_YS=REW_Y  :REW_XS=REW_X
  2795. 14080  REF_SW=1      :CRXF_S=CRXF     :CRYF_S=CRYF   :GET_ON=0
  2796. 14085  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :MUX_Q=MUX     :MUY_Q=MUY
  2797. 14090  GOSUB *CALK_P
  2798. 14095  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :BPQ=0
  2799. 14100  GOSUB *SCR_BACK
  2800. 14105  GOSUB *SET_XYD
  2801. 14110  INTERVAL ON  :TIMX$=""         :GOSUB *CLOCK_P
  2802. 14115  JP=9         :REW_Y=REW_YS     :REW_X=REW_XS
  2803. 14120  IF GET_ON=1 THEN MX$=STR$(QX#)
  2804. 14125  INK_END=0    :CAR_END=1   :REF_SW=0
  2805. 14130  CRXF=CRXF_S  :CRYF=CRYF_S :MUX=MUX_Q :MUY=MUY_Q
  2806. 14135  MOUSE 0 :MOUSE 1,MUX,MUY,1
  2807. 14140  WHILE MOUSE(2,0)=-1      :WEND
  2808. 14145  RETURN
  2809. 14150  '
  2810. 14155 *SEL_SWP
  2811. 14160  P=0
  2812. 14165  IF MUX>MPXL-VXL+115 AND MUX<MPXL-VXL+125 THEN P=-1
  2813. 14170  IF MUX>MPXL-VXL+130 AND MUX<MPXL-VXL+140 THEN P=1
  2814. 14175  IF P<>0 THEN  GOSUB *YMD_UDP :CSP6=1 :GOSUB *BOLD_BACK
  2815. 14180  WHILE MOUSE(2,0)=-1      :WEND
  2816. 14185  MOUSE 5
  2817. 14190  RETURN
  2818. 14195  '
  2819. 14200 *YMD_UDP
  2820. 14205  PDX=PDX+P
  2821. 14210  RXD=RXD+P
  2822. 14215  IF RXD<1         THEN
  2823. 14220                        RXM=RXM-1
  2824. 14225                        IF RXM<1 THEN RXM=12 :PDX=364+URY
  2825. 14230                        RXD=MONT(RXM)
  2826. 14235     ENDIF
  2827. 14240  IF RXD>MONT(RXM) THEN
  2828. 14245                        RXM=RXM+1
  2829. 14250                        IF RXM>12 THEN RXM=1 :PDX=0
  2830. 14255                        RXD=1 
  2831. 14260     ENDIF
  2832. 14265  RETURN
  2833. 14270  '
  2834. 14275 *FLL_KMN
  2835. 14280  RESTORE *ERM_D3
  2836. 14285  *MES_6P
  2837. 14290  GOSUB *ERMD_SET
  2838. 14295  GOSUB *MESSAGE_P
  2839. 14300  RETURN
  2840. 14305  '
  2841. 14310 *ERM_D3 
  2842. 14315  DATA 3
  2843. 14320  DATA "登録領域が一杯です",0
  2844. 14325  DATA "これ以上登録する事は出来ません" ,10
  2845. 14330  DATA "不要な欄を削除してください",0
  2846. 14335  '
  2847. 14340 *FLL_6P
  2848. 14345  RESTORE *ERM_D3B
  2849. 14350  GOSUB *MES_6P
  2850. 14355  RETURN
  2851. 14360 '
  2852. 14365 *ERM_D3B
  2853. 14370  DATA 3
  2854. 14375  DATA "登録領域が一杯で",0
  2855. 14380  DATA "通帳に登録する事は出来ません" ,10
  2856. 14385  DATA "家計簿のみ登録します",0
  2857. 14390 '
  2858. 14395 '-------------------------------------------------------------------
  2859. 14400 *KMD_IP
  2860. 14405  X1=MPXL       :Y1=MPYL       :X2=MPXF       :Y2=MPYF
  2861. 14410  A=9           :GOSUB *SWAP_XY
  2862. 14415  MPXL=PXL%(9)  :MPYL=PYL%(9)  :MPXE=PXE%(9)  :MPYE=PYE%(9)
  2863. 14420  GOSUB *OPEN_P2
  2864. 14425  BCL(1)=BCL(18) :BCL(9)=BCL(19) :GET_ON=0    :MUX_S=MUX   :MUY_S=MUY
  2865. 14430  REW_X=PXE%(9)  :REW_Y=MPYE=PYE%(9) :BDP=10  :BPQ=0
  2866. 14435  GOSUB *BOLD_P
  2867. 14440  GOSUB *SET_XYD
  2868. 14445  GOSUB *SEL_MXY
  2869. 14450  IF ER=1 THEN 14480
  2870. 14455  IF VAL(K$)>0 AND VAL(K$)=<KOZ THEN  P=VAL(K$)  :KPJ=P  :                                                      MX$=KOM$(P)  :GOTO 14480
  2871. 14460  IF JP=1 THEN  KPJ=0  :MX$=""
  2872. 14465  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN6I,*YL_UP6I,*XL_RIGHT6I,                      *XL_LEFT6I,*DRAG_B,*BSCR_P6I,*CSL_S6I,*CSL_D6I,*RET_W
  2873. 14470  IF JP<>1 THEN 14445
  2874. 14475  NEXP=NEXP+1
  2875. 14480  GOSUB *CLOSE_P2
  2876. 14485  PXL%(9)=MPXL :PYL%(9)=MPYL :PXE%(9)=MPXE :PYE%(9)=MPYE
  2877. 14490  A=9  :GOSUB *SWAP_XY   :MUX=MUX_S  :MUY=MUY_S
  2878. 14495  GOSUB *SET_XYD
  2879. 14500  MOUSE 0    :MOUSE 1,MUX,MUY,1      :INK_END=1
  2880. 14505  RETURN
  2881. 14510 '
  2882. 14515 *BD_10P
  2883. 14520  IF REF_SW=1 THEN  FILS$="[項目登録]"     ELSE  FILS$="[項目選択]"
  2884. 14525  WINDOW (MPXL+VXU+1,MPYL+17)-(MPXF+VXU-17,MPYF-17)   :                          VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  2885. 14530  GOSUB *BD10_LINE
  2886. 14535  XL=MPXL+5  :YL=MPYL+55  :L=INT((MPXF-36)/8)
  2887. 14540  FOR A=KMCS TO  KOZ
  2888. 14545      SYMBOL(XL,YL),STR$(A),1,1,%BCL(0)
  2889. 14550      IF KMT%(A)=0 THEN CL=0
  2890. 14555      IF KMT%(A)=1 THEN CL=8
  2891. 14560      IF KMT%(A)=2 THEN CL=10
  2892. 14565      IF KMT%(A)=3 THEN CL=1
  2893. 14570      IF KMT%(A)=4 THEN CL=13
  2894. 14575      IF KMT%(A)=5 THEN CL=14
  2895. 14580      SYMBOL(XL+25,YL),KOM$(A),1,1,%BCL(CL)
  2896. 14585      YL=YL+18
  2897. 14590      IF YL>MPYF-32 THEN XL=XL+(KOML+2)*8 :YL=MPYL+55 :                                                                L=INT((MPXF-XL-36)/8)
  2898. 14595      IF XL>MPXF-36 THEN 14605
  2899. 14600  NEXT A
  2900. 14605  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  2901. 14610  GOSUB *CASOL_P6I  :GOSUB *CASOL_P6IB
  2902. 14615  RETURN
  2903. 14620 '
  2904. 14625 *BD10_LINE
  2905. 14630  IF KOML=0 THEN KOML=15
  2906. 14635  XL=MPXL+5  :YL=MPYL+50  :X=(KOML+2)*8  :L=INT((MPXE-25)/X)
  2907. 14640  SYMBOL(XL+3*8,YL-10),STR$(KOML-3),.7!,.7!,%BCL(0)
  2908. 14645  FOR A=1 TO L
  2909. 14650      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  2910. 14655      LINE (XL+KOML*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2911. 14660      LINE (XL,YL  )-STEP(X-16,0),PSET,%BCL(0)
  2912. 14665      SYMBOL(XL,YL-28),"No.",1,1,%BCL(0)
  2913. 14670      LINE (XL+3*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  2914. 14675      SYMBOL(XL+3*8,YL-28),"[名 称]",1,1,%BCL(0)
  2915. 14680      XL=XL+X
  2916. 14685  NEXT A
  2917. 14690  IF XL<MPXF-16 THEN 14645
  2918. 14695  RETURN
  2919. 14700 '
  2920. 14705 *YL_DOWN6I
  2921. 14710  KMCS=KMCS+1
  2922. 14715  IF KMCS>KOZ THEN KMCS=KOZ
  2923. 14720  GOSUB *BD_SUBP
  2924. 14725  RETURN
  2925. 14730  '
  2926. 14735 *YL_UP6I
  2927. 14740  KMCS=KMCS-1
  2928. 14745  IF KMCS<1 THEN KMCS=1
  2929. 14750  GOSUB *BD_SUBP
  2930. 14755  RETURN
  2931. 14760 '
  2932. 14765 *XL_RIGHT6I
  2933. 14770  L=INT((MPYE-71)/18)+1
  2934. 14775  KMCS=KMCS+L
  2935. 14780  IF KMCS>KOZ THEN KMCS=KMCS-L
  2936. 14785  GOSUB *BD_SUBP
  2937. 14790  RETURN
  2938. 14795 '
  2939. 14800 *XL_LEFT6I
  2940. 14805  L=INT((MPYE-71)/18)+1
  2941. 14810  KMCS=KMCS-L
  2942. 14815  IF KMCS<1 THEN KMCS=1
  2943. 14820  GOSUB *BD_SUBP
  2944. 14825  RETURN
  2945. 14830 '
  2946. 14835 *CASOL_P6I
  2947. 14840  A=KOZ :B=KMCS
  2948. 14845  GOSUB *CASOL_PX1
  2949. 14850  RETURN
  2950. 14855 '
  2951. 14860 *CASOL_P6IB
  2952. 14865  A=MPXE-80 :B=((MPXE-80)/KOZ)*(KMCS-1)
  2953. 14870  GOSUB *CASOL_PX2
  2954. 14875  RETURN
  2955. 14880 '
  2956. 14885 *CSL_S6I
  2957. 14890  IF KOZ=0 THEN GOSUB *RET_W
  2958. 14895  A=KOZ
  2959. 14900  GOSUB *ｶｰｿﾙ_SET1
  2960. 14905  KMCS=P
  2961. 14910  GOSUB *BD_SUBP
  2962. 14915  RETURN
  2963. 14920 '
  2964. 14925 *CSL_D6I
  2965. 14930  IF KOZ=0 THEN GOSUB *RET_W
  2966. 14935  A=KOZ
  2967. 14940  GOSUB *ｶｰｿﾙ_SET2
  2968. 14945  KMCS=P
  2969. 14950  GOSUB *BD_SUBP
  2970. 14955  RETURN
  2971. 14960 '
  2972. 14965 *BSCR_P6I
  2973. 14970  XL=INT((MUX-MPXL-5)/((KOML+2)*8))
  2974. 14975  IF ((MUX-MPXL-5) MOD ((KOML+2)*8))>0 THEN XL=XL+1
  2975. 14980  Y=INT((MPYE-87)/18)+1
  2976. 14985  YL=INT((MUY-MPYL-55)/18)
  2977. 14990  P=(XL-1)*Y+YL+KMCS
  2978. 14995  IF YL<0  THEN *LINE_EXE6I
  2979. 15000  IF P>KOZ THEN *INP_KMDP
  2980. 15005  IF REF_SW=1 THEN *KMD_EXEP
  2981. 15010  KPJ=P  :MX$=KOM$(P)  :GET_ON=1
  2982. 15015  JP=1   :NEXP=NEXP-1  :MOUSE 5
  2983. 15020  RETURN
  2984. 15025 '
  2985. 15030 *LINE_EXE6I
  2986. 15035  GOSUB *LINE_EXEP
  2987. 15040  IF CAR_END=1 THEN KOML=VAL(MX$)+3
  2988. 15045  GOSUB *BOLD_P2
  2989. 15050  RETURN
  2990. 15055 '
  2991. 15060 *KMD_EXEP
  2992. 15065  IF MUY>MPYL+Y*18+55 THEN RETURN
  2993. 15070  CRXF=MPXL+(XL-1)*((KOML+2)*8)+30 :CRXE=CRXF+KOML*8
  2994. 15075  CRYF=MPYL+YL*18+55               :CRYE=CRYF+18
  2995. 15080  KMDP=P
  2996. 15085  MX$=KOM$(KMDP)  :XLP=LEN(MX$)
  2997. 15090  IF KMT%(KMDP)=1 THEN MX$=MX$+"+"
  2998. 15095  IF KMT%(KMDP)=2 THEN MX$=MX$+"/"
  2999. 15100  IF KMT%(KMDP)=3 THEN MX$=MX$+"*"
  3000. 15105  IF KMT%(KMDP)=4 THEN MX$=MX$+"="
  3001. 15110  IF KMT%(KMDP)=5 THEN MX$=MX$+"-"
  3002. 15115  *INP_KMDP2
  3003. 15120  CRLEN=KOML-2         :CAR_END=0   :CRB=BCL(5)
  3004. 15125  GOSUB *INKEY_WP
  3005. 15130  IF INK_END=1 THEN  RETURN
  3006. 15135  A=0
  3007. 15140  IF RIGHT$(MX$,1)="+" THEN A=1
  3008. 15145  IF RIGHT$(MX$,1)="/" THEN A=2
  3009. 15150  IF RIGHT$(MX$,1)="*" THEN A=3
  3010. 15155  IF RIGHT$(MX$,1)="=" THEN A=4
  3011. 15160  IF RIGHT$(MX$,1)="-" THEN A=5
  3012. 15165  IF A>0 THEN MX$=LEFT$(MX$,LEN(MX$)-1)
  3013. 15170  KOM$(KMDP)=MX$   :KMT%(KMDP)=A
  3014. 15175  VXU=0
  3015. 15180  GOSUB *BOLD_P3
  3016. 15185  GOSUB *KOMOK_SAVE
  3017. 15190  RETURN
  3018. 15195 '
  3019. 15200 *INP_KMDP
  3020. 15205  IF P>=KSZ THEN *FLL_KMD
  3021. 15210  KOZ=KOZ+1
  3022. 15215  KOM$(KOZ)=""  :KMT%(KOZ)=0
  3023. 15220  CRXF=MPXL+(XL-1)*((KOML+2)*8)+30 :CRXE=CRXF+KOML*8
  3024. 15225  CRYF=MPYL+YL*18+55               :CRYE=CRYF+18
  3025. 15230  MX$=""      :XLP=0      :KMDP=KOZ
  3026. 15235  GOSUB *INP_KMDP2
  3027. 15240  IF INK_END=1 THEN KOZ=KOZ-1  :GOSUB *BOLD_P3
  3028. 15245  RETURN
  3029. 15250 '
  3030. 15255 *FLL_KMD
  3031. 15260  RESTORE *ERM_D4   :GOSUB *ERMD_SET
  3032. 15265  GOSUB *MESSAGE_P
  3033. 15270  RETURN
  3034. 15275 '
  3035. 15280 *ERM_D4
  3036. 15285  DATA 4
  3037. 15290  DATA "登録領域が一杯です",0
  3038. 15295  DATA "これ以上項目を登録する事は出来ません" ,10
  3039. 15300  DATA "不要な項目を変更してください",10
  3040. 15305  DATA "この場合､すでに家計簿に登録されている項目名も変更されます",11
  3041. 15310 '
  3042. 15315 '-------------------------------------------------------------------
  3043. 15320 *CALK_P
  3044. 15325  A=NP(NEXP)   :GOSUB *SWAP_XY
  3045. 15330  MPXL=PXL%(6) :MPYL=PYL%(6)  :MPXE=PXE%(6)  :MPYE=PYE%(6)
  3046. 15335  GOSUB *SWAP_MD
  3047. 15340  A=6          :GOSUB *OPEN_P
  3048. 15345  *CALK_P2
  3049. 15350  BCL(1)=BCL(18) :BCL(9)=BCL(19) :S$=""  :SX$=""  :QX#=0  :GET_ON=0
  3050. 15355  BDP=7          :NEXP=NEXP+1    :BPQ=2  :MRI_P=0
  3051. 15360  GOSUB *BOLD_P
  3052. 15365  GOSUB *SET_XYD3
  3053. 15370  GOSUB *SEL_MXY
  3054. 15375  IF ER=1 OR (JP=18 AND REF_SW=0) THEN 15370
  3055. 15380  IF K$<>"" THEN
  3056. 15385                 GOSUB *KEY_GET
  3057. 15390                 IF JP=0 THEN 15370
  3058. 15395            ENDIF
  3059. 15400  IF JP=0 THEN
  3060. 15405              GOSUB *NEX_XY
  3061. 15410              IF JP>0 THEN
  3062. 15415                          IF JP=10 THEN PXL%(6)=MPXL :PYL%(6)=MPYL :                                                PXE%(6)=MPXE :PYE%(6)=MPYE
  3063. 15420                          A=NP(NEXP-1) :GOSUB *SWAP_XY :GOTO *NEX_P
  3064. 15425                          GOTO *NEX_P
  3065. 15430                      ENDIF
  3066. 15435              GOTO 15365
  3067. 15440          ENDIF
  3068. 15445  IF JP>6 THEN GOSUB *CALK  :IF GET_ON=1 AND REF_SW=1 THEN JP=1
  3069. 15450  IF JP=1 AND REF_SW=1 THEN
  3070. 15455                           MOUSE 5
  3071. 15460                           PXL%(6)=MPXL :PYL%(6)=MPYL :PXE%(6)=MPXE
  3072. 15465                           PYE%(6)=MPYE :GOSUB *CLOSE_P
  3073. 15470                           NEXP=NEXP-1  :A=NP(NEXP)   :GOSUB *SWAP_XY
  3074. 15475                           RETURN
  3075. 15480                       ENDIF
  3076. 15485  ON JP GOSUB *RET_P,*DRAG_B,*SUJI_P,*SUJI_P2,*TEN_P,*ZERO_P
  3077. 15490  IF JP=1 THEN
  3078. 15495               PXL%(6)=MPXL :PYL%(6)=MPYL :PXE%(6)=MPXE :PYE%(6)=MPYE
  3079. 15500               GOSUB *CLOSE_P
  3080. 15505               IF NEXP=0 THEN RETURN                                                                 ELSE JP=BPS(NP(NEXP-1))  :NX=0 :GOTO *NEX_P
  3081. 15510          ENDIF
  3082. 15515  GOTO 15370
  3083. 15520 '
  3084. 15525 *SUJI_P
  3085. 15530  X=INT((MUX-MPXL-10)/20)+1
  3086. 15535  Y=INT((MUY-MPYL-60)/20)
  3087. 15540  IF P>=21 AND P=<23 THEN S$=""
  3088. 15545  P=Y*3+X
  3089. 15550  IF Y=0 THEN S=6+X    :P=X-1
  3090. 15555  IF Y=1 THEN S=3+X    :P=5+X
  3091. 15560  IF Y=2 THEN S=X      :P=11+X
  3092. 15565  S$=S$+MID$(STR$(S),2)
  3093. 15570  *SUJI_P1
  3094. 15575  IF MRI_P=1 THEN S$=RIGHT$(S$,1) :MRI_P=0
  3095. 15580  S$=LEFT$(S$,13)   :SX$=S$
  3096. 15585  GOSUB *BOTAN_P
  3097. 15590  RETURN
  3098. 15595  '
  3099. 15600 *SUJI_P2
  3100. 15605  IF P>=21 AND P=<23 THEN S$=""
  3101. 15610  IF S$="" THEN RETURN
  3102. 15615  S$=S$+"0"    :P=18
  3103. 15620  GOTO *SUJI_P1
  3104. 15625  '
  3105. 15630 *TEN_P
  3106. 15635  IF P>=21 AND P=<23 THEN S$=""
  3107. 15640  S$=S$+"."    :P=19
  3108. 15645  GOTO *SUJI_P1
  3109. 15650  '
  3110. 15655 *ZERO_P
  3111. 15660  IF P>=21 AND P=<23 THEN S$=""
  3112. 15665  IF S$="" THEN RETURN
  3113. 15670  S$=S$+"000"  :P=20
  3114. 15675  GOTO *SUJI_P1
  3115. 15680  '
  3116. 15685 *SUJI_PRINT
  3117. 15690  LINE (MPXL+15,MPYL+25)-STEP(110,21),PSET,%BCL(5),BF
  3118. 15695  IF SX$="" THEN A$="0"     ELSE A$=SX$
  3119. 15700  IF VAL(SX$)>10^12 THEN A$="桁溢れです"
  3120. 15705  A$=LEFT$(A$,13)
  3121. 15710  SYMBOL(MPXF-LEN(A$)*8-20,MPYL+28),A$,1,1,%BCL(0)
  3122. 15715  RETURN
  3123. 15720  '
  3124. 15725 *CALK
  3125. 15730  IF JP=7 THEN S$="" :SX$=""  :P=3          :GOSUB *BOTAN_P  :RETURN
  3126. 15735  IF JP=8 THEN S$="" :SX$=""  :QX#=0  :P=4  :GOSUB *BOTAN_P  :RETURN
  3127. 15740  IF JP=9 THEN
  3128. 15745               SX$=STR$(MR#)  :IF VAL(SX$)=0 THEN S$=""   ELSE S$=SX$
  3129. 15750               IF MR_SW>0 AND TIMZ=TIME THEN MR_SW=0 :MR#=0
  3130. 15755               P=5   :GOSUB *BOTAN_P   :TIMZ=TIME :RETURN
  3131. 15760          ENDIF
  3132. 15765  IF C_SW=0 AND (JP>9 AND JP<15) AND JP<>12 THEN
  3133. 15770               IF JP=10 THEN C_SW=1    :P=9
  3134. 15775               IF JP=11 THEN C_SW=2    :P=10
  3135. 15780               IF JP=13 THEN C_SW=3    :P=15
  3136. 15785               IF JP=14 THEN C_SW=4    :P=16
  3137. 15790               QX#=VAL(S$)   :S$=""    :GOSUB *BOTAN_P
  3138. 15795               RETURN
  3139. 15800     ENDIF
  3140. 15805  IF C_SW>0 AND (JP>9 AND JP<15) AND JP<>12 THEN
  3141. 15810               GOSUB *MAIN_CALK
  3142. 15815               SX$=STR$(QX#)   :S$=""
  3143. 15820               IF JP=10 THEN C_SW=1    :P=9
  3144. 15825               IF JP=11 THEN C_SW=2    :P=10
  3145. 15830               IF JP=13 THEN C_SW=3    :P=15
  3146. 15835               IF JP=14 THEN C_SW=4    :P=16
  3147. 15840               GOSUB *BOTAN_P   :RETURN
  3148. 15845     ENDIF
  3149. 15850  IF JP=17 OR JP=18 THEN
  3150. 15855               GOSUB *MAIN_CALK
  3151. 15860               C_SW=0   :S$=SX$ :MRI_P=1 :P=22
  3152. 15865               IF JP=18 THEN GET_ON=1    :P=23
  3153. 15870               GOSUB *BOTAN_P   :RETURN
  3154. 15875     ENDIF
  3155. 15880  IF JP=16 THEN
  3156. 15885     IF C_SW=1 THEN
  3157. 15890                    QX#=QX#/100*VAL(S$) :SX$=STR$(QX#)
  3158. 15895               ELSE
  3159. 15900                    GOSUB *MAIN_CALK
  3160. 15905               ENDIF
  3161. 15910               C_SW=0   :P=21   :S$=SX$
  3162. 15915               GOSUB *BOTAN_P   :RETURN
  3163. 15920     ENDIF
  3164. 15925  IF JP=12 THEN  MR#=MR#+VAL(S$)  :MR_SW=1  :C_SW=0  :P=11 :                                 GOSUB *BOTAN_P   :MRI_P=1  :RETURN
  3165. 15930  IF JP=15 THEN  MR#=MR#-VAL(S$)  :MR_SW=1  :C_SW=0  :P=17 :                                 GOSUB *BOTAN_P   :MRI_P=1
  3166. 15935  RETURN
  3167. 15940  '
  3168. 15945 *KEY_GET
  3169. 15950  IF VAL(K$)>0 THEN
  3170. 15955                    IF P>=21 AND P=<23 THEN S$=""
  3171. 15960                    S$=S$+K$  :A=VAL(K$)
  3172. 15965                    IF A>=1 AND A=<3 THEN P=A+11
  3173. 15970                    IF A>=4 AND A=<6 THEN P=A+2
  3174. 15975                    IF A>=7 AND A=<9 THEN P=A-7
  3175. 15980                    GOTO *SUJI_P1
  3176. 15985               ENDIF
  3177. 15990  IF K$="0"    THEN *SUJI_P2
  3178. 15995  IF K$="."    THEN *TEN_P
  3179. 16000  IF K$="000"  THEN *ZERO_P
  3180. 16005  IF K$="*" THEN JP=10
  3181. 16010  IF K$="/" THEN JP=11
  3182. 16015  IF K$="-" THEN JP=13
  3183. 16020  IF K$="+" THEN JP=14
  3184. 16025  IF K$=CHR$(8)       THEN JP=7
  3185. 16030  IF K$="c" OR K$="C" THEN JP=8
  3186. 16035  IF K$="r" OR K$="R" THEN JP=9
  3187. 16040  IF K$="p" OR K$="P" THEN JP=12
  3188. 16045  IF K$="n" OR K$="N" THEN JP=15
  3189. 16050  IF K$="%"           THEN JP=16
  3190. 16055  IF K$="="           THEN JP=17
  3191. 16060  IF K$=CHR$(13)      THEN JP=18
  3192. 16065  RETURN
  3193. 16070  '
  3194. 16075 *MAIN_CALK
  3195. 16080  IF C_SW=0 THEN QX#=VAL(S$)
  3196. 16085  IF C_SW=1 THEN QX#=QX#*VAL(S$)
  3197. 16090  IF C_SW=2 THEN IF VAL(S$)=0 THEN ER=1    ELSE QX#=QX#/VAL(S$)
  3198. 16095  IF C_SW=3 THEN QX#=QX#-VAL(S$)
  3199. 16100  IF C_SW=4 THEN QX#=QX#+VAL(S$)
  3200. 16105  IF ER=1 THEN SX$="ｴﾗｰ"  :QX#=0  :ER=0
  3201. 16110  SX$=STR$(QX#)   :S$=""
  3202. 16115  RETURN
  3203. 16120  '
  3204. 16125 *BOTAN_P
  3205. 16130  GOSUB *SUJI_PRINT
  3206. 16135  Y=INT(P/6)*20+MPYL+60   :X=(P MOD 6)*20+MPXL+10
  3207. 16140  LINE (X,Y)-(X+20,Y+20),XOR,%BCL(2),BF
  3208. 16145  IF MOUSE(2,0)=0  THEN  WAIT 20
  3209. 16150  WHILE MOUSE(2,0)=-1   :WEND
  3210. 16155  LINE (X,Y)-(X+20,Y+20),XOR,%BCL(2),BF
  3211. 16160  RETURN
  3212. 16165 '-------------------------------------------------------------------
  3213. 16170 *BANK_P
  3214. 16175  A=NP(NEXP)   :GOSUB *SWAP_XY
  3215. 16180  MPXL=PXL%(8) :MPYL=PYL%(8)  :MPXE=PXE%(8)  :MPYE=PYE%(8)
  3216. 16185  A=8          :GOSUB *OPEN_P
  3217. 16190  *BANK_P2
  3218. 16195  BDP=9  :BPQ=0  :YU=28  :WKST=1  :REF_SW=0
  3219. 16200  GOSUB *SEL_WAKP
  3220. 16205  IF JPQ=1 THEN GOTO *NEX_P
  3221. 16210  RETURN
  3222. 16215  '
  3223. 16220 *BD_9P
  3224. 16225  WINDOW (MPXL+VHL+1,MPYL+17)-(MPXF+VHL-17,MPYF-17)
  3225. 16230  VIEW   (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  3226. 16235  IF VHL<200 THEN A$=" [ 普 通 ]"  ELSE A$=" [ 定 期 ]"
  3227. 16240  FILS$="預 金 通 帳"+A$
  3228. 16245  GOSUB *BD9_LINE
  3229. 16250  XL=MPXL-190  :YL=MPYL+75  :GOSUB *BANKN_PUT  :GOSUB *TEIKI_PUT
  3230. 16255  IF BMAX=0 THEN WINDOW (0,0)-(639,479) :VIEW (0,0)-(639,479) :RETURN
  3231. 16260  XL=MPXL+5  :YL=MPYL+75  :E=15  :CL=BCL(0)
  3232. 16265  GOSUB *SYOKEI_P9   :BZAN2#=BZANX#
  3233. 16270  FOR A=CSPB TO BMAX
  3234. 16275      SYMBOL(XL-10-LEN(STR$(A))*8,YL),STR$(A)+".",1,1,%BCL(0)
  3235. 16280      A$=BYM$(A-1)     :P=9   :PL=0    :GOSUB *PUT_DAT
  3236. 16285      IF BCD(A-1)=0 THEN A$=""                                                                  ELSE A$=MID$(STR$(BCD(A-1)),2) :                                                 IF LEN(A$)<3 THEN A$=RIGHT$("00"+A$,3)
  3237. 16290      P=6    :PL=9*8  :GOSUB *PUT_DAT
  3238. 16295      A$=LEFT$(BME$(A-1),BSX-51)  :P=BSX-36 :PL=15*8 :GOSUB *PUT_DAT
  3239. 16300                      BA#=BIN#(A-1)
  3240. 16305                      IF BA#=0 THEN A$=""   ELSE A$=STR$(BA#)
  3241. 16310                      P=BSX-24  :PL=(BSX-36)*8  :GOSUB *CONMA_P
  3242. 16315                      GOSUB *PUT_DAT
  3243. 16320 '
  3244. 16325                      BB#=BOUT#(A-1)
  3245. 16330                      IF BB#=0 THEN A$=""    ELSE A$=STR$(BB#)
  3246. 16335                      P=BSX-12  :PL=(BSX-24)*8  :GOSUB *CONMA_P
  3247. 16340                      GOSUB *PUT_DAT
  3248. 16345 '
  3249. 16350                      BZAN2#=BZAN2#+BA#-BB#
  3250. 16355                      A$=STR$(BZAN2#)
  3251. 16360                      P=BSX     :PL=(BSX-12)*8  :GOSUB *CONMA_P
  3252. 16365                      GOSUB *PUT_DAT
  3253. 16370      YL=YL+18
  3254. 16375      IF YL>MPYF-32 THEN 16385
  3255. 16380  NEXT A
  3256. 16385  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  3257. 16390  GOSUB *CASOL_P9  :GOSUB *CASOL_P9B
  3258. 16395  RETURN
  3259. 16400 '
  3260. 16405 *BANKN_PUT
  3261. 16410  IF BNMAX=0 OR VHL>0 THEN RETURN
  3262. 16415  FOR A=BNL TO BNMAX
  3263. 16420      SYMBOL(XL-10-LEN(STR$(A))*8,YL+(A-BNL)*18),                                        STR$(A)+".",1,1,%BCL(0)
  3264. 16425      IF A=BANKP THEN  LINE (XL-1,YL+(A-BNL)*18-1)-                                                      STEP(16*8,18),XOR,%BCL(0),BF,%BCL(23)
  3265. 16430      SYMBOL(XL,YL+(A-BNL)*18),LEFT$(BNAME$(A-1),16),1,1,%BCL(0)
  3266. 16435      IF A*18>MPYF-16 THEN RETURN
  3267. 16440  NEXT A
  3268. 16445  RETURN
  3269. 16450  '
  3270. 16455 *CONMA_P
  3271. 16460  S=LEN(A$)
  3272. 16465  U=INT(S/3)   :IF U<1 THEN RETURN
  3273. 16470  B$=""
  3274. 16475  FOR U=S TO 1  STEP -1
  3275. 16480      B$=MID$(A$,U,1)+B$
  3276. 16485      IF ((S-U+1) MOD 3)=0 AND U>2 THEN B$=","+B$
  3277. 16490  NEXT U
  3278. 16495  A$=B$
  3279. 16500  RETURN
  3280. 16505 '
  3281. 16510 *TEIKI_PUT
  3282. 16515  IF TMAX<1 THEN RETURN
  3283. 16520  XL=MPXL+(BSX+6)*8+4   :YL=MPYL+75  :E=15  :CL=BCL(0)
  3284. 16525  FOR A=CSPT TO TMAX
  3285. 16530      SYMBOL(XL-8-LEN(STR$(A))*8,YL),STR$(A)+".",1,1,%BCL(0)
  3286. 16535      A$=TYD$(A-1)       :P=9      :PL=0          :GOSUB *PUT_DAT
  3287. 16540      A$=LEFT$(TYN$(A-1),TBX) :P=TBX+9  :PL=9*8   :GOSUB *PUT_DAT
  3288. 16545      A$=STR$(TYI#(A-1)) :P=TBX+21 :PL=(TBX+9)*8  :GOSUB *CONMA_P
  3289. 16550      GOSUB *PUT_DAT
  3290. 16555      A$=TYK$(A-1)       :P=TBX+30 :PL=(TBX+21)*8 :GOSUB *PUT_DAT
  3291. 16560      A$=STR$(TYO#(A-1)) :P=TBX+42 :PL=(TBX+30)*8 :GOSUB *CONMA_P
  3292. 16565      GOSUB *PUT_DAT
  3293. 16570      YL=YL+18
  3294. 16575      IF YL>MPYF-32 THEN RETURN
  3295. 16580  NEXT A
  3296. 16585  RETURN
  3297. 16590  '
  3298. 16595 *BD9_LINE
  3299. 16600  IF BSX=<0 THEN BSX=59
  3300. 16605  IF TBX=<0 THEN TBX=14
  3301. 16610  XL=MPXL+5  :YL=MPYL+70
  3302. 16615  GOSUB *TEIKI_ZAN
  3303. 16620      IF BANKP>0 THEN  BN$=LEFT$(BNAME$(BANKP-1),16)                                         ELSE  BN$="銀行名選択"
  3304. 16625      SYMBOL(XL+4,YL-50),BN$,1,1,%BCL(10)
  3305. 16630      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  3306. 16635      LINE (XL+BSX*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3307. 16640      LINE (XL,YL  )-STEP((BSX+2)*8-16,0),PSET,%BCL(0)
  3308. 16645      LINE (XL-200,YL-5)-STEP(0,7),PSET,%BCL(0)
  3309. 16650      LINE (XL-60 ,YL-5)-STEP(0,7),PSET,%BCL(0)
  3310. 16655      LINE (XL-200,YL  )-STEP(140,0),PSET,%BCL(0)
  3311. 16660      SYMBOL(XL-250,YL-10),"No",1,1,%BCL(0)
  3312. 16665      SYMBOL(XL-195,YL-28),"[銀行名]  ↑ ↓",1,1,%BCL(0)
  3313. 16670      SYMBOL(XL-50,YL-10),"No",1,1,%BCL(0)
  3314. 16675      SYMBOL(XL,YL-28),"[年月日]",1,1,%BCL(0)
  3315. 16680      LINE (XL+72,YL-5)-STEP(0,7),PSET,%BCL(0)
  3316. 16685      SYMBOL(XL+72,YL-28),"[取扱]",1,1,%BCL(0)
  3317. 16690      LINE (XL+120,YL-5)-STEP(0,7),PSET,%BCL(0)
  3318. 16695      SYMBOL(XL+120,YL-10),STR$(BSX-51),.7!,.7!,%BCL(0)
  3319. 16700      SYMBOL(XL+120,YL-28),"[名 目]",1,1,%BCL(0)
  3320. 16705      LINE (XL+(BSX-36)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3321. 16710      SYMBOL(XL+(BSX-36)*8,YL-28),"[預 入]",1,1,%BCL(0)
  3322. 16715      LINE (XL+(BSX-24)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3323. 16720      SYMBOL(XL+(BSX-24)*8,YL-28),"[引 出]",1,1,%BCL(0)
  3324. 16725      LINE (XL+(BSX-12)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3325. 16730      SYMBOL(XL+(BSX-12)*8,YL-28),"[残 高]   →   ←",1,1,%BCL(0)
  3326. 16735      LINE (XL+(BSX-42)*8,YL-34)-STEP(42*8,0),PSET,%BCL(0)
  3327. 16740      LINE (XL+(BSX-42)*8,YL-50)-STEP(42*8,16),XOR,%BCL(21),BF
  3328. 16745      SYMBOL(XL+(BSX-42)*8+4,YL-50),"合 計",1,1,%BCL(0)
  3329. 16750      LINE (XL+(BSX-36)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3330. 16755      A$=STR$(BIN1#)   :GOSUB *CONMA_P  :P=LEN(A$)
  3331. 16760      SYMBOL(XL+(BSX-24-P)*8,YL-50),A$,1,1,%BCL(0)
  3332. 16765      LINE (XL+(BSX-24)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3333. 16770      A$=STR$(BOUT1#)  :GOSUB *CONMA_P  :P=LEN(A$)
  3334. 16775      SYMBOL(XL+(BSX-12-P)*8,YL-50),A$,1,1,%BCL(0)
  3335. 16780      LINE (XL+(BSX-12)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3336. 16785      A$=STR$(BZAN1#)  :GOSUB *CONMA_P  :P=LEN(A$)
  3337. 16790      SYMBOL(XL+(BSX-P)*8,YL-50),A$,1,1,%BCL(0)
  3338. 16795      LINE (XL+BSX*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3339. 16800      SYMBOL(MPXL+BSX*8+54,MPYL+20),BN$,1,1,%BCL(10)
  3340. 16805      SYMBOL(XL+BSX*8+5,YL-10),"No",1,1,%BCL(0)
  3341. 16810      LINE (XL+(BSX+6)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3342. 16815      LINE (XL+(BSX+6)*8,YL  )-STEP((TBX+42)*8,0),PSET,%BCL(0)
  3343. 16820      LINE (XL+(BSX+TBX+11)*8,YL-34  )-STEP(17*8,0),PSET,%BCL(0)
  3344. 16825      LINE (XL+(BSX+TBX+32)*8,YL-34  )-STEP(16*8,0),PSET,%BCL(0)
  3345. 16830      LINE (XL+(BSX+15)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3346. 16835      LINE (XL+(BSX+TBX+15)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3347. 16840      LINE (XL+(BSX+TBX+15)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3348. 16845      LINE (XL+(BSX+TBX+27)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3349. 16850      LINE (XL+(BSX+TBX+27)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3350. 16855      LINE (XL+(BSX+TBX+36)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3351. 16860      LINE (XL+(BSX+TBX+36)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3352. 16865      LINE (XL+(BSX+TBX+48)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  3353. 16870      LINE (XL+(BSX+TBX+48)*8,YL-39)-STEP(0,7),PSET,%BCL(0)
  3354. 16875      SYMBOL(XL+(BSX+15)*8,YL-10),STR$(TBX),.7!,.7!,%BCL(0)
  3355. 16880      SYMBOL(XL+(BSX+ 6)*8,YL-28),"[預入日]",1,1,%BCL(0)
  3356. 16885      SYMBOL(XL+(BSX+15)*8,YL-28),"[口座名]",1,1,%BCL(0)
  3357. 16890      SYMBOL(XL+(BSX+TBX+15)*8,YL-28),"[預金額]",1,1,%BCL(0)
  3358. 16895      LINE  (XL+(BSX+TBX+11)*8,YL-50)-STEP(16*8,16),XOR,%BCL(21),BF
  3359. 16900      SYMBOL(XL+(BSX+TBX+11)*8,YL-50),"合計",1,1,%BCL(0)
  3360. 16905      A$=STR$(TZAN1#)  :GOSUB *CONMA_P  :P=LEN(A$)
  3361. 16910      SYMBOL(XL+(BSX+TBX+27-P)*8,YL-50),A$,1,1,%BCL(0)
  3362. 16915      SYMBOL(XL+(BSX+TBX+27)*8,YL-28),"[解約日]",1,1,%BCL(0)
  3363. 16920      SYMBOL(XL+(BSX+TBX+36)*8,YL-28),"[受取額] ↓↑",1,1,%BCL(0)
  3364. 16925      LINE  (XL+(BSX+TBX+32)*8,YL-50)-STEP(16*8,16),XOR,%BCL(21),BF
  3365. 16930      SYMBOL(XL+(BSX+TBX+32)*8,YL-50),"残高",1,1,%BCL(0)
  3366. 16935      A$=STR$(TZAN3#)  :GOSUB *CONMA_P  :P=LEN(A$)
  3367. 16940      SYMBOL(XL+(BSX+TBX+48-P)*8,YL-50),A$,1,1,%BCL(0)
  3368. 16945      A$="["+MID$(STR$(PAGE1(BANKP)+1),2)+"頁]"
  3369. 16950      SYMBOL(MPXL-50,MPYL+20),A$,1,1,%BCL(6)
  3370. 16955      A$="["+MID$(STR$(PAGE2(BANKP)+1),2)+"頁]"
  3371. 16960      SYMBOL(MPXL+BSX*8+5,MPYL+20),A$,1,1,%BCL(6)
  3372. 16965  RETURN
  3373. 16970 '
  3374. 16975 *YL_DOWN9
  3375. 16980  CSPB=CSPB+1
  3376. 16985  IF CSPB>BMAX THEN CSPB=BMAX
  3377. 16990  GOSUB *BD_SUBP
  3378. 16995  RETURN
  3379. 17000 '
  3380. 17005 *YL_UP9
  3381. 17010  CSPB=CSPB-1
  3382. 17015  IF CSPB<1 THEN CSPB=1
  3383. 17020  GOSUB *BD_SUBP
  3384. 17025  RETURN
  3385. 17030 '
  3386. 17035 *XL_LEFT9
  3387. 17040  VHL=VHL-100
  3388. 17045  GOSUB *BD_SUBP
  3389. 17050  RETURN
  3390. 17055 '
  3391. 17060 *XL_RIGHT9
  3392. 17065  VHL=VHL+100
  3393. 17070  GOSUB *BD_SUBP
  3394. 17075  RETURN
  3395. 17080 '
  3396. 17085 *CASOL_P9
  3397. 17090  A=BMAX :B=CSPB
  3398. 17095  GOSUB *CASOL_PX1
  3399. 17100  RETURN
  3400. 17105 '
  3401. 17110 *CASOL_P9B
  3402. 17115  A=(BSX+2)*8 :B=VHL
  3403. 17120  GOSUB *CASOL_PX2
  3404. 17125  RETURN
  3405. 17130  '
  3406. 17135 *CSL_S9
  3407. 17140  IF BMAX=0 THEN GOSUB *RET_W :RETURN
  3408. 17145  A=BMAX
  3409. 17150  GOSUB *ｶｰｿﾙ_SET1
  3410. 17155  CSPB=P
  3411. 17160  GOSUB *BD_SUBP
  3412. 17165  RETURN
  3413. 17170 '
  3414. 17175 *BSCR_P9
  3415. 17180  VHP=VHL   :CRB=BCL(5)   :INTERVAL ON
  3416. 17185 *BSCR_P9B
  3417. 17190  TIMX$=""  :GOSUB *CLOCK_P
  3418. 17195  IF MUX>MPXL+BSX*8+5-VHL THEN *BSCR_P9T
  3419. 17200  YL=INT((MUY-MPYL-75)/18)
  3420. 17205  IF YL<0 THEN
  3421. 17210              IF MUY<MPYL+42  THEN *BANK_EXE
  3422. 17215              IF MUY<MPYL+58  THEN *BCOD_EXE
  3423. 17220              GOTO *LINE_EXE9
  3424. 17225          ENDIF
  3425. 17230  IF PAGE1S<>PAGE1(BANKP) THEN *PAGE1_ERR
  3426. 17235  BOXP=YL+CSPB
  3427. 17240  IF BOXP>BMAX THEN *BMN_INPUT
  3428. 17245  IF BOXP>0    THEN *BMN_EXE
  3429. 17250  GOSUB *RET_W
  3430. 17255  RETURN
  3431. 17260 '
  3432. 17265 *LINE_EXE9
  3433. 17270  IF MUX<MPXL+120-VHL OR MUX>MPXL+120+(BSX-51)*8-VHL THEN RETURN
  3434. 17275  GOSUB *LINE_EXEP
  3435. 17280  IF CAR_END=1 THEN BSX=VAL(MX$)+51
  3436. 17285  GOSUB *SCR_BACK
  3437. 17290  RETURN
  3438. 17295 '
  3439. 17300 *BMN_EXE
  3440. 17305  WHILE MOUSE(2,0)=-1  :WEND
  3441. 17310  IF MUX<MPXL-VHL THEN *BANK_NEXE
  3442. 17315  GOSUB *BCRD_SET  :IF ER=1 THEN ER=0 :GOTO 17415
  3443. 17320  GOSUB *BCRP_SET  :XLP=LEN(MX$)
  3444. 17325  GOSUB *KEY_CR
  3445. 17330                EXE_SW=1
  3446. 17335                GOSUB *INKEY_P
  3447. 17340                EXE_SW=0
  3448. 17345                IF RCLICK>0 THEN CRB=BCL(10) :GOSUB *KEY_CR     :                                       CRB=BCL(5) :GOSUB *KILL_P9 :GOTO 17420
  3449. 17350                IF LCLICK>0 THEN
  3450. 17355                    CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  3451. 17360                    IF KPS=3 THEN GOSUB *BGET_CORD :                                               IF GET_ON=0 THEN *BSCR_P9B                                                              ELSE INK_END=0  :CAR_END=1
  3452. 17365                    IF KPS>3 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P9B
  3453. 17370                   ENDIF
  3454. 17375  IF INK_END=0 THEN
  3455. 17380                    GOSUB *BMX_SET    :GOSUB *KEY_CR
  3456. 17385                    IF CAR_END=1 THEN  GOSUB *BCRD_NSET
  3457. 17390                    GOSUB *BOLD_BACK
  3458. 17395                    GOTO  *BSCR_P9B
  3459. 17400               ELSE
  3460. 17405                    WHILE MOUSE(2,1)=-1   :WEND
  3461. 17410               ENDIF
  3462. 17415  MOUSE 5
  3463. 17420  GOSUB *BANK_SAVE   :VHL=VHP  :GOSUB *SCR_BACK
  3464. 17425  RETURN
  3465. 17430 '
  3466. 17435 *BMN_INPUT
  3467. 17440  IF MUX<MPXL-VHL THEN *BANK_NINP
  3468. 17445  BOXP=BMAX+1   :IF BMAX>=BNZ THEN GOSUB *FLL_BMN :GOTO 17565
  3469. 17450  BYM$(BMAX)="" :BCD(BMAX)=0  :BME$(BMAX)=""
  3470. 17455  BIN#(BMAX)=0  :BOUT#(BMAX)=0
  3471. 17460  GOSUB *BCRD_SET   :IF ER=1 THEN ER=0 :GOTO 17560
  3472. 17465  MX$=""   :GOSUB *KEY_CR
  3473. 17470  WHILE MOUSE(2,0)=-1     :WEND
  3474. 17475                EXE_SW=1
  3475. 17480                GOSUB *INKEY_P
  3476. 17485                EXE_SW=0
  3477. 17490                IF LCLICK>0 THEN
  3478. 17495                   CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  3479. 17500                   IF KPS=3 THEN GOSUB *BGET_CORD :                                               IF GET_ON=0 THEN *BSCR_P9B                                                              ELSE INK_END=0  :CAR_END=1
  3480. 17505                   IF KPS>3 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P9B
  3481. 17510                  ENDIF
  3482. 17515  IF INK_END=0 THEN
  3483. 17520                    BMAX=BMAX+1       :BOXP=BMAX
  3484. 17525                    GOSUB *BMX_SET    :GOSUB *KEY_CR
  3485. 17530                    IF CAR_END=1 THEN  GOSUB *BCRD_NSET
  3486. 17535                    GOSUB *BOLD_BACK
  3487. 17540                    GOTO  *BSCR_P9B
  3488. 17545               ELSE
  3489. 17550                    WHILE MOUSE(2,1)=-1   :WEND
  3490. 17555               ENDIF
  3491. 17560  MOUSE 5
  3492. 17565  GOSUB *BANK_SAVE   :VHL=VHP  :GOSUB *SCR_BACK
  3493. 17570  RETURN
  3494. 17575 '
  3495. 17580 *BCRD_SET
  3496. 17585  P=INT((MUX-MPXL-5+VHL)/8)
  3497. 17590  IF P<0 OR P>(BSX-12) THEN  ER=1  :RETURN
  3498. 17595  IF P>=0  AND P<8         THEN CRXF=MPXL :CRXE=CRXF+8*8 :                                                  CRLEN=10  :KPS=1
  3499. 17600  IF P>=8  AND P<15        THEN CRXF=MPXL+9*8  :CRXE=CRXF+15*8 :                                            CRLEN=6   :KPS=2
  3500. 17605  IF P>=15  AND P<(BSX-36) THEN CRXF=MPXL+15*8 :CRXE=CRXF+(BSX-51)*8 :                                      CRLEN=(BSX-50) :KPS=3
  3501. 17610  IF P>=(BSX-36) AND P<(BSX-24) THEN CRXF=MPXL+(BSX-36)*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=4
  3502. 17615  IF P>=(BSX-24) AND P<(BSX-12) THEN CRXF=MPXL+(BSX-24)*8 :                                                      CRXE=CRXF+12*8  :CRLEN=13 :KPS=5
  3503. 17620  CRXF=CRXF+5-VHL   :CRXE=CRXE+5-VHL
  3504. 17625  CRYF=MPYL+75+(BOXP-CSPB)*18  :CRYE=CRYF+18
  3505. 17630  IF CRYF>MPYF-32 THEN  CSPB=CSPB+1  :GOSUB *BD_9P  :GOTO 17625
  3506. 17635  XLP=0
  3507. 17640  RETURN
  3508. 17645 '
  3509. 17650 *BCRP_SET
  3510. 17655  MX$=""
  3511. 17660  IF KPS=1  THEN  MX$=BYM$(BOXP-1)
  3512. 17665  IF KPS=2  THEN  MX$=MID$(STR$(BCD(BOXP-1)),2)
  3513. 17670  IF KPS=3  THEN  MX$=BME$(BOXP-1)
  3514. 17675  IF KPS=4  THEN  MX$=STR$(BIN#(BOXP-1))
  3515. 17680  IF KPS=5  THEN  MX$=STR$(BOUT#(BOXP-1))
  3516. 17685  IF MX$="0" OR MX$=" 0" THEN MX$=""
  3517. 17690  RETURN
  3518. 17695 '
  3519. 17700 *BMX_SET
  3520. 17705  IF KPS=1 THEN  BYM$(BOXP-1) =MX$
  3521. 17710  IF KPS=2 THEN  BCD(BOXP-1)  =VAL(MX$)
  3522. 17715  IF KPS=3 THEN  BME$(BOXP-1) =MX$
  3523. 17720  IF KPS=4 THEN  BIN#(BOXP-1) =VAL(MX$)  :BZAN1#=BZAN1#+BIN#(BOXP-1) :                       BIN1#=BIN1#+BIN#(BOXP-1)
  3524. 17725  IF KPS=5 THEN  BOUT#(BOXP-1)=VAL(MX$)  :BZAN1#=BZAN1#-BOUT#(BOXP-1):                       BOUT1#=BOUT1#+BOUT#(BOXP-1)
  3525. 17730  RETURN
  3526. 17735 '
  3527. 17740 *BCRD_NSET
  3528. 17745  IF KPS=1 THEN  BLEN=9*8   :MUX=MPXL+BLEN+5      :NLEN=6
  3529. 17750  IF KPS=2 THEN  BLEN=6*8   :MUX=MPXL+BLEN+9*8+5  :NLEN=(BSX-51)
  3530. 17755  IF KPS=3 AND KPJ>=0 THEN
  3531. 17760           MUX=MPXL+(BSX-42)*8+5   :NLEN=12
  3532. 17765           IF KMT%(KPJ)=2 THEN BLEN=24*8      ELSE BLEN=12*8 
  3533. 17770           MUX=MUX+BLEN
  3534. 17775      ENDIF
  3535. 17780  IF KPS=4 THEN  BLEN=12*8   :MUX=MPXL+BLEN+(BSX-30)*8+5 :NLEN=12
  3536. 17785  IF KPS=5 THEN  MUX=MPXL+20 :MUY=CRYF+20   :NLEN=12 :VHL=0
  3537. 17790  IF MUX>MPXF-32-NLEN*8+VHL THEN  VHL=VHL+NLEN*8
  3538. 17795  IF MUX<MPXL+5  THEN  MUX=MPXL+20
  3539. 17800  IF MUY>MPYF-32 THEN  CSPB=CSPB+1  :MUY=MUY-20
  3540. 17805  MUX=MUX-VHL
  3541. 17810  RETURN
  3542. 17815 '
  3543. 17820 *BGET_CORD
  3544. 17825  INTERVAL OFF  :MOUSE 5
  3545. 17830  REF_SW=1      :CRXF_S=CRXF     :CRYF_S=CRYF   :GET_ON=0
  3546. 17835  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :MUX_Q=MUX     :MUY_Q=MUY
  3547. 17840  GOSUB *CORD_P
  3548. 17845  A=NP(NEXP-1)  :GOSUB *SWAP_XY
  3549. 17850  GOSUB *SCR_BACK
  3550. 17855  GOSUB *SET_XYD
  3551. 17860  INTERVAL ON :TIMX$=""      :GOSUB *CLOCK_P
  3552. 17865  JP=9        :REW_X=PXE%(8) :REW_Y=PYE%(8)
  3553. 17870  IF GET_ON=1 THEN  MX$=CODN$
  3554. 17875  INK_END=0   :CAR_END=1   :REF_SW=0  :CRB=BCL(5)
  3555. 17880  CRXF=CRXF_S :CRYF=CRYF_S :MUX=MUX_Q :MUY=MUY_Q
  3556. 17885  MOUSE 0 :MOUSE 1,MUX,MUY,1
  3557. 17890  WHILE MOUSE(2,0)=-1      :WEND
  3558. 17895  RETURN
  3559. 17900 '
  3560. 17905 *SYOKEI_P9
  3561. 17910  BZAN1#=BZAN#  :BIN1#=0  :BOUT1#=0  :BZANX#=0
  3562. 17915  IF BMAX<1 THEN RETURN
  3563. 17920  FOR A=0 TO BMAX-1
  3564. 17925      BZAN1#=BZAN1#+BIN#(A)-BOUT#(A)
  3565. 17930      IF A<CSPB-1 THEN BZANX#=BZAN1#
  3566. 17935      BIN1#=BIN1#+BIN#(A)
  3567. 17940      BOUT1#=BOUT1#+BOUT#(A)
  3568. 17945  NEXT A
  3569. 17950  RETURN
  3570. 17955 '
  3571. 17960 *TEIKI_UP
  3572. 17965  CSPT=CSPT+1
  3573. 17970  IF CSPT>TMAX THEN CSPT=TMAX
  3574. 17975  GOSUB *BD_SUBP
  3575. 17980  RETURN
  3576. 17985  '
  3577. 17990 *TEIKI_DOWN
  3578. 17995  CSPT=CSPT-1
  3579. 18000  IF CSPT<1 THEN CSPT=1
  3580. 18005  GOSUB *BD_SUBP
  3581. 18010  RETURN
  3582. 18015  '
  3583. 18020 *BCOD_EXE
  3584. 18025  IF MUX>MPXL+(BSX+TBX+46)*8-16-VHL AND MUX<MPXL+(BSX+TBX+47)*8-VHL               THEN  GOSUB *TEIKI_UP    :RETURN
  3585. 18030  IF MUX>MPXL+(BSX+TBX+48)*8-16-VHL AND MUX<MPXL+(BSX+TBX+49)*8-VHL               THEN  GOSUB *TEIKI_DOWN  :RETURN
  3586. 18035  IF MUX>MPXL+BSX*8-16-VHL AND MUX<MPXL+BSX*8-VHL                                 THEN VHL=BSX*8+24  :GOSUB *BOLD_BACK  :RETURN
  3587. 18040  IF MUX>MPXL+BSX*8+32-VHL AND MUX<MPXL+BSX*8+48-VHL                              THEN VHL=0         :GOSUB *BOLD_BACK  :RETURN
  3588. 18045  IF MUX>MPXL+(BSX+15)*8-VHL AND MUX<MPXL+(BSX+TBX+15)*8-VHL                      THEN GOSUB *TGET_CORD2  :RETURN
  3589. 18050  IF MUX>MPXL-VHL AND MUX<MPXL+8*8-VHL                                            THEN GOSUB *BYMD_EXE    :RETURN
  3590. 18055  IF MUX>MPXL+(BSX+6)*8-VHL AND MUX<MPXL+(BSX+14)*8-VHL                           THEN GOSUB *TYMD_EXE    :RETURN
  3591. 18060  IF MUX>(MPXL+(BSX-50)*8+125-VHL) THEN RETURN
  3592. 18065  IF MUX<(MPXL+125-VHL)            THEN *BANK_CASOL
  3593. 18070  REF_SW=1
  3594. 18075  INTERVAL OFF
  3595. 18080  GOSUB *BGET_CORD
  3596. 18085  INTERVAL ON   :TIMX$=""  :GOSUB *CLOCK_P
  3597. 18090  REF_SW=0
  3598. 18095  REW_X=PXE%(8) :REW_Y=PYE%(8) :JP=9
  3599. 18100  RETURN
  3600. 18105 '
  3601. 18110 *BYMD_EXE
  3602. 18115  FOR A=0 TO BMAX-2
  3603. 18120      A$=BYM$(A) :GOSUB *BYM_RSET  :C=P
  3604. 18125        FOR B=A TO BMAX-1
  3605. 18130            A$=BYM$(B) :GOSUB *BYM_RSET
  3606. 18135            IF P<C THEN GOSUB *SWAP_BYM
  3607. 18140        NEXT B
  3608. 18145  NEXT A
  3609. 18150  GOSUB *BANK_SAVE
  3610. 18155  GOSUB *BOLD_BACK
  3611. 18160  RETURN
  3612. 18165  '
  3613. 18170 *BYM_RSET
  3614. 18175  P=VAL(LEFT$(A$,2))*10000+VAL(MID$(A$,4,2))*100+VAL(RIGHT$(A$,2))
  3615. 18180  RETURN
  3616. 18185 '
  3617. 18190 *SWAP_BYM
  3618. 18195  SWAP BYM$(A) ,BYM$(B)
  3619. 18200  SWAP BCD(A)  ,BCD(B)
  3620. 18205  SWAP BME$(A) ,BME$(B)
  3621. 18210  SWAP BIN#(A) ,BIN#(B)
  3622. 18215  SWAP BOUT#(A),BOUT#(B)
  3623. 18220  RETURN
  3624. 18225  '
  3625. 18230 *TYMD_EXE
  3626. 18235  FOR A=0 TO TMAX-2
  3627. 18240      A$=TYD$(A) :GOSUB *BYM_RSET  :C=P
  3628. 18245        FOR B=A TO TMAX-1
  3629. 18250            A$=TYD$(B) :GOSUB *BYM_RSET
  3630. 18255            IF P<C THEN GOSUB *SWAP_TYD
  3631. 18260        NEXT B
  3632. 18265  NEXT A
  3633. 18270  GOSUB *TEIKI_SAVE
  3634. 18275  GOSUB *BOLD_BACK
  3635. 18280  RETURN
  3636. 18285  '
  3637. 18290 *SWAP_TYD
  3638. 18295  SWAP TYD$(A) ,TYD$(B)
  3639. 18300  SWAP TYN$(A) ,TYN$(B)
  3640. 18305  SWAP TYI#(A) ,TYI#(B)
  3641. 18310  SWAP TYK$(A) ,TYK$(B)
  3642. 18315  SWAP TYO#(A) ,TYO#(B)
  3643. 18320  RETURN
  3644. 18325 '
  3645. 18330 *KILL_P9
  3646. 18335  IF BOXP>BNZ  THEN 18375
  3647. 18340  FOR A=BOXP-1 TO BMAX-2
  3648. 18345      SWAP BYM$(A) ,BYM$(A+1)
  3649. 18350      SWAP BCD(A)  ,BCD(A+1)
  3650. 18355      SWAP BME$(A) ,BME$(A+1)
  3651. 18360      SWAP BIN#(A) ,BIN#(A+1)
  3652. 18365      SWAP BOUT#(A),BOUT#(A+1)
  3653. 18370  NEXT A
  3654. 18375  IF BMAX>0 THEN BMAX=BMAX-1
  3655. 18380  RETURN
  3656. 18385 '
  3657. 18390 *INST_P9
  3658. 18395  IF BMAX<1 THEN P=1  :RETURN
  3659. 18400  IF P>BNZ-2   THEN ER=1 :RETURN
  3660. 18405  FOR A=BMAX-1 TO P-1 STEP-1
  3661. 18410      BYM$(A+1) =BYM$(A)
  3662. 18415      BCD(A+1)  =BCD(A)
  3663. 18420      BME$(A+1) =BME$(A)
  3664. 18425      BIN#(A+1) =BIN#(A)
  3665. 18430      BOUT#(A+1)=BOUT#(A)
  3666. 18435  NEXT A
  3667. 18440  BMAX=BMAX+1
  3668. 18445  RETURN
  3669. 18450 '
  3670. 18455 *BANK_EXE
  3671. 18460  IF BANKP>0 THEN A$=BNAME$(BANKP-1)  ELSE A$=STRING$(20," ")
  3672. 18465  IF MUX>MPXL+(BSX+6)*8-VHL AND MUX<MPXL+(BSX+LEN(A$)+6)*8-VHL                   THEN 18485
  3673. 18470  IF MUX>MPXL-VHL-50 AND MUX<MPXL-VHL THEN *PAGE1_EXE
  3674. 18475  IF MUX>MPXL-VHL+BSX*8+5 AND MUX<MPXL-VHL+(BSX+6)*8 THEN *PAGE2_EXE
  3675. 18480  IF MUX>MPXL-VHL+120 OR MUX<MPXL-VHL THEN RETURN
  3676. 18485  VHL=-250
  3677. 18490  GOSUB *BD_SUBP
  3678. 18495  RETURN
  3679. 18500  '
  3680. 18505 *PAGE1_EXE
  3681. 18510  RCLICK=MOUSE(3,1)
  3682. 18515  WHILE MOUSE(2,0)=-1
  3683. 18520        IF MOUSE(2,1)=-1 THEN GOSUB *REW_PAGE1
  3684. 18525  WEND
  3685. 18530  IF MOUSE(3,1)>0 THEN MOUSE 5 :RETURN
  3686. 18535  PAGE1(BANKP)=PAGE1(BANKP)+1
  3687. 18540  IF PAGE1(BANKP)>10 THEN PAGE1(BANKP)=0
  3688. 18545  MOUSE 5
  3689. 18550  GOSUB *BANK_DLOAD
  3690. 18555  GOSUB *BOLD_P2
  3691. 18560  RETURN
  3692. 18565  '
  3693. 18570 *REW_PAGE1
  3694. 18575  PAGE1(BANKP)=PAGE1(BANKP)-1
  3695. 18580  IF PAGE1(BANKP)<0 THEN PAGE1(BANKP)=10
  3696. 18585  GOSUB *BANK_DLOAD
  3697. 18590  GOSUB *BOLD_BACK
  3698. 18595  WHILE MOUSE(2,1)=-1  :WEND
  3699. 18600  RETURN
  3700. 18605  '
  3701. 18610 *PAGE2_EXE
  3702. 18615  RCLICK=MOUSE(3,1)
  3703. 18620  WHILE MOUSE(2,0)=-1
  3704. 18625        IF MOUSE(2,1)=-1 THEN GOSUB *REW_PAGE2
  3705. 18630  WEND
  3706. 18635  IF MOUSE(3,1)>0 THEN 18660
  3707. 18640  PAGE2(BANKP)=PAGE2(BANKP)+1
  3708. 18645  IF PAGE2(BANKP)>10 THEN PAGE2(BANKP)=0
  3709. 18650  GOSUB *TEIKI_LOAD
  3710. 18655  GOSUB *BOLD_BACK
  3711. 18660  MOUSE 5
  3712. 18665  RETURN
  3713. 18670  '
  3714. 18675 *REW_PAGE2
  3715. 18680  PAGE2(BANKP)=PAGE2(BANKP)-1
  3716. 18685  IF PAGE2(BANKP)<0 THEN PAGE2(BANKP)=10
  3717. 18690  GOSUB *TEIKI_LOAD
  3718. 18695  GOSUB *BOLD_BACK
  3719. 18700  WHILE MOUSE(2,1)=-1  :WEND
  3720. 18705  RETURN
  3721. 18710  '
  3722. 18715 *BANK_CASOL
  3723. 18720  IF MUX>MPXL-VHL-110  AND MUX<MPXL-VHL-90                                        THEN  GOSUB *BNAME_UP
  3724. 18725  IF MUX>MPXL-VHL-88  AND MUX<MPXL-VHL-70                                         THEN  GOSUB *BNAME_DOWN
  3725. 18730  WHILE MOUSE(2,0)=-1  :WEND
  3726. 18735  RETURN
  3727. 18740  '
  3728. 18745 *BNAME_UP
  3729. 18750  BNL=BNL-1
  3730. 18755  IF BNL<1 THEN BNL=1
  3731. 18760  GOSUB *BOLD_BACK
  3732. 18765  WHILE MOUSE(2,0)=-1  :WEND
  3733. 18770  RETURN
  3734. 18775  '
  3735. 18780 *BNAME_DOWN
  3736. 18785  BNL=BNL+1
  3737. 18790  IF BNL>BNMAX THEN BNL=BNMAX
  3738. 18795  GOSUB *BOLD_BACK
  3739. 18800  WHILE MOUSE(2,0)=-1  :WEND
  3740. 18805  RETURN
  3741. 18810  '
  3742. 18815 *BANK_NINP
  3743. 18820  PH=BOXP-CSPB+BNL      :IF BNMAX>=PH THEN *BANK_NEXE2
  3744. 18825  *BANK_NINP2
  3745. 18830  IF BNMAX>=26 THEN GOSUB *FLL_BANKN :GOTO 18890
  3746. 18835  CRXF=MPXL-190-VHL     :CRXE=CRXF+18*8-VHL  :CRLEN=19 
  3747. 18840  CRYF=MPYL+57+PH*18    :CRYE=CRYF+18
  3748. 18845  EXE_SW=1    :MX$=""   :XLP=0    :GOSUB *KEY_CR
  3749. 18850  GOSUB *INKEY_P
  3750. 18855  EXE_SW=0
  3751. 18860  IF INK_END=1 THEN  GOSUB *BD_SUBP :RETURN
  3752. 18865  IF MX$=""    THEN  GOSUB *BD_SUBP :RETURN
  3753. 18870  BANKP=PH
  3754. 18875  BNAME$(BNMAX)=MX$
  3755. 18880  BNMAX=BNMAX+1
  3756. 18885  GOSUB *BNAME_SAVE
  3757. 18890  GOSUB *SCR_BACK
  3758. 18895  RETURN
  3759. 18900  '
  3760. 18905 *BANK_NEXE
  3761. 18910  PH=BOXP-CSPB+BNL     :IF BNMAX<PH THEN *BANK_NINP2
  3762. 18915  *BANK_NEXE2
  3763. 18920  CRXF=MPXL-190-VHL    :CRXE=CRXF+18*8-VHL  :CRLEN=19
  3764. 18925  CRYF=MPYL+57+(PH-BNL+1)*18          :CRYE=CRYF+18
  3765. 18930  EXE_SW=1      :MX$=BNAME$(PH-1)     :LCLICK=MOUSE(3,0)
  3766. 18935  XLP=LEN(MX$)  :CRB=BCL(10)          :GOSUB *KEY_CR
  3767. 18940  WHILE MOUSE(2,0)=-1  :WEND
  3768. 18945  WAIT WAIX       :LCLICK=MOUSE(3,0)
  3769. 18950  IF LCLICK>0 THEN
  3770. 18955                    CRB=BCL(5) :GOSUB *KEY_CR :GOSUB *INKEY_P
  3771. 18960                    EXE_SW=0
  3772. 18965                    IF INK_END=1 THEN GOSUB *BD_SUBP    :RETURN
  3773. 18970                    IF MX$=""    THEN GOSUB *BD_SUBP    :RETURN
  3774. 18975                    BNAME$(PH-1)=MX$    :GOSUB *BNAME_SAVE
  3775. 18980              ELSE
  3776. 18985                    BANKP=PH
  3777. 18990                    CRB=BCL(10)         :GOSUB *KEY_CR
  3778. 18995                    GOSUB *BANK_DLOAD   :GOSUB *TEIKI_LOAD
  3779. 19000                    VHL=0               :CRB=BCL(5)
  3780. 19005                    PAGE1S=PAGE1(BANKP) :PAGE2S=PAGE2(BANKP)
  3781. 19010               ENDIF
  3782. 19015  GOSUB *SCR_BACK
  3783. 19020  RETURN
  3784. 19025  '
  3785. 19030 *BNAME_LOAD
  3786. 19035  ON ERROR GOTO *ERR_P9NL
  3787. 19040  OPEN "I",#1,FIL$(2)
  3788. 19045      INPUT #1,BNMAX
  3789. 19050      FOR A=0 TO BNMAX-1
  3790. 19055          INPUT #1,BNAME$(A)
  3791. 19060          INPUT #1,PAGE1(A)
  3792. 19065          INPUT #1,PAGE2(A)
  3793. 19070         IF EOF(1)=-1 THEN *BNLOAD_RET
  3794. 19075     NEXT A
  3795. 19080  *BNLOAD_RET
  3796. 19085  CLOSE #1
  3797. 19090  ON ERROR GOTO 0
  3798. 19095  BNL=1 
  3799. 19100  RETURN
  3800. 19105 '
  3801. 19110 *ERR_P9NL
  3802. 19115  IF ERR<>63 THEN *ERR_MESE
  3803. 19120  BNMAX=0
  3804. 19125  RESUME *BNLOAD_RET
  3805. 19130 '
  3806. 19135 *BNAME_SAVE
  3807. 19140  ON ERROR GOTO *ERR_P9NS
  3808. 19145  OPEN "O",#1,FIL$(2)
  3809. 19150       PRINT #1,BNMAX
  3810. 19155       FOR A=0 TO BNMAX-1
  3811. 19160           PRINT #1,BNAME$(A)
  3812. 19165           PRINT #1,PAGE1(A)
  3813. 19170           PRINT #1,PAGE2(A)
  3814. 19175       NEXT A
  3815. 19180  *BNSAVE_RET
  3816. 19185  CLOSE #1
  3817. 19190  ON ERROR GOTO 0
  3818. 19195  RETURN
  3819. 19200 '
  3820. 19205 *ERR_P9NS
  3821. 19210  IF ERR<>64 THEN *ERR_MESE
  3822. 19215  KILL FIL$(2)
  3823. 19220  RESUME
  3824. 19225 '
  3825. 19230 *BANK_DLOAD
  3826. 19235  ERASE BYM$,BCD,BME$,BIN#,BOUT#
  3827. 19240  DIM BYM$(BNZ),BCD(BNZ),BME$(BNZ),BIN#(BNZ),BOUT#(BNZ)   :'ﾌﾂｳ ﾖｷﾝ
  3828. 19245  F$=FIL$(1)+"bank_"+CHR$(BANKP+&H40)+                                                       RIGHT$("00"+MID$(STR$(PAGE1(BANKP)),2),2)+".dat"
  3829. 19250  ON ERROR GOTO *ERR_P9L
  3830. 19255  OPEN "I",#1,F$
  3831. 19260      INPUT #1,BMAX,BSX,BZAN#
  3832. 19265      FOR A=0 TO BMAX-1
  3833. 19270          INPUT #1,BYM$(A)
  3834. 19275          INPUT #1,BCD(A)
  3835. 19280          INPUT #1,BME$(A)
  3836. 19285          INPUT #1,BIN#(A)
  3837. 19290          INPUT #1,BOUT#(A)
  3838. 19295          IF EOF(1)=-1 THEN *BLOAD_RET
  3839. 19300      NEXT A
  3840. 19305  *BLOAD_RET
  3841. 19310  CLOSE #1
  3842. 19315  ON ERROR GOTO 0
  3843. 19320  BZAN#=0  :GOSUB *SYOKEI_P9
  3844. 19325  CSPB=BMAX-INT((MPYE-100)/18)+1
  3845. 19330  IF CSPB<1 THEN CSPB=1
  3846. 19335  RETURN
  3847. 19340 '
  3848. 19345 *ERR_P9L
  3849. 19350  IF ERR<>63 THEN *ERR_MESE
  3850. 19355  BMAX=0  :BSX=59
  3851. 19360  RESUME *BLOAD_RET
  3852. 19365 '
  3853. 19370 *BANK_SAVE
  3854. 19375  F$=FIL$(1)+"bank_"+CHR$(BANKP+&H40)+                                                       RIGHT$("00"+MID$(STR$(PAGE1(BANKP)),2),2)+".dat"
  3855. 19380  ON ERROR GOTO *ERR_P9S
  3856. 19385  OPEN "O",#1,F$
  3857. 19390       PRINT #1,BMAX,BSX,BZAN#
  3858. 19395       FOR A=0 TO BMAX-1
  3859. 19400           PRINT #1,BYM$(A)
  3860. 19405           PRINT #1,BCD(A)
  3861. 19410           PRINT #1,BME$(A)
  3862. 19415           PRINT #1,BIN#(A)
  3863. 19420           PRINT #1,BOUT#(A)
  3864. 19425       NEXT A
  3865. 19430  *BSAVE_RET
  3866. 19435  CLOSE #1
  3867. 19440  ON ERROR GOTO 0
  3868. 19445  RETURN
  3869. 19450 '
  3870. 19455 *ERR_P9S
  3871. 19460  IF ERR<>64 THEN *ERR_MESE
  3872. 19465  KILL F$
  3873. 19470  RESUME
  3874. 19475 '
  3875. 19480 *BSCR_P9T
  3876. 19485  YL=INT((MUY-MPYL-75)/18)
  3877. 19490  IF YL<0 THEN
  3878. 19495              IF MUY<MPYL+42  THEN *BANK_EXE
  3879. 19500              IF MUY<MPYL+58  THEN *BCOD_EXE
  3880. 19505              GOTO *LINE_EXE9T
  3881. 19510          ENDIF
  3882. 19515  IF PAGE2S<>PAGE2(BANKP) THEN *PAGE2_ERR
  3883. 19520  BTXP=YL+CSPT
  3884. 19525  IF BTXP>TMAX THEN *BMT_INPUT
  3885. 19530  IF BTXP>0    THEN *BMT_EXE
  3886. 19535  WHILE MOUSE(2,0)=-1  :WEND   :MOUSE 5
  3887. 19540  RETURN
  3888. 19545 '
  3889. 19550 *LINE_EXE9T
  3890. 19555  IF MUX<MPXL+(BSX+15)*8-VHL OR MUX>MPXL+(BSX+TBX+15)*8-VHL                      THEN RETURN
  3891. 19560  GOSUB *LINE_EXEP
  3892. 19565  IF CAR_END=1 THEN TBX=VAL(MX$)
  3893. 19570  GOSUB *SCR_BACK
  3894. 19575  RETURN
  3895. 19580 '
  3896. 19585 *BMT_EXE
  3897. 19590  WHILE MOUSE(2,0)=-1  :WEND
  3898. 19595  GOSUB *TCRD_SET  :IF ER=1 THEN ER=0  :GOTO 19690
  3899. 19600  GOSUB *TCRP_SET  :XLP=LEN(MX$)
  3900. 19605  GOSUB *KEY_CR
  3901. 19610                EXE_SW=1
  3902. 19615                GOSUB *INKEY_P
  3903. 19620                EXE_SW=0
  3904. 19625                IF RCLICK>0 THEN GOSUB *KILL_P9T :GOTO 19695
  3905. 19630                IF LCLICK>0 THEN
  3906. 19635                    IF KPS=2 THEN GOSUB *TGET_CORD :                                               IF GET_ON=0 THEN *BSCR_P9T                                                              ELSE INK_END=0  :CAR_END=1
  3907. 19640                    IF KPS>2 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P9T
  3908. 19645                   ENDIF
  3909. 19650  IF INK_END=0 THEN
  3910. 19655                    GOSUB *TMX_SET    :GOSUB *KEY_CR
  3911. 19660                    IF CAR_END=1 THEN  GOSUB *TCRD_NSET
  3912. 19665                    GOSUB *BOLD_BACK
  3913. 19670                    GOTO *BSCR_P9T
  3914. 19675               ELSE
  3915. 19680                    WHILE MOUSE(2,1)=-1   :WEND
  3916. 19685               ENDIF
  3917. 19690  MOUSE 5
  3918. 19695  GOSUB *TEIKI_SAVE   :VHL=VHP  :GOSUB *SCR_BACK
  3919. 19700  RETURN
  3920. 19705 '
  3921. 19710 *BMT_INPUT
  3922. 19715  BTXP=TMAX+1      :IF TMAX>=TYZ THEN GOSUB *FLL_BMT  :GOTO 19830
  3923. 19720  GOSUB *TCRD_SET  :IF ER=1 THEN ER=0  :GOTO 19825
  3924. 19725  TYD$(TMAX)="" :TYN$(TMAX)="" :TYI#(TMAX)=0
  3925. 19730  TYK$(TMAX)="" :TYO#(TMAX)=0
  3926. 19735  MX$=""   :GOSUB *KEY_CR
  3927. 19740  WHILE MOUSE(2,0)=-1  :WEND
  3928. 19745                EXE_SW=1
  3929. 19750                GOSUB *INKEY_P
  3930. 19755                EXE_SW=0
  3931. 19760                IF LCLICK>0 THEN
  3932. 19765                   IF KPS=2 THEN GOSUB *TGET_CORD :                                               IF GET_ON=0 THEN *BSCR_P9T                                                              ELSE INK_END=0  :CAR_END=1
  3933. 19770                   IF KPS>2 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P9T
  3934. 19775                  ENDIF
  3935. 19780  IF INK_END=0 THEN
  3936. 19785                    TMAX=TMAX+1       :BTXP=TMAX
  3937. 19790                    GOSUB *TMX_SET    :GOSUB *KEY_CR
  3938. 19795                    IF CAR_END=1 THEN  GOSUB *TCRD_NSET
  3939. 19800                    GOSUB *BOLD_BACK
  3940. 19805                    GOTO *BSCR_P9T
  3941. 19810               ELSE
  3942. 19815                    WHILE MOUSE(2,1)=-1   :WEND
  3943. 19820               ENDIF
  3944. 19825  MOUSE 5
  3945. 19830  GOSUB *TEIKI_SAVE   :VHL=VHP  :GOSUB *SCR_BACK
  3946. 19835  RETURN
  3947. 19840 '
  3948. 19845 *TCRD_SET
  3949. 19850  A=MPXL+(BSX+6)*8   :P=INT((MUX-A+VHL)/8)
  3950. 19855  IF P<0 OR P>TBX+42 THEN  ER=1  :RETURN
  3951. 19860  IF P>=0  AND P<9          THEN CRXF=A      :CRXE=CRXF+9*8 :                                                CRLEN=10    :KPS=1
  3952. 19865  IF P>=9  AND P<TBX+9      THEN CRXF=A+9*8  :CRXE=CRXF+TBX*8 :                                              CRLEN=TBX+1 :KPS=2
  3953. 19870  IF P>=TBX+9  AND P<TBX+21 THEN CRXF=A+(TBX+9)*8  :CRXE=CRXF+12*8 :                                         CRLEN=13    :KPS=3
  3954. 19875  IF P>=TBX+21 AND P<TBX+30 THEN CRXF=A+(TBX+21)*8 :CRXE=CRXF+9*8  :                                         CRLEN=10    :KPS=4
  3955. 19880  IF P>=TBX+30 AND P<TBX+42 THEN CRXF=A+(TBX+30)*8 :CRXE=CRXF+12*8 :                                         CRLEN=13    :KPS=5
  3956. 19885  CRXF=CRXF+5-VHL   :CRXE=CRXE+5-VHL
  3957. 19890  CRYF=MPYL+75+(BTXP-CSPT)*18  :CRYE=CRYF+18
  3958. 19895  IF CRYF>MPYF-32 THEN  CSPT=CSPT+1  :GOSUB *BD_9P  :GOTO 19890
  3959. 19900  XLP=0  :CAR_END=0 :ER=0
  3960. 19905  RETURN
  3961. 19910 '
  3962. 19915 *TCRP_SET
  3963. 19920  MX$=""
  3964. 19925  IF KPS=1  THEN  MX$=TYD$(BTXP-1)
  3965. 19930  IF KPS=2  THEN  MX$=TYN$(BTXP-1)
  3966. 19935  IF KPS=3  THEN  MX$=STR$(TYI#(BTXP-1))
  3967. 19940  IF KPS=4  THEN  MX$=TYK$(BTXP-1)
  3968. 19945  IF KPS=5  THEN  MX$=STR$(TYO#(BTXP-1))
  3969. 19950  IF MX$="0" OR MX$=" 0" THEN MX$=""
  3970. 19955  RETURN
  3971. 19960 '
  3972. 19965 *TMX_SET
  3973. 19970  IF KPS=1 THEN  TYD$(BTXP-1) =MX$
  3974. 19975  IF KPS=2 THEN  TYN$(BTXP-1) =MX$
  3975. 19980  IF KPS=3 THEN  TYI#(BTXP-1) =VAL(MX$)
  3976. 19985  IF KPS=4 THEN  TYK$(BTXP-1) =MX$
  3977. 19990  IF KPS=5 THEN  TYO#(BTXP-1) =VAL(MX$)
  3978. 19995  RETURN
  3979. 20000 '
  3980. 20005 *TCRD_NSET
  3981. 20010  IF KPS=1 THEN  BLEN=9*8   :MUX=MPXL+BLEN+(BSX+6 )*8+5    :NLEN=TBX
  3982. 20015  IF KPS=2 THEN  BLEN=TBX*8 :MUX=MPXL+BLEN+(BSX+15)*8+5    :NLEN=12
  3983. 20020  IF KPS=3 THEN  BLEN=12*8  :MUX=MPXL+BLEN+(TBX+BSX+15)*8  :NLEN=12
  3984. 20025  IF KPS=4 THEN  BLEN=9*8   :MUX=MPXL+BLEN+(TBX+BSX+27)*8  :NLEN=12
  3985. 20030  IF KPS=5 THEN  MUX=MPXL+(BSX+6)*8+5 :VHL=BSX*8+24 :                                        MUY=CRYF+20  :NLEN=9
  3986. 20035  IF MUX>MPXF-16-NLEN*8+VHL  THEN  VHL=VHL+NLEN*8
  3987. 20040  IF MUX<MPXL+5  THEN  MUX=MPXL+20
  3988. 20045  IF MUY>MPYF-32 THEN  CSPT=CSPT+1  :MUY=MUY-20
  3989. 20050  MUX=MUX-VHL
  3990. 20055  RETURN
  3991. 20060 '
  3992. 20065 *TGET_CORD
  3993. 20070  REF_SW=1      :CRXF_S=CRXF     :CRYF_S=CRYF   :GET_ON=0
  3994. 20075  *TGET_CORD2
  3995. 20080  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :MUX_Q=MUX     :MUY_Q=MUY
  3996. 20085  GOSUB *CORD_P
  3997. 20090  A=NP(NEXP-1)  :GOSUB *SWAP_XY
  3998. 20095  GOSUB *SCR_BACK
  3999. 20100  GOSUB *SET_XYD
  4000. 20105  REW_X=PXE%(8) :REW_Y=PYE%(8)  :JP=9
  4001. 20110  IF GET_ON=1 THEN  MX$=CODN$   :TYI#(BTXP-1)=CODX
  4002. 20115  INK_END=0   :CAR_END=1   :REF_SW=0
  4003. 20120  CRXF=CRXF_S :CRYF=CRYF_S :MUX=MUX_Q :MUY=MUY_Q
  4004. 20125  MOUSE 0 :MOUSE 1,MUX,MUY,1
  4005. 20130  WHILE MOUSE(2,0)=-1      :WEND
  4006. 20135  RETURN
  4007. 20140 '
  4008. 20145 *TEIKI_LOAD
  4009. 20150  ERASE TYD$,TYN$,TYI#,TYK$,TYO#
  4010. 20155  DIM TYD$(TYZ),TYN$(TYZ),TYI#(TYZ),TYK$(TYZ),TYO#(TYZ)   :'ﾃｲｷ ﾖｷﾝ
  4011. 20160  F$=FIL$(1)+"teik_"+CHR$(BANKP+&H40)+                                                       RIGHT$("00"+MID$(STR$(PAGE2(BANKP)),2),2)+".dat"
  4012. 20165  ON ERROR GOTO *ERR_P9TL
  4013. 20170  OPEN "I",#1,F$
  4014. 20175      INPUT #1,TMAX,TBX
  4015. 20180      FOR A=0 TO TMAX-1
  4016. 20185          INPUT #1,TYD$(A)
  4017. 20190          INPUT #1,TYN$(A)
  4018. 20195          INPUT #1,TYI#(A)
  4019. 20200          INPUT #1,TYK$(A)
  4020. 20205          INPUT #1,TYO#(A)
  4021. 20210          IF EOF(1)=-1 THEN *TLOAD_RET
  4022. 20215      NEXT A
  4023. 20220  *TLOAD_RET
  4024. 20225  CLOSE #1
  4025. 20230  ON ERROR GOTO 0
  4026. 20235  GOSUB *TEIKI_ZAN
  4027. 20240  CSPT=TMAX-INT((MPYE-100)/18)+1
  4028. 20245  IF CSPT<1 THEN CSPT=1
  4029. 20250  RETURN
  4030. 20255 '
  4031. 20260 *ERR_P9TL
  4032. 20265  IF ERR<>63 THEN *ERR_MESE
  4033. 20270  TMAX=0  :TBX=14
  4034. 20275  RESUME *TLOAD_RET
  4035. 20280 '
  4036. 20285 *TEIKI_SAVE
  4037. 20290  F$=FIL$(1)+"teik_"+CHR$(BANKP+&H40)+                                                       RIGHT$("00"+MID$(STR$(PAGE2(BANKP)),2),2)+".dat"
  4038. 20295  ON ERROR GOTO *ERR_P9TS
  4039. 20300  OPEN "O",#1,F$
  4040. 20305       PRINT #1,TMAX,TBX
  4041. 20310       FOR A=0 TO TMAX-1
  4042. 20315           PRINT #1,TYD$(A)
  4043. 20320           PRINT #1,TYN$(A)
  4044. 20325           PRINT #1,TYI#(A)
  4045. 20330           PRINT #1,TYK$(A)
  4046. 20335           PRINT #1,TYO#(A)
  4047. 20340       NEXT A
  4048. 20345  *TSAVE_RET
  4049. 20350  CLOSE #1
  4050. 20355  ON ERROR GOTO 0
  4051. 20360  RETURN
  4052. 20365 '
  4053. 20370 *ERR_P9TS
  4054. 20375  IF ERR<>64 THEN *ERR_MESE
  4055. 20380  KILL F$
  4056. 20385  RESUME
  4057. 20390 '
  4058. 20395 *TEIKI_ZAN
  4059. 20400  TZAN1#=0 :TZAN2#=0
  4060. 20405  FOR A=0 TO TMAX-1
  4061. 20410      TZAN1#=TZAN1#+TYI#(A)
  4062. 20415      TZAN2#=TZAN2#+TYO#(A)
  4063. 20420  NEXT A
  4064. 20425  TZAN3#=TZAN1#-TZAN2#
  4065. 20430  RETURN
  4066. 20435 '
  4067. 20440 *KILL_P9T
  4068. 20445  IF BTXP>=TYZ  THEN 20485
  4069. 20450  FOR A=BTXP-1 TO TMAX-2
  4070. 20455      SWAP TYD$(A) ,TYD$(A+1)
  4071. 20460      SWAP TYN$(A) ,TYN$(A+1)
  4072. 20465      SWAP TYI#(A) ,TYI#(A+1)
  4073. 20470      SWAP TYK$(A) ,TYK$(A+1)
  4074. 20475      SWAP TYO#(A) ,TYO#(A+1)
  4075. 20480  NEXT A
  4076. 20485  IF TMAX>0 THEN TMAX=TMAX-1
  4077. 20490  RETURN
  4078. 20495 '
  4079. 20500 *FLL_BMN
  4080. 20505  RESTORE *ERM_D5     :GOSUB *ERMD_SET
  4081. 20510  BNP=PAGE1(BANKP)+1  :IF BNP>10 THEN BNP=0
  4082. 20515  ERM$(3)=ERM$(3)+AKCNV$(STR$(BNP+1))+"ページ目です"
  4083. 20520  GOSUB *MESSAGE_P
  4084. 20525  IF MESJ=1 THEN GOSUB *NEXT_PAGE1
  4085. 20530  RETURN
  4086. 20535 '
  4087. 20540 *NEXT_PAGE1
  4088. 20545  GOSUB *SYOKEI_P9
  4089. 20550  GOSUB *BANK_SAVE
  4090. 20555  PAGE1(BANKP)=BNP  :BYMS$=BYM$(BNZ)
  4091. 20560  GOSUB *BNAME_SAVE
  4092. 20565  ERASE BYM$,BCD,BME$,BIN#,BOUT#
  4093. 20570  DIM BYM$(BNZ),BCD(BNZ),BME$(BNZ),BIN#(BNZ),BOUT#(BNZ)
  4094. 20575  BYM$(0)=BYMS$     :BMAX=1
  4095. 20580  BME$(0)="繰越し"
  4096. 20585  BIN#(0)=BZAN1#
  4097. 20590  RETURN
  4098. 20595  '
  4099. 20600 *FLL_BMT
  4100. 20605  RESTORE *ERM_D5     :GOSUB *ERMD_SET
  4101. 20610  BNP=PAGE2(BANKP)+1  :IF BNP>10 THEN BNP=0
  4102. 20615  ERM$(3)=ERM$(3)+AKCNV$(STR$(BNP+1))+"ページ目です"
  4103. 20620  GOSUB *MESSAGE_P
  4104. 20625  IF MESJ=1 THEN GOSUB *NEXT_PAGE2
  4105. 20630  RETURN
  4106. 20635 '
  4107. 20640 *NEXT_PAGE2
  4108. 20645  GOSUB *TEIKI_SAVE
  4109. 20650  PAGE2(BANKP)=BNP
  4110. 20655  GOSUB *BNAME_SAVE
  4111. 20660  ERASE TYD$,TYN$,TYI#,TYK$,TYO#
  4112. 20665  DIM TYD$(TYZ),TYN$(TYZ),TYI#(TYZ),TYK$(TYZ),TYO#(TYZ)   :'ﾃｲｷ ﾖｷﾝ
  4113. 20670  RETURN
  4114. 20675  '
  4115. 20680 *FLL_BANKN
  4116. 20685  RESTORE *ERM_D7     :GOSUB *ERMD_SET
  4117. 20690  GOSUB *MESSAGE_P
  4118. 20695  RETURN
  4119. 20700 '
  4120. 20705 *ERM_D7
  4121. 20710  DATA 3
  4122. 20715  DATA "登録域が一杯です",0
  4123. 20720  DATA "これ以上銀行名を増やす事は出来ません" ,10
  4124. 20725  DATA "中止を選択してください",10
  4125. 20730 '
  4126. 20735 *ERM_D5
  4127. 20740  DATA 4
  4128. 20745  DATA "ページが一杯です",0
  4129. 20750  DATA "これ以上欄を増やす事は出来ません" ,10
  4130. 20755  DATA "実行でページを更新します",10
  4131. 20760  DATA "次は､",11
  4132. 20765  '
  4133. 20770 *PAGE1_ERR
  4134. 20775  RESTORE *ERM_D6     :GOSUB *ERMD_SET
  4135. 20780  ERM$(2)=ERM$(2)+AKCNV$(MID$(STR$(PAGE1S+1),2))+"ページ目です"
  4136. 20785  GOSUB *MESSAGE_P
  4137. 20790  IF MESJ=1 THEN PAGE1(BANKP)=PAGE1S :GOSUB *BANK_DLOAD :                                    GOSUB *BOLD_P2
  4138. 20795  RETURN
  4139. 20800  '
  4140. 20805 *PAGE2_ERR
  4141. 20810  RESTORE *ERM_D6     :GOSUB *ERMD_SET
  4142. 20815  ERM$(2)=ERM$(2)+AKCNV$(MID$(STR$(PAGE2S+1),2))+"ページ目です"
  4143. 20820  GOSUB *MESSAGE_P
  4144. 20825  IF MESJ=1 THEN PAGE2(BANKP)=PAGE2S :GOSUB *TEIKI_LOAD :                                    GOSUB *BOLD_P2
  4145. 20830  RETURN
  4146. 20835  '
  4147. 20840 *ERM_D6
  4148. 20845  DATA 4
  4149. 20850  DATA "このページのデータを変更することは出来ません",0
  4150. 20855  DATA "登録､変更の出来るのは最終ページだけです",10
  4151. 20860  DATA "現在の最終ページは､",10
  4152. 20865  DATA "実行で最終ページに戻ります",1
  4153. 20870  '
  4154. 20875 '-------------------------------------------------------------------
  4155. 20880 *MESSAGE_P
  4156. 20885  A=10 :GOSUB *SWAP_XY
  4157. 20890  C=0
  4158. 20895  FOR D=0 TO ERMX-1 :B=LEN(ERM$(D)) :IF B>C THEN C=B
  4159. 20900  NEXT D
  4160. 20905  MPXE=C*8+40   :MPYE=ERMX*16+80
  4161. 20910  MPXL=XLS(A)+INT(XES(A)/2)-INT(MPXE/2)
  4162. 20915  MPYL=YLS(A)+20
  4163. 20920  BCL(1)=BCL(18)  :BCL(9)=BCL(19)
  4164. 20925  REW_X=200  :REW_Y=200   :BDP=11     :BPQ=0    :VML=0   :ERMC=1
  4165. 20930  GOSUB *BOLD_P
  4166. 20935  GOSUB *SET_XYD
  4167. 20940  GOSUB *SEL_MXY
  4168. 20945  IF ER=1 THEN 20965
  4169. 20950  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_UP11,*YL_DOWN11,*XL_LEFT11,                       *XL_RIGHT11,  *DRAG_B,*BSCR_MS,*RET_W,*RET_W,*RET_W
  4170. 20955  IF JP<>1 THEN 20940
  4171. 20960  NEXP=NEXP+1
  4172. 20965  A=10 :GOSUB *SWAP_XY
  4173. 20970  GOSUB *SET_XYD       :JP=9
  4174. 20975  IF ERP=0 THEN GOSUB *SCR_BACK
  4175. 20980  RETURN
  4176. 20985  '
  4177. 20990 *BD_11P
  4178. 20995  FILS$="メッセージ"
  4179. 21000  WINDOW (MPXL+VML+1,MPYL+17)-(MPXF+VML-17,MPYF-17)   :                         VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  4180. 21005  XL=MPXL+10  :YL=MPYL+20  :ERML=0
  4181. 21010  FOR A=ERMC TO ERMX
  4182. 21015       SYMBOL(XL,YL+(A-ERMC)*18),ERM$(A-1),1,1,%BCL(ERC(A-1))
  4183. 21020       IF LEN(ERM$(A-1))>ERML THEN ERML=LEN(ERM$(A-1))
  4184. 21025       IF (A-ERMC)*18+YL>MPYF-56 THEN 21035
  4185. 21030  NEXT A
  4186. 21035  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  4187. 21040  LINE(XL-1,MPYF-40)-STEP(50,18),PSET,%BCL(0),BF,%BCL(5)
  4188. 21045  LINE(XL+1,MPYF-39)-STEP(46,16),PSET,%BCL(12),BF,%BCL(3)
  4189. 21050  LINE(MPXF-23,MPYF-40)-STEP(-50,18),PSET,%BCL(0),BF,%BCL(5)
  4190. 21055  LINE(MPXF-25,MPYF-39)-STEP(-46,16),PSET,%BCL(12),BF,%BCL(3)
  4191. 21060  DEF FONT "システム   12ﾄﾞｯﾄ"
  4192. 21065  SYMBOL(XL+8,MPYF-37),"実 行",.9!,.8!,%BCL(0)
  4193. 21070  SYMBOL(MPXF-64,MPYF-37),"中 止",.9!,.8!,%BCL(0)
  4194. 21075  DEF FONT "システム   16ﾄﾞｯﾄ"
  4195. 21080  GOSUB *CASOL_P11   :GOSUB *CASOL_P11B
  4196. 21085  RETURN
  4197. 21090  '
  4198. 21095 *YL_UP11
  4199. 21100  ERMC=ERMC+1
  4200. 21105  IF ERMC>ERMX THEN ERMC=ERMX
  4201. 21110  GOSUB *BD_SUBP
  4202. 21115  RETURN
  4203. 21120 '
  4204. 21125 *YL_DOWN11
  4205. 21130  ERMC=ERMC-1
  4206. 21135  IF ERMC<1 THEN ERMC=1
  4207. 21140  GOSUB *BD_SUBP
  4208. 21145  RETURN
  4209. 21150 '
  4210. 21155 *XL_LEFT11
  4211. 21160  VML=VML+100
  4212. 21165  GOSUB *BD_SUBP
  4213. 21170  RETURN
  4214. 21175 '
  4215. 21180 *XL_RIGHT11
  4216. 21185  VML=VML-100
  4217. 21190  GOSUB *BD_SUBP
  4218. 21195  RETURN
  4219. 21200  '
  4220. 21205 *CASOL_P11
  4221. 21210  A=ERMX :B=ERMC
  4222. 21215  GOSUB *CASOL_PX1
  4223. 21220  RETURN
  4224. 21225 '
  4225. 21230 *CASOL_P11B
  4226. 21235  A=(ERML*8) :B=VML
  4227. 21240  GOSUB *CASOL_PX2
  4228. 21245  RETURN
  4229. 21250 '
  4230. 21255 *BSCR_MS
  4231. 21260  MESJ=0
  4232. 21265  IF MUY>MPYF-40 AND MUY<MPYF-22 THEN
  4233. 21270     IF MUX>MPXL+10 AND MUX<MPXL+60 THEN MESJ=1
  4234. 21275     IF MUX>MPXF-70 AND MUX<MPXF-23 THEN MESJ=0
  4235. 21280     JP=1  :NEXP=NEXP-1
  4236. 21285    ENDIF
  4237. 21290  RETURN
  4238. 21295 '-------------------------------------------------------------------
  4239. 21300 *CLOCK_P
  4240. 21305  IF MPXE<280 OR NEXP=0 THEN RETURN
  4241. 21310  SYMBOL(MPXF-69,MPYL+4),":",.9!,.7!,%BCL(9),,XOR
  4242. 21315  IF TIMX$=LEFT$(TIME$,5) THEN RETURN   ELSE TIMX$=LEFT$(TIME$,5)
  4243. 21320  TIMES$=TIME$
  4244. 21325  TIMS=VAL(LEFT$(TIMES$,2))
  4245. 21330  IF TIMS>12 THEN TIMS=TIMS-12  :TAM$=" pm"    ELSE TAM$=" am"
  4246. 21335  TA$=RIGHT$(" "+MID$(STR$(TIMS),2),2)  :TB$=MID$(TIMES$,4,2)+TAM$
  4247. 21340  LINE  (MPXF-90,MPYL+1)-STEP(70,14),PSET,%BCL(12),BF,%BCL(4)
  4248. 21345  LINE  (MPXF-88,MPYL+2)-STEP(66,12),PSET,%BCL(2),BF,%BCL(6)
  4249. 21350  SYMBOL(MPXF-69,MPYL+4),":",.9!,.7!,%BCL(9),,XOR
  4250. 21355  DEF FONT "システム   12ﾄﾞｯﾄ"
  4251. 21360  SYMBOL(MPXF-85,MPYL+4),TA$,.9!,.7!,%BCL(9)
  4252. 21365  SYMBOL(MPXF-61,MPYL+4),TB$,.9!,.7!,%BCL(9)
  4253. 21370  DEF FONT "システム   16ﾄﾞｯﾄ"
  4254. 21375  RETURN
  4255. 21380  '------------------------------------------------------------------
  4256. 21385 *OPEN_P
  4257. 21390  X1=MXY(A,0) :Y1=MXY(A,1) :X2=MXY(A,2) :Y2=MXY(A,3)
  4258. 21395  *OPEN_P2
  4259. 21400  XA=(MPXL-X1)/5       :YA=(MPYL-Y1)/5
  4260. 21405  XB=(MPXL+MPXE-X2)/5  :YB=(MPYL+MPYE-Y2)/5
  4261. 21410  FOR B=1 TO 2
  4262. 21415     FOR A=0 TO 4
  4263. 21420         LINE (X1+A*XA,Y1+A*YA)-(X2+A*XB,Y2+A*YB),XOR,%BCL(2),B
  4264. 21425         WAIT 2
  4265. 21430     NEXT A
  4266. 21435  NEXT B
  4267. 21440  RETURN
  4268. 21445  '
  4269. 21450 *CLOSE_P
  4270. 21455  GOSUB *SWAP_MD
  4271. 21460  A=BDP-1
  4272. 21465  X1=MXY(A,0) :Y1=MXY(A,1) :X2=MXY(A,2) :Y2=MXY(A,3) 
  4273. 21470  *CLOSE_P2
  4274. 21475  XA=(MPXL-X1)/5       :YA=(MPYL-Y1)/5
  4275. 21480  XB=(MPXL+MPXE-X2)/5  :YB=(MPYL+MPYE-Y2)/5
  4276. 21485  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),CPY%
  4277. 21490  FOR B=1 TO 2
  4278. 21495     FOR A=4 TO 0 STEP -1
  4279. 21500         LINE (X1+A*XA,Y1+A*YA)-(X2+A*XB,Y2+A*YB),XOR,%BCL(2),B
  4280. 21505         WAIT 2
  4281. 21510     NEXT A
  4282. 21515  NEXT B
  4283. 21520  RETURN
  4284. 21525 '-------------------------------------------------------------------
  4285. 21530 *MEMO_P
  4286. 21535  A=NP(NEXP)   :GOSUB *SWAP_XY
  4287. 21540  MPXL=PXL%(3) :MPYL=PYL%(3)  :MPXE=PXE%(3)  :MPYE=PYE%(3)
  4288. 21545  A=3          :GOSUB *OPEN_P
  4289. 21550 *MEMO_P2
  4290. 21555  BDP=4  :BPQ=0  :WKST=1  :REF_SW=0  :MVX=0  :MEM_EXS=0
  4291. 21560  GOSUB *SEL_WAKP
  4292. 21565  IF JPQ=1 THEN GOTO *NEX_P
  4293. 21570  RETURN
  4294. 21575 '
  4295. 21580 *MEMO_LOAD
  4296. 21585  ERASE MEMO$
  4297. 21590  DIM   MEMO$(MSX)
  4298. 21595  F$=FIL$(11)+RIGHT$("00"+MID$(STR$(MOX),2),3)+".dat"
  4299. 21600  ON ERROR GOTO *ERR_P4L
  4300. 21605  OPEN "I",#1,F$
  4301. 21610      MOZ=0
  4302. 21615      WHILE EOF(1)<>-1
  4303. 21620          LINE INPUT #1,MEMO$(MOZ)
  4304. 21625          MOZ=MOZ+1  :IF MOZ>MSX THEN *MLOAD_RET
  4305. 21630      WEND
  4306. 21635  *MLOAD_RET
  4307. 21640  CLOSE #1
  4308. 21645  ON ERROR GOTO 0
  4309. 21650  CSP4=1
  4310. 21655  RETURN
  4311. 21660 '
  4312. 21665 *ERR_P4L
  4313. 21670  IF ERR<>63 THEN *ERR_MESE
  4314. 21675  MOZ=0
  4315. 21680  RESUME *MLOAD_RET
  4316. 21685 '
  4317. 21690 *MEMO_SAVE
  4318. 21695  F$=FIL$(11)+RIGHT$("00"+MID$(STR$(MOX),2),3)+".dat"
  4319. 21700  ON ERROR GOTO *ERR_P4S
  4320. 21705  OPEN "O",#1,F$
  4321. 21710       GOSUB *SET_MOZ
  4322. 21715       FOR A=0 TO MOZ-1
  4323. 21720           B$=MEMO$(A)
  4324. 21725           GOSUB *DELETE_SP
  4325. 21730           PRINT #1,B$
  4326. 21735       NEXT A
  4327. 21740  *MSAVE_RET
  4328. 21745  CLOSE #1
  4329. 21750  ON ERROR GOTO 0
  4330. 21755  RETURN
  4331. 21760 '
  4332. 21765 *ERR_P4S
  4333. 21770  IF ERR<>64 THEN *ERR_MESE
  4334. 21775  KILL F$
  4335. 21780  RESUME
  4336. 21785 '
  4337. 21790 *BD_4P
  4338. 21795  FILS$="[メモ帳]"  :GOSUB *CASOL_P4B
  4339. 21800  WINDOW (MPXL+MVX+1,MPYL+17)-(MPXF+MVX-17,MPYF-17)
  4340. 21805  VIEW   (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  4341. 21810  GOSUB *BD4_LINE
  4342. 21815  IF MOZ=0 THEN WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479) :RETURN
  4343. 21820  XL=MPXL+5  :YL=MPYL+18
  4344. 21825  FOR A=CSP4 TO MOZ
  4345. 21830      SYMBOL(XL,YL),MEMO$(A-1),1,1,%BCL(0)
  4346. 21835      YL=YL+18
  4347. 21840      IF YL>MPYF-50 THEN 21850
  4348. 21845  NEXT A
  4349. 21850  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  4350. 21855  GOSUB *CASOL_P4
  4351. 21860  RETURN
  4352. 21865 '
  4353. 21870 *BD4_LINE
  4354. 21875  XL=MPXL+5  :YL=MPYL+34  :L=INT((MPYE-50)/18)
  4355. 21880  FOR A=1 TO L
  4356. 21885      LINE (XL,YL+(A-1)*18)-STEP(640,0),PSET,%BCL(0)
  4357. 21890  NEXT A
  4358. 21895  LINE(MPXL+1,MPYF-35)-STEP(640,18),XOR,%BCL(3),BF
  4359. 21900  A$="[頁"+RIGHT$("0"+MID$(STR$(MOX),2),2)+"]"
  4360. 21905  SYMBOL(MPXL+5,MPYF-33),A$,1,1,%BCL(0)
  4361. 21910  RETURN
  4362. 21915 '
  4363. 21920 *YL_DOWN4
  4364. 21925  CSP4=CSP4+1
  4365. 21930  IF CSP4>MOZ THEN CSP4=MOZ
  4366. 21935  MOUSE 1,,,0 :GOSUB *BD_4P :MOUSE 1,,,1
  4367. 21940  RETURN
  4368. 21945 '
  4369. 21950 *YL_UP4
  4370. 21955  CSP4=CSP4-1
  4371. 21960  IF CSP4<1 THEN CSP4=1
  4372. 21965  MOUSE 1,,,0 :GOSUB *BD_4P :MOUSE 1,,,1
  4373. 21970  RETURN
  4374. 21975 '
  4375. 21980 *XL_LEFT4
  4376. 21985  MVX=MVX-100
  4377. 21990  GOSUB *BD_SUBP
  4378. 21995  RETURN
  4379. 22000 '
  4380. 22005 *XL_RIGHT4
  4381. 22010  MVX=MVX+100
  4382. 22015  GOSUB *BD_SUBP
  4383. 22020  RETURN
  4384. 22025 '
  4385. 22030 *CASOL_P4
  4386. 22035  A=MOZ :B=CSP4
  4387. 22040  GOSUB *CASOL_PX1
  4388. 22045  RETURN
  4389. 22050 '
  4390. 22055 *CASOL_P4B
  4391. 22060  A=640  :B=MVX
  4392. 22065  GOSUB *CASOL_PX2
  4393. 22070  RETURN
  4394. 22075 '
  4395. 22080 *CSL_S4
  4396. 22085  IF MOZ=0 THEN GOSUB *RET_W :RETURN
  4397. 22090  A=MOZ
  4398. 22095  GOSUB *ｶｰｿﾙ_SET1
  4399. 22100  CSP4=P
  4400. 22105  GOSUB *BD_SUBP
  4401. 22110  RETURN
  4402. 22115 '
  4403. 22120 *BSCR_P4
  4404. 22125  IF MUY>MPYF-36 AND MUY<MPYF-16 THEN
  4405. 22130                     IF MUX>MPXL+37*8+5-MVX AND MUX<MPXL+44*8+5-MVX                                 THEN GOSUB *PAGE_CLS
  4406. 22135                     IF MUX>MPXL+5-MVX AND MUX<MPXL+6*8+5-MVX                                       THEN GOSUB *PAGE_UP
  4407. 22140                     GOSUB *RET_W
  4408. 22145                     RETURN
  4409. 22150                 ENDIF
  4410. 22155  YL=INT((MPYE-50)/18)
  4411. 22160  YP=INT((MUY-MPYL-16)/18)
  4412. 22165  IF YP+CSP4>=MSX THEN  GOSUB *RET_W  :RETURN
  4413. 22170  GOSUB *MEMO_IN
  4414. 22175  RETURN
  4415. 22180 '
  4416. 22185 *MEMO_IN
  4417. 22190  WINDOW (MPXL+MVX+1,MPYL+17)-(MPXF+MVX-17,MPYF-17)
  4418. 22195  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  4419. 22200  TABX=80
  4420. 22205  GOSUB *MEMO_EXE
  4421. 22210  XLP=INT((MUX-MPXL-5+MVX)/8)
  4422. 22215  GOSUB *INKEY_P2
  4423. 22220  WINDOW (0,0)-(639,479)       :VIEW (0,0)-(639,479)
  4424. 22225  RETURN
  4425. 22230 '
  4426. 22235 *INKEY_P2
  4427. 22240  GOSUB *EDIT_CAR  :DRAG_SW=0
  4428. 22245  INK_END=0  :LCLICK=0  :RCLICK=0  :TW=0  :WAIX=10
  4429. 22250  WHILE MOUSE(2,0)=0
  4430. 22255        B$=""
  4431. 22260        A$=INKEY$+INKEY$
  4432. 22265        IF A$<>"" THEN B$=B$+A$   :GOTO 22260
  4433. 22270        IF B$<>"" THEN INKEY_P=1  :GOSUB *CAR_PUT2
  4434. 22275        IF MOUSE(2,1)=-1 THEN
  4435. 22280              MUX=MOUSE(4,1)  :MUY=MOUSE(5,1)
  4436. 22285              GOSUB *BD_B4P
  4437. 22290              IF INKEY_P=1 THEN GOSUB *MEMO_SAVE :INKEY_P=0
  4438. 22295              RETURN
  4439. 22300          ENDIF
  4440. 22305        IF (TIME MOD 2)=TW THEN GOSUB *CR_POINT2 :                                                          IF TW=0 THEN TW=1   ELSE TW=0
  4441. 22310  WEND
  4442. 22315  MUX=MOUSE(4,0)  :MUY=MOUSE(5,0)  :MUZ=MOUSE(9)  :MUW=MOUSE(10)
  4443. 22320  XU=XLP  :YU=YP  :DRAG_SW=0       :RCLICK=MOUSE(3,1)
  4444. 22325  WHILE MOUSE(2,0)=-1
  4445. 22330        MUZ=MOUSE(9)  :MUW=MOUSE(10)
  4446. 22335        IF MUZ+MUW<>0 THEN GOSUB *DRAG_LINE
  4447. 22340  WEND
  4448. 22345  'IF YU<YP THEN DRAG_SW=0
  4449. 22350  IF XU-XLP+YU-YP<>0  THEN GOSUB *LINE_SEL :GOTO *INKEY_P2
  4450. 22355  WAIT WAIX       :LCLICK=MOUSE(3,0)  :RCLICK=MOUSE(3,1)
  4451. 22360  IF MUX>MPXL AND MUX<MPXF-16 AND MUY>MPYL+16 AND MUY<MPYF-32 THEN
  4452. 22365         GOSUB *KEY_CR2
  4453. 22370         XLP=INT((MUX-MPXL-5+MVX)/8)  :MEMO$(YP+CSP4-1)=MX$
  4454. 22375         YLP=INT((MUY-MPYL-16)/18)    :IF YLP+CSP4>MSX THEN *INKEY_P2
  4455. 22380         IF XLP<0 THEN XLP=0
  4456. 22385         YP=YLP
  4457. 22390         GOSUB *MEMO_EXE  :GOSUB *EDIT_CAR
  4458. 22395         IF LCLICK>0 OR RCLICK>0 THEN  RETURN    ELSE  *INKEY_P2
  4459. 22400    ENDIF
  4460. 22405  IF MUX>MPXL AND MUX<MPXF-16 AND MUY>MPYF-34 AND MUY<MPYF-18 THEN
  4461. 22410     X=MPXL-MVX+10
  4462. 22415     IF MUX>26*8+X AND MUX<32*8+X THEN GOSUB *PAST_P
  4463. 22420     IF MUX>36*8+X AND MUX<42*8+X THEN GOSUB *PAGE_CLS
  4464. 22425     IF MUX>X-4 AND MUX<6*8+X THEN
  4465. 22430          MUSF$=""
  4466. 22435          GOSUB *TEXT_REF
  4467. 22440       ENDIF
  4468. 22445     GOSUB *MOVE_MEMO2
  4469. 22450     GOTO  *INKEY_P2
  4470. 22455  ENDIF
  4471. 22460  GOSUB *BD_B4P
  4472. 22465  IF INKEY_P=1 THEN GOSUB *MEMO_SAVE :INKEY_P=0
  4473. 22470  RETURN
  4474. 22475 '  
  4475. 22480 *BD_B4P
  4476. 22485  MOUSE 1,,,0
  4477. 22490  GOSUB *BD_4P
  4478. 22495  MOUSE 1,,,1
  4479. 22500  RETURN
  4480. 22505 '
  4481. 22510 *CAR_PUT2
  4482. 22515  IF LEN(B$)>1 THEN IF LEN(B$) MOD 2 THEN                                        IF ASC(RIGHT$(B$,1))<32 THEN B$=LEFT$(B$,LEN(B$)-1)
  4483. 22520  IF JIS(B$)>31  AND  JIS(B$)<>&H7F THEN
  4484. 22525         MEM_EXS=1
  4485. 22530         IF TABX>XLP  THEN
  4486. 22535                          A$=LEFT$(MX$,XLP)+B$+MID$(MX$,XLP+1)
  4487. 22540                          XLP=XLP+LEN(B$)
  4488. 22545                      ELSE
  4489. 22550                          A$=MX$+B$
  4490. 22555                          XLP=LEN(A$)
  4491. 22560                      ENDIF
  4492. 22565         P=YP+CSP4-1  :Q=0
  4493. 22570         IF XLP>TABX THEN
  4494. 22575                          GOSUB *RSIFT_LINE   :MX$=MEMO$(P)
  4495. 22580                          GOSUB *KEY_CR2      :YP=YP+1
  4496. 22585                          MX$=MEMO$(P+1)
  4497. 22590                          XLP=XLP-TABX+Z
  4498. 22595                     ELSE
  4499. 22600                          MX$=A$
  4500. 22605                          MEMO$(P)=MX$
  4501. 22610                     ENDIF
  4502. 22615         IF P+1>MOZ    THEN MOZ=P+1
  4503. 22620         IF YP-CSP4>YL THEN
  4504. 22625                           CSP4=CSP4+1  :YP=YP-1  :YLS=YL
  4505. 22630                           GOSUB *MOVE_MEMO2
  4506. 22635                           YL=YLS
  4507. 22640                      ELSE
  4508. 22645                           GOSUB *KEY_CR2
  4509. 22650                      ENDIF
  4510. 22655     ENDIF
  4511. 22660  IF B$<>"" THEN E=JIS(B$)    ELSE  RETURN
  4512. 22665  IF (E<32 AND E>0) OR E=&H7F THEN *SUBKEY2 
  4513. 22670  RETURN
  4514. 22675  '
  4515. 22680 *SUBKEY2
  4516. 22685  IF E=&H7F THEN A=KLEN(MID$(MX$,XLP+1,2))  :XLP=XLP+3-A :E=8
  4517. 22690  IF E=13   THEN GOSUB *LINE_END
  4518. 22695  IF E=8    THEN
  4519. 22700                 IF XLP<1 THEN GOSUB *LSIFT_LINE   ELSE GOSUB *BAKSP
  4520. 22705                 MEMO$(YP+CSP4-1)=MX$  :MEM_EXS=1
  4521. 22710            ENDIF
  4522. 22715  IF E=29 AND XLP>=0 THEN
  4523. 22720                        IF XLP=0 THEN XLP=-1 :GOTO 22735
  4524. 22725                        GOSUB *BAKSP_SUB
  4525. 22730                        XLP=XLP-F
  4526. 22735                        IF XLP<0 THEN
  4527. 22740                                      XLP=TABX
  4528. 22745                                      MEMO$(YP+CSP4-1)=MX$ :YP=YP-1
  4529. 22750                                      IF YP<0 THEN IF CSP4>1                                                         THEN CSP4=CSP4-1 :YP=0
  4530. 22755                                      MVX=200
  4531. 22760                                      MX$=MEMO$(YP+CSP4-1)
  4532. 22765                                      GOSUB *MOVE_MEMO2
  4533. 22770                                 ENDIF
  4534. 22775                    ENDIF
  4535. 22780  IF E=28 AND XLP<TABX+1 THEN
  4536. 22785                        GOSUB *BAKSP_SUB
  4537. 22790                        XLP=XLP+F
  4538. 22795                        IF XLP>TABX THEN
  4539. 22800                                         XLP=0
  4540. 22805                                         MEMO$(YP+CSP4-1)=MX$
  4541. 22810                                         IF (YP+5)*18<MPYE THEN
  4542. 22815                                                 YP=YP+1
  4543. 22820                                             ELSE
  4544. 22825                                                 IF CSP4+YP<MSX                                                                 THEN CSP4=CSP4+1
  4545. 22830                                             ENDIF
  4546. 22835                                         MVX=0
  4547. 22840                                         MX$=MEMO$(YP+CSP4-1)
  4548. 22845                                         GOSUB *MOVE_MEMO2
  4549. 22850                                     ENDIF
  4550. 22855                    ENDIF
  4551. 22860  IF E=30 AND YP+CSP4>1   THEN
  4552. 22865                              MEMO$(YP+CSP4-1)=MX$
  4553. 22870                              IF YP>0 THEN
  4554. 22875                                          YP=YP-1
  4555. 22880                                      ELSE
  4556. 22885                                          IF CSP4>1 THEN CSP4=CSP4-1
  4557. 22890                                      ENDIF
  4558. 22895                              GOSUB *MEMO_EXE
  4559. 22900                              GOSUB *MOVE_MEMO2
  4560. 22905                          ENDIF
  4561. 22910  IF E=31 AND YP+CSP4<MSX THEN
  4562. 22915                              MEMO$(YP+CSP4-1)=MX$
  4563. 22920                              IF (YP+5)*18<MPYE THEN
  4564. 22925                                          YP=YP+1
  4565. 22930                                                ELSE
  4566. 22935                                          IF CSP4<MSX THEN CSP4=CSP4+1
  4567. 22940                                                ENDIF
  4568. 22945                              GOSUB *MEMO_EXE
  4569. 22950                              GOSUB *MOVE_MEMO2
  4570. 22955                              IF MOZ<YP+CSP4 THEN MOZ=YP+CSP4
  4571. 22960                          ENDIF
  4572. 22965  GOSUB *KEY_CR2
  4573. 22970  RETURN
  4574. 22975  '
  4575. 22980 *KEY_CR2
  4576. 22985  LINE (MPXL,MPYL+(YP+1)*18-1)-STEP(650,16),PSET,%BCL(2),BF
  4577. 22990  SYMBOL(MPXL+5,MPYL+(YP+1)*18),MX$,1,1,%BCL(0)
  4578. 22995  GOSUB *EDIT_CAR
  4579. 23000  RETURN
  4580. 23005 '
  4581. 23010 *EDIT_CAR
  4582. 23015  X=MPXL   :Y=MPYF-33
  4583. 23020  LINE(MPXL+1,MPYF-35)-STEP(640,18),PSET,%6,BF
  4584. 23025  SYMBOL(8+X,Y) ,"[検索]",1,1,%14
  4585. 23030  IF DRAG_SW=1 THEN CL=14   ELSE CL=6
  4586. 23035  SYMBOL(11*8+X,Y),"[ｶｯﾄ]",1,1,%CL
  4587. 23040  SYMBOL(18*8+X,Y),"[ｺﾋﾟｰ]",1,1,%CL
  4588. 23045  IF PAST_SW>0 THEN CL=14   ELSE CL=6
  4589. 23050  SYMBOL(26*8+X,Y),"[ﾍﾟｰｽﾄ]",1,1,%CL
  4590. 23055  SYMBOL(37*8+X,Y),"[頁ｸﾘｱ]",1,1,%14
  4591. 23060  SYMBOL(60*8+X,Y),"e."+MID$(STR$(MOZ),2    ),1,1,%BCL(0)
  4592. 23065  SYMBOL(66*8+X,Y),"y."+MID$(STR$(YP+CSP4),2),1,1,%BCL(0)
  4593. 23070  SYMBOL(72*8+X,Y),"x."+MID$(STR$(XLP+1),2  ),1,1,%BCL(0)
  4594. 23075  RETURN
  4595. 23080 '
  4596. 23085 *CR_POINT2
  4597. 23090  LINE (MPXL+XLP*8+4,MPYL+(YP+1)*18)-STEP(0,14),XOR,%BCL(7)
  4598. 23095  IF MPXL+XLP*8+5>MPXF+MVX-24 THEN MVX=MVX+16 :MVX_SET=1 :GOTO 23095
  4599. 23100  IF MPXL+XLP*8+5<MPXL+MVX    THEN MVX=MVX-16 :MVX_SET=1 :GOTO 23095
  4600. 23105  IF MVX_SET=1 THEN MVX_SET=0 :GOSUB *MOVE_MEMO
  4601. 23110  RETURN
  4602. 23115 '
  4603. 23120 *MEMO_EXE
  4604. 23125  MX$=MEMO$(YP+CSP4-1) :A=LEN(MX$)
  4605. 23130  IF A<TABX THEN MX$=MX$+SPACE$(TABX-A)
  4606. 23135  RETURN
  4607. 23140 '
  4608. 23145 *MOVE_MEMO
  4609. 23150  MEMO$(YP+CSP4-1)=MX$
  4610. 23155  *MOVE_MEMO2
  4611. 23160  GOSUB *BD_B4P
  4612. 23165  WINDOW (MPXL+MVX+1,MPYL+17)-(MPXF+MVX-17,MPYF-17)
  4613. 23170  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  4614. 23175  RETURN
  4615. 23180 '
  4616. 23185 *LINE_END
  4617. 23190  P=YP+CSP4
  4618. 23195  MEMO$(P-1)=LEFT$(MX$,XLP)
  4619. 23200  IF P<MSX-1 THEN
  4620. 23205               GOSUB *SIFT_MEMO
  4621. 23210               MEMO$(P)=MID$(MX$,XLP+1)
  4622. 23215               GOSUB *MEMO_EXE
  4623. 23220               E=31  :XLP=0  :MVX=0  :MOZ=MOZ+1
  4624. 23225               IF MOZ>MSX THEN MOZ=MSX
  4625. 23230  ENDIF
  4626. 23235  RETURN
  4627. 23240 '
  4628. 23245 *SIFT_MEMO
  4629. 23250  FOR A=MSX-1 TO P STEP-1
  4630. 23255     MEMO$(A+1)=MEMO$(A)
  4631. 23260  NEXT A
  4632. 23265  RETURN
  4633. 23270 '
  4634. 23275 *LSIFT_LINE
  4635. 23280  P=YP+CSP4-2
  4636. 23285  IF P<1 THEN RETURN
  4637. 23290  B$=MEMO$(P)
  4638. 23295  GOSUB *DELETE_SP   :MX$=B$
  4639. 23300  A=LEN(MX$)
  4640. 23305  IF A>=TABX THEN RETURN
  4641. 23310  C=TABX-A  :C$=MX$  :XLP=A
  4642. 23315  B$=MEMO$(P+1)
  4643. 23320  GOSUB *DELETE_SP   :MX$=B$
  4644. 23325  IF MID$(MX$,C+1)=""  THEN  K=1  :A$=MEMO$(P+2)   ELSE K=0  :A$=""
  4645. 23330  A=KLEN(LEFT$(MX$,C)) :B$=KLEFT$(LEFT$(MX$,C+1),A)
  4646. 23335  IF LEN(B$)>C THEN C=C-1
  4647. 23340  MEMO$(P+1)=MID$(MX$,C+1)+A$
  4648. 23345  MX$=C$+LEFT$(MX$,C)  :MEMO$(P)=MX$
  4649. 23350  MX$=MEMO$(P+1)
  4650. 23355  IF K=1 THEN GOSUB *KILL_LINE
  4651. 23360  E=30
  4652. 23365  RETURN
  4653. 23370 '
  4654. 23375 *KILL_LINE
  4655. 23380  FOR A=P+1 TO MOZ-1
  4656. 23385      SWAP MEMO$(A),MEMO$(A+1)
  4657. 23390  NEXT A
  4658. 23395  MOZ=MOZ-1
  4659. 23400  RETURN
  4660. 23405 '
  4661. 23410 *DRAG_LINE
  4662. 23415  DRAG_SW=1
  4663. 23420  GOSUB *LINE_GET
  4664. 23425  XU=INT((MOUSE(0)-MPXL-5+MVX)/8)  :YU=INT((MOUSE(1)-MPYL-16)/18)
  4665. 23430  IF YU*18>MPYE-64 THEN
  4666. 23435                       IF CSP4<MSX THEN CSP4=CSP4+1 :YP=YP-1
  4667. 23440                       GOSUB *MOVE_MEMO2
  4668. 23445                  ENDIF
  4669. 23450  IF YU*18<18     THEN
  4670. 23455                       IF CSP4>1 THEN CSP4=CSP4-1 :YP=YP+1
  4671. 23460                       GOSUB *MOVE_MEMO2
  4672. 23465                  ENDIF
  4673. 23470  GOSUB *LINE_GET
  4674. 23475  RETURN
  4675. 23480 '
  4676. 23485 *LINE_GET
  4677. 23490  CL=5
  4678. 23495  IF YP=YU THEN LINE (MPXL+XLP*8+4,MPYL+YP*18+16)                                                 -STEP((XU-XLP)*8,18),XOR,%BCL(CL),BF
  4679. 23500  IF YP<YU THEN LINE (MPXL+XLP*8+4,MPYL+YP*18+16)                                                 -STEP((TABX-XLP)*8,18),XOR,%BCL(CL),BF
  4680. 23505  IF YP<YU THEN LINE (MPXL+4,MPYL+YU*18+16)                                                        -STEP(XU*8,18),XOR,%BCL(CL),BF
  4681. 23510  A=YU-YP
  4682. 23515  WHILE A>1
  4683. 23520    LINE (MPXL+4,MPYL+(YP+A-1)*18+16)-STEP(TABX*8,18),XOR,%BCL(CL),BF
  4684. 23525    A=A-1
  4685. 23530  WEND
  4686. 23535  RETURN
  4687. 23540 '
  4688. 23545 *LINE_SEL
  4689. 23550  PAST_SW=0  :GOSUB *EDIT_CAR  :DRAG_SW=0
  4690. 23555  WHILE MOUSE(2,0)=0
  4691. 23560        IF MOUSE(2,1)=-1 THEN GOSUB *MOVE_MEMO2 :RETURN
  4692. 23565  WEND
  4693. 23570  MUX=MOUSE(4,0)  :MUY=MOUSE(5,0)
  4694. 23575  IF MUY>MPYF-34 AND MUY<MPYF-18 THEN
  4695. 23580     X=MPXL+10-MVX
  4696. 23585     IF MUX>10*8+X AND MUX<16*8+X THEN GOSUB *DEL_LINE  :GOTO 23640
  4697. 23590     IF MUX>18*8+X AND MUX<24*8+X THEN GOSUB *COPY_LINE :GOTO 23640
  4698. 23595     IF MUX>X-4 AND MUX< 6*8+X THEN
  4699. 23600           WHILE MOUSE(2,0)=-1  :WEND   :MOUSE 5  :MUSF$=""
  4700. 23605           IF XU-XLP>0 THEN
  4701. 23610                           MUSF$=LEFT$(MID$(MX$,XLP+1,XU-XLP),25)
  4702. 23615                           TEXT_REFSW=1
  4703. 23620                       ENDIF
  4704. 23625           GOSUB *TEXT_REF
  4705. 23630       ENDIF
  4706. 23635     ENDIF
  4707. 23640  GOSUB *MOVE_MEMO2
  4708. 23645  WHILE MOUSE(2,0)=-1  :WEND
  4709. 23650  RETURN
  4710. 23655 '
  4711. 23660 *DEL_LINE
  4712. 23665  A=YU-YP
  4713. 23670  IF A<0 OR (A=0 AND XU<XLP) THEN RETURN
  4714. 23675  IF A>80 THEN A=80 :YU=YP+80
  4715. 23680  PAST_SW=A+1  :MEM_EXS=1  :INKEY_P=1
  4716. 23685  IF A=0 THEN
  4717. 23690              IF XU<XLP THEN SWAP XU,XLP
  4718. 23695              MEMO$(YP+CSP4-1)=LEFT$(MX$,XLP)+MID$(MX$,XU+1)
  4719. 23700              PAST$(0)=MID$(MX$,XLP+1,XU-XLP)
  4720. 23705         ENDIF
  4721. 23710  IF A>0 THEN
  4722. 23715              MEMO$(YP+CSP4-1)=LEFT$(MX$,XLP)
  4723. 23720              PAST$(0)=MID$(MX$,XLP+1)        :MX$=MEMO$(YP+CSP4-1)
  4724. 23725              IF XU>0 THEN PAST$(A)=LEFT$(MEMO$(YU+CSP4-1),XU)
  4725. 23730              MEMO$(YU+CSP4-1)=MID$(MEMO$(YU+CSP4-1),XU+1)
  4726. 23735  ENDIF
  4727. 23740  B=A-1
  4728. 23745  WHILE B>0
  4729. 23750        P=YP+CSP4+B-1  :A=LEN(MEMO$(P))
  4730. 23755        IF A<TABX THEN MEMO$(P)=MEMO$(P)+SPACE$(TABX-A)
  4731. 23760        PAST$(B)=MEMO$(P) :MEMO$(P)=""
  4732. 23765        P=P-1 :GOSUB *KILL_LINE
  4733. 23770        B=B-1
  4734. 23775  WEND
  4735. 23780  IF YU-YP>0 THEN
  4736. 23785                  A$=MX$+MEMO$(YP+CSP4)
  4737. 23790                  IF LEN(A$)=<TABX THEN
  4738. 23795                         MEMO$(YP+CSP4-1)=A$
  4739. 23800                         P=YP+CSP4-1 :GOSUB *KILL_LINE
  4740. 23805                     ELSE
  4741. 23810                         MEMO$(YP+CSP4-1)=LEFT$(A$,TABX)
  4742. 23815                         MEMO$(YP+CSP4  )=MID$(A$,TABX+1)
  4743. 23820                     ENDIF
  4744. 23825             ENDIF
  4745. 23830  GOSUB *MEMO_EXE
  4746. 23835  RETURN
  4747. 23840 '
  4748. 23845 *COPY_LINE
  4749. 23850  A=YU-YP      :IF A>80 THEN A=80
  4750. 23855  PAST_SW=A+1
  4751. 23860  IF A=0 THEN PAST$(0)=MID$(MX$,XLP+1,XU-XLP)
  4752. 23865  IF A>0 THEN PAST$(0)=MID$(MX$,XLP+1)
  4753. 23870  IF A>0 THEN PAST$(A)=LEFT$(MEMO$(YU+CSP4-1),XU)
  4754. 23875  B=A-1
  4755. 23880  WHILE B>0
  4756. 23885        P=YP+CSP4+B-1  :A$=MEMO$(P)  :A=LEN(A$)
  4757. 23890        IF A<TABX THEN  A$=A$+SPACE$(TABX-A)
  4758. 23895        PAST$(B)=A$
  4759. 23900        B=B-1
  4760. 23905  WEND
  4761. 23910  RETURN
  4762. 23915 '
  4763. 23920 *PAST_P
  4764. 23925  IF PAST_SW=0 THEN RETURN
  4765. 23930  Q=0  :P=YP+CSP4-1  :XLP_S=XLP  :MEM_EXS=1  :INKEY_P=1
  4766. 23935  IF PAST_SW=1 THEN
  4767. 23940                   A$=LEFT$(MX$,XLP)+PAST$(Q)  :B$=MID$(MX$,XLP+1)
  4768. 23945                   GOSUB *DELETE_SP            :A$=A$+B$
  4769. 23950                   IF LEN(A$)=<TABX THEN
  4770. 23955                        MEMO$(P)=LEFT$(A$+SPACE$(TABX),TABX)
  4771. 23960                        XLP=XLP+LEN(PAST$(Q))
  4772. 23965                     ELSE
  4773. 23970                        GOSUB *RSIFT_LINE
  4774. 23975                        XLP=XLP+LEN(PAST$(Q))
  4775. 23980                        IF XLP>TABX THEN XLP=XLP-TABX :YP=YP+1 :P=P+1
  4776. 23985                     ENDIF
  4777. 23990                   MX$=MEMO$(P)
  4778. 23995               ELSE
  4779. 24000                   B$=MID$(MX$,XLP+1)
  4780. 24005                   IF Q<PAST_SW THEN
  4781. 24010                      A$=LEFT$(MX$,XLP)+PAST$(Q)
  4782. 24015                      IF LEN(A$)>=TABX THEN
  4783. 24020                          GOSUB *RSIFT_LINE
  4784. 24025                          MX$=KMID$(A$,C+1)
  4785. 24030                          XLP=LEN(MX$)+1  :P=P+1   :Q=Q+1
  4786. 24035                          GOTO 24005
  4787. 24040                      ELSE
  4788. 24045                          MX$=A$  :XLP=LEN(A$)+1 :Q=Q+1
  4789. 24050                          GOTO 24005
  4790. 24055                      ENDIF
  4791. 24060                   ENDIF
  4792. 24065                   XLP=LEN(MX$)     :YP=P-CSP4+1
  4793. 24070                   MEMO$(P)=MX$+B$  :MX$=MEMO$(P)
  4794. 24075               ENDIF
  4795. 24080  MOZ=MOZ+PAST_SW    :IF MOZ<MSX THEN MOZ=MOZ+1
  4796. 24085  RETURN
  4797. 24090 '
  4798. 24095 *DELETE_SP
  4799. 24100  C=LEN(B$)  :IF C=0 THEN B$="" :RETURN
  4800. 24105  FOR B=C TO 1 STEP -1
  4801. 24110      IF MID$(B$,B,1)>" " THEN B$=LEFT$(B$,B) :RETURN
  4802. 24115  NEXT B
  4803. 24120  B$=""
  4804. 24125  RETURN
  4805. 24130 '
  4806. 24135 *RSIFT_LINE
  4807. 24140  C=KLEN(LEFT$(A$,TABX))  :Z=0
  4808. 24145  MEMO$(P)=KLEFT$(A$,C)
  4809. 24150  IF LEN(KRIGHT$(MEMO$(P),1))>1 THEN C=C-1 :Z=1 :MEMO$(P)=KLEFT$(A$,C)
  4810. 24155  IF P<MSX-1 THEN
  4811. 24160               GOSUB *SIFT_MEMO
  4812. 24165               IF Q=0 THEN MEMO$(P+1)=KMID$(A$,C+1)
  4813. 24170          ENDIF
  4814. 24175  RETURN
  4815. 24180 '
  4816. 24185 *PAGE_UP
  4817. 24190  IF INKEY_P=1 THEN GOSUB *MEMO_SAVE :INKEY_P=0
  4818. 24195  A=MOUSE(3,1)
  4819. 24200  WHILE MOUSE(2,0)=-1
  4820. 24205        IF MOUSE(2,1)=-1 THEN GOSUB *PAGE_DOWN
  4821. 24210  WEND
  4822. 24215  IF MOUSE(3,1)>0 THEN RETURN
  4823. 24220  MOX=MOX+1
  4824. 24225  IF MOX>MEMO_X THEN MOX=1
  4825. 24230  GOSUB *MEMO_LOAD
  4826. 24235  GOSUB *BD_B4P
  4827. 24240  RETURN
  4828. 24245 '
  4829. 24250 *PAGE_DOWN
  4830. 24255  MOX=MOX-1
  4831. 24260  IF MOX<1 THEN MOX=MEMO_X
  4832. 24265  GOSUB *MEMO_LOAD
  4833. 24270  GOSUB *BD_B4P
  4834. 24275  WHILE MOUSE(2,1)=-1   :WEND
  4835. 24280  RETURN
  4836. 24285 '
  4837. 24290 *SET_MOZ
  4838. 24295  FOR MOZ=MSX-1 TO 0 STEP-1
  4839. 24300      B$=MEMO$(MOZ)
  4840. 24305      GOSUB *DELETE_SP
  4841. 24310      IF B$<>"" THEN MOZ=MOZ+1  :MX$=B$  :RETURN
  4842. 24315  NEXT MOZ
  4843. 24320  MX$=B$
  4844. 24325  RETURN
  4845. 24330 '
  4846. 24335 *PAGE_CLS
  4847. 24340  P=YP+CSP4-1   :INKEY_P=1
  4848. 24345  MEMO$(P)=LEFT$(MX$,XLP)
  4849. 24350  FOR A=P+1 TO MOZ  :MEMO$(A)=""  :NEXT A  :MOZ=P+1
  4850. 24355  GOSUB *MEMO_EXE
  4851. 24360  GOSUB *MOVE_MEMO2
  4852. 24365  WHILE MOUSE(2,1)=-1   :WEND
  4853. 24370  RETURN
  4854. 24375 '-------------------------------------------------------------------
  4855. 24380 *TEXT_REF
  4856. 24385  WINDOW(0,0)-(639,479) :VIEW(0,0)-(639,479)
  4857. 24390  TYRP=YP+CSP4-1  :YPS=YP  :YLSP=YL
  4858. 24395  TXRP=XLP
  4859. 24400  MS1$="検索名称を入力してください"
  4860. 24405  MS2$=""
  4861. 24410  A=10     :GOSUB *SWAP_XY
  4862. 24415  MUX1=0   :MUY1=0   :MUX2=639 :MUY2=479 :MU_INK=1
  4863. 24420  MPXL=180 :MPYL=200 :MPXE=300 :MPYE=100
  4864. 24425  MUIM_XL=46  :MUIM_YL=38  :MUIK_L=25
  4865. 24430  MS3$="上方" :MS5$="下方" :MS4$="取消"
  4866. 24435  GOSUB *マウス選択
  4867. 24440  MU_INK=0  :MOUSX=0
  4868. 24445  IF MUJP=0 OR MUSF$="" THEN 24480
  4869. 24450  IF TEXT_REFSW=1 AND MUJP=2 THEN TXRP=XU
  4870. 24455  IF MUJP=2 THEN TRC=TXRP+1         ELSE TRC=TXRP
  4871. 24460  YP=YPS    :YL=YLSP  :REF$=MUSF$  :TRFX=0  :ER=0
  4872. 24465  ON MUJP GOSUB *TEXT_UREF,*TEXT_DREF
  4873. 24470  IF ER=0 THEN GOSUB *TEXT_REF_ZERO
  4874. 24475  MOUSE 0  :MOUSE 1,MUX,MUY,1
  4875. 24480  TEXT_REFSW=0
  4876. 24485  RETURN
  4877. 24490 '
  4878. 24495 *TEXT_DREF
  4879. 24500  FOR TRN=TYRP TO MOZ-1
  4880. 24505      B=TRC
  4881. 24510      TREFP=INSTR(B,MEMO$(TRN),REF$)
  4882. 24515      IF TREFP>0 THEN
  4883. 24520                     GOSUB *TREF_MESEGI
  4884. 24525                     IF MUJP=0 THEN ER=1 :GOTO 24555
  4885. 24530                     TRC=TREFP+1
  4886. 24535                     GOTO 24505
  4887. 24540                 ENDIF
  4888. 24545      TRC=1
  4889. 24550  NEXT TRN
  4890. 24555  RETURN
  4891. 24560  '
  4892. 24565 *TEXT_UREF
  4893. 24570  DIM TRFP%(255)
  4894. 24575  FOR TRN=TYRP TO 0  STEP -1
  4895. 24580      TRQ=0  :B=1
  4896. 24585      D=INSTR(B,MEMO$(TRN),REF$)
  4897. 24590      IF D>0 THEN TRFP%(TRQ)=D  :TRQ=TRQ+1  :B=D+1  :GOTO 24585
  4898. 24595      IF TRQ>0 THEN
  4899. 24600            FOR TRW=TRQ-1 TO 0 STEP -1
  4900. 24605                TREFP=TRFP%(TRW)
  4901. 24610                IF TREFP<TRC THEN
  4902. 24615                                 GOSUB *TREF_MESEGI
  4903. 24620                                 IF MUJP=0 THEN ER=1 :GOTO 24650
  4904. 24625                             ENDIF
  4905. 24630            NEXT TRW
  4906. 24635        ENDIF
  4907. 24640      TRC=256
  4908. 24645  NEXT TRN
  4909. 24650  ERASE TRFP%
  4910. 24655  RETURN
  4911. 24660  '
  4912. 24665 *TREF_MESEGI
  4913. 24670  TRFX=TRFX+1
  4914. 24675  IF CSP4>TRN THEN CSP4=TRN-1 :IF CSP4<1 THEN CSP4=1
  4915. 24680  IF CSP4+INT((MPYF-MPYL-80)/18)=<TRN THEN
  4916. 24685        CSP4=TRN-1
  4917. 24690    ENDIF
  4918. 24695  XA=INT((MVX+1)/8)
  4919. 24700  XB=INT((MPXF-MPXL-18)/8)
  4920. 24705  IF TREFP+LEN(REF$)>XA+XB THEN MVX=(TREFP-XA-XB+(XB-LEN(REF$))/4)*8
  4921. 24710  IF TREFP=<XA THEN IF TREFP-XB<1 THEN MVX=0  ELSE MVX=(TREFP-XB)*8
  4922. 24715  GOSUB *BD_4P
  4923. 24720  Y=MPYL+((TRN-CSP4+1)*18)+17     :YP=TRN-CSP4+1
  4924. 24725  X=MPXL+(TREFP-1)*8-MVX+2        :XLP=TREFP-1
  4925. 24730  GOSUB *MEMO_EXE
  4926. 24735  LINE (X,Y)-STEP(LEN(REF$)*8+2,16),XOR,%BCL(5),BF
  4927. 24740  MS2$="["+REF$+"]"   :MS1$="発見しました"
  4928. 24745  MS3$="続行"         :MS4$="中止"   :MS5$=""
  4929. 24750  A=10
  4930. 24755  GOSUB *SWAP_XY      :MPXE=250  :MPYE=85  :GOSUB *マウス選択
  4931. 24760  MOUSX=0
  4932. 24765  RETURN
  4933. 24770  '
  4934. 24775 *TEXT_REF_ZERO
  4935. 24780  MS2$="["+REF$+"]" :MS1$="見つかりません"
  4936. 24785  MS3$=""           :MS4$="確認"   :MS5$=""
  4937. 24790  A=10
  4938. 24795  GOSUB *SWAP_XY    :MPXE=250  :MPYE=85  :GOSUB *マウス選択
  4939. 24800  MOUSX=0
  4940. 24805  RETURN
  4941. 24810 '-------------------------------------------------------------------
  4942. 24815 *マウス選択
  4943. 24820  GOSUB *BOLD_PM
  4944. 24825  MUSEL=0 :MUJP=0
  4945. 24830  GOSUB *マウスX
  4946. 24835  ON MOUSX GOSUB *RET,*RET,*ﾄﾞﾗｯｸﾞ
  4947. 24840  IF (MOUSX=1 OR MOUSX=7)=0 THEN 24830
  4948. 24845  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),U%
  4949. 24850  A=10 :GOSUB *SWAP_XY
  4950. 24855  RETURN
  4951. 24860 '
  4952. 24865 *ﾄﾞﾗｯｸﾞ
  4953. 24870  MPXL_SAV=MPXL :MPYL_SAV=MPYL
  4954. 24875  GOSUB *ﾄﾞﾗｯｸﾞB
  4955. 24880  SWAP MPXL,MPXL_SAV :SWAP MPYL,MPYL_SAV
  4956. 24885  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),U%
  4957. 24890  SWAP MPXL,MPXL_SAV :SWAP MPYL,MPYL_SAV
  4958. 24895  GOSUB *BOLD_PM
  4959. 24900  RETURN
  4960. 24905 '
  4961. 24910 *マウスX
  4962. 24915  MOUSE 0
  4963. 24920  MOUSE 4,MUX1,MUY1,MUX2,MUY2
  4964. 24925  MOUSE 1,MUX,MUY,1
  4965. 24930 *マウスX2
  4966. 24935  MOUSX=0 
  4967. 24940  WHILE MOUSE(2,0)=0
  4968. 24945       MUSI$=""
  4969. 24950       A$=INKEY$+INKEY$  :IF A$<>""  THEN MUSI$=MUSI$+A$ :GOTO 24950
  4970. 24955       IF MUSI$<>"" AND MU_INK>0  THEN
  4971. 24960                                       GOSUB *MOUS_INKEY
  4972. 24965                                       IF MOUSX=1 THEN 25055
  4973. 24970                                  ENDIF
  4974. 24975       IF MOUSE(2,1)=-1 THEN *MOUSE_SUB
  4975. 24980  WEND
  4976. 24985  MUX=MOUSE(4,0) :MUY=MOUSE(5,0)
  4977. 24990  IF MUX>MPXL AND MUX<MPXF AND MUY>MPYL AND MUY<MPYF THEN
  4978. 24995     GOSUB  *SUB_INPUT
  4979. 25000     IF MUJP<3 THEN
  4980. 25005                   MOUSX=1
  4981. 25010                   WHILE MOUSE(2,0)=-1   :WEND
  4982. 25015                   RETURN
  4983. 25020               ELSE
  4984. 25025                   MOUSX=3
  4985. 25030                   RETURN
  4986. 25035               ENDIF
  4987. 25040     ENDIF
  4988. 25045  MOUSX=7 :MUJP=0
  4989. 25050  WHILE MOUSE(2,0)=-1   :WEND
  4990. 25055  MUXE=MOUSE(0) :MUYE=MOUSE(1) :MUZ=MOUSE(3,0)
  4991. 25060  MOUSE 5
  4992. 25065  RETURN
  4993. 25070 '
  4994. 25075 *MOUSE_SUB
  4995. 25080  WHILE MOUSE(2,1)=-1   :WEND
  4996. 25085  MUX=MOUSE(0) :MUY=MOUSE(1)
  4997. 25090  PUT@A (MPXL,MPYL)-(MPXF+2,MPYF+2),U%
  4998. 25095  WHILE MOUSE(2,1)=0   :WEND
  4999. 25100  GOSUB *BOLD_PM
  5000. 25105  WHILE MOUSE(2,1)=-1  :WEND
  5001. 25110  MUX=MOUSE(0) :MUY=MOUSE(1)
  5002. 25115  GOTO *マウスX2
  5003. 25120 '
  5004. 25125 *SUB_INPUT
  5005. 25130  IF MUX>MPXL+20 AND MUX<MPXL+60 AND  MUY>MPYF-35 AND MUY<MPYF-15                AND  MS3$<>""                  THEN  MUJP=1 :RETURN
  5006. 25135  IF MUX>MPXF-60 AND MUX<MPXF-20 AND  MUY>MPYF-35 AND MUY<MPYF-15                AND  MS4$<>""                  THEN  MUJP=0 :RETURN
  5007. 25140  IF MS5$<>"" THEN
  5008. 25145     IF MUX>(MPXL+(MPXF-MPXL)\2-20) AND MUX<(MPXL+(MPXF-MPXL)\2+20) AND             MUY>MPYF-35 AND MUY<MPYF-15 THEN  MUJP=2 :RETURN
  5009. 25150  ENDIF
  5010. 25155  MUJP=3
  5011. 25160  RETURN
  5012. 25165 '--------------------------------------------------------------------
  5013. 25170 *MOUS_INKEY
  5014. 25175  IF MU_INK=1 THEN XMP=254
  5015. 25180  E=JIS(MUSI$)
  5016. 25185  IF E<32 AND E>0 OR E=127 THEN
  5017. 25190        LINE (MUIK_XL+(XP-1)*8+2,MUIK_YL+1)-STEP(8,14),XOR,%BCL(9),BF
  5018. 25195        GOTO *SUBKEY_M
  5019. 25200    ENDIF
  5020. 25205  IF LEN(MUSI$) MOD 2 THEN                                                       IF ASC(RIGHT$(MUSI$,1))<32 THEN MUSI$=LEFT$(MUSI$,LEN(MUSI$)-1)
  5021. 25210  IF MU_INK>1 THEN MID$(MUSF$,XP,LEN(MUSI$))=MUSI$
  5022. 25215  IF MU_INK=1 THEN
  5023. 25220                   IF XP=1 THEN
  5024. 25225                                MUSF$=MUSF$+MUSI$
  5025. 25230                           ELSE
  5026. 25235                                A$=LEFT$(MUSF$,XP-1)+MUSI$  :B$=""
  5027. 25240                                IF XP=<LEN(MUSF$) THEN
  5028. 25245                                       B$=MID$(MUSF$,XP)
  5029. 25250                                   ENDIF
  5030. 25255                                MUSF$=A$+B$
  5031. 25260                           ENDIF
  5032. 25265              ENDIF
  5033. 25270  GOSUB *MU_INK_PUT
  5034. 25275  XP=XP+LEN(MUSI$)
  5035. 25280  IF XMP=12 AND (XP=5 OR XP=9) THEN XP=XP+2
  5036. 25285  IF XMP=14 AND  XP=5          THEN XP=XP+6
  5037. 25290  IF XP>XMP THEN XP=XMP
  5038. 25295  LINE (MUIK_XL+(XP-1)*8+2,MUIK_YL+1)-STEP(8,14),XOR,%BCL(9),BF
  5039. 25300  RETURN
  5040. 25305 '
  5041. 25310 *SUBKEY_M
  5042. 25315  IF E=13  THEN ER=1 :MUJP=1 :MOUSX=1
  5043. 25320  IF E=8   THEN IF MU_INK=1 THEN *BAKSP_M
  5044. 25325  IF E=127 AND MU_INK=1 AND LEN(MUSF$)>=XP                                             THEN A=KLEN(MID$(MUSF$,XP,2))  :XP=XP+3-A   :GOTO *BAKSP_M
  5045. 25330  IF E=24  THEN
  5046. 25335               IF MU_INK>1 THEN
  5047. 25340                      ER=2 :MUJP=1 :MOUSX=1
  5048. 25345                  ELSE
  5049. 25350                      MUJP=0  :MOUSX=1
  5050. 25355                  ENDIF
  5051. 25360           ENDIF
  5052. 25365  IF E=28 OR E=29 THEN
  5053. 25370       IF E=28 THEN
  5054. 25375                    IF MU_INK=1 AND XP>LEN(MUSF$) THEN 25295
  5055. 25380                    XP=XP+1  :GOTO 25280
  5056. 25385               ENDIF
  5057. 25390       IF E=29 THEN
  5058. 25395                   XP=XP-1  :IF XP=0 THEN XP=1
  5059. 25400                   IF MU_INK>1 THEN
  5060. 25405                         IF XMP=12 AND (XP=6 OR XP=10) THEN XP=XP-2
  5061. 25410                         IF XMP=14 AND  XP=10          THEN XP=XP-6
  5062. 25415                   ENDIF
  5063. 25420               ENDIF
  5064. 25425    ENDIF
  5065. 25430  GOTO 25295
  5066. 25435 '
  5067. 25440 *BAKSP_M
  5068. 25445  IF XP=1 THEN 25480
  5069. 25450  GOSUB *BAKSP_SUB_M
  5070. 25455  IF XP-F>0 THEN A$=LEFT$(MUSF$,XP-F-1)     ELSE A$=""
  5071. 25460  IF XP=<LEN(MUSF$) THEN B$=MID$(MUSF$,XP)  ELSE B$=""
  5072. 25465  MUSF$=A$+B$
  5073. 25470  XP=XP-F
  5074. 25475  IF XP<1 THEN XP=1
  5075. 25480  GOSUB *MU_INK_PUT
  5076. 25485  LINE (MUIK_XL+(XP-1)*8+2,MUIK_YL+1)-STEP(8,14),XOR,%BCL(9),BF
  5077. 25490  RETURN
  5078. 25495 '
  5079. 25500 *BAKSP_SUB_M
  5080. 25505  IF XP>2 THEN
  5081. 25510              A=KLEN(MID$(MUSF$,XP-2,2))
  5082. 25515              IF A=1 THEN F=2    ELSE F=1
  5083. 25520          ELSE
  5084. 25525              F=1
  5085. 25530          ENDIF
  5086. 25535  RETURN
  5087. 25540 '
  5088. 25545 *MU_INK_PUT
  5089. 25550  MUIK_XL=MPXL+MUIM_XL :MUIK_YL=MPYL+MUIM_YL
  5090. 25555  LINE (MUIK_XL,MUIK_YL-1)-                                                         (MUIK_XL+MUIK_L*8+4,MUIK_YL+17),PSET,%BCL(0),BF,%BCL(3)
  5091. 25560  SYMBOL(MUIK_XL+2,MUIK_YL),MUSF$,1,1,%BCL(0)
  5092. 25565  RETURN
  5093. 25570 '--------------------------------------------------------------------
  5094. 25575 *BOLD_PM
  5095. 25580  A=16
  5096. 25585  MPXF=MPXL+MPXE :MPYF=MPYL+MPYE
  5097. 25590  GET@A (MPXL,MPYL)-(MPXF+2,MPYF+2),U%
  5098. 25595 *BOLD_PM2
  5099. 25600  LINE (MPXL,MPYL)-(MPXF+2,MPYF+2),PSET,%BCL(4),BF
  5100. 25605  X=16  :Y=16
  5101. 25610  LINE (MPXL,MPYL)-(MPXF,MPYF),PSET,%BCL(0),BF,%BCL(1)
  5102. 25615  LINE (MPXL+3,MPYL+3)-(MPXF-3,MPYF-3),PSET,%BCL(0),BF,%BCL(2)
  5103. 25620  IF MU_INK>0 THEN GOSUB *MU_INK_PUT :XP=1 :                                        LINE (MUIK_XL+(XP-1)*8+2,MUIK_YL+1)-STEP(8,14),XOR,%BCL(2),BF
  5104. 25625  IF MS3$<>"" THEN                                                                  LINE (MPXL+20,MPYF-35)-STEP(40,20),PSET,%BCL(0),BF,%BCL(13)
  5105. 25630  IF MS4$<>"" THEN                                                                  LINE (MPXF-60,MPYF-35)-STEP(40,20),PSET,%BCL(0),BF,%BCL(13)
  5106. 25635  IF MS5$<>"" THEN LINE (MPXL+(MPXF-MPXL)\2-20,MPYF-35)-                                            STEP(40,20),PSET,%BCL(0),BF,%BCL(13)
  5107. 25640  X=INT((INT(MPXE/8)-LEN(MS1$))/2)-1 :IF X<1 THEN X=0
  5108. 25645  SYMBOL(MPXL+10,MPYL+10),SPACE$(X)+MS1$,1,1,%BCL(0)
  5109. 25650  X=INT((INT(MPXE/8)-LEN(MS2$))/2)-1 :IF X<1 THEN X=0
  5110. 25655  SYMBOL(MPXL+10,MPYL+30),SPACE$(X)+MS2$,1,1,%BCL(0)
  5111. 25660  SYMBOL(MPXL+25,MPYF-33),MS3$,1,1,%BCL(0)
  5112. 25665  SYMBOL(MPXF-55,MPYF-33),MS4$,1,1,%BCL(0)
  5113. 25670  SYMBOL(MPXL+(MPXF-MPXL)\2-15,MPYF-33),MS5$,1,1,%BCL(0)
  5114. 25675  RETURN
  5115. 25680 '-------------------------------------------------------------------
  5116. 25685 *GRAH_P
  5117. 25690  A=NP(NEXP)   :GOSUB *SWAP_XY
  5118. 25695  MPXL=PXL%(2) :MPYL=PYL%(2)  :MPXE=PXE%(2)  :MPYE=PYE%(2)
  5119. 25700  A=2          :GOSUB *OPEN_P
  5120. 25705 *GRAH_P2
  5121. 25710  BDP=3  :BPQ=0  :WKST=1  :REF_SW=0
  5122. 25715  GOSUB *SEL_WAKP
  5123. 25720  IF JPQ=1 THEN GOTO *NEX_P
  5124. 25725  RETURN
  5125. 25730  '
  5126. 25735 *BD_3P
  5127. 25740  FILS$="[グラフ]"
  5128. 25745  GOSUB *GRAP_PUT
  5129. 25750  WINDOW (MPXL+GVX+1,MPYL+GVY+17)-(MPXF+GVX-17,MPYF+GVY-17)
  5130. 25755  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  5131. 25760  LINE(MPXL+GVX+1,MPYF+GVY-35)-STEP(640,18),PSET,%BCL(4),BF
  5132. 25765  IF GRAP_SW=0 THEN CL1=0  :CL2=3  ELSE CL1=3  :CL2=0
  5133. 25770  SYMBOL(MPXL+10 ,MPYF+GVY-33),"[年間]",1,1,%BCL(CL1)
  5134. 25775  SYMBOL(MPXL+100,MPYF+GVY-33),"[月間]",1,1,%BCL(CL2)
  5135. 25780  IF GRAP_CSW=0 THEN
  5136. 25785                     CL1=0  :CL2=3  :CL3=3
  5137. 25790                ELSE
  5138. 25795                     CL1=3  :CL2=0
  5139. 25800                     IF GZS=1 THEN CL3=3   ELSE CL3=0
  5140. 25805                ENDIF
  5141. 25810  SYMBOL(MPXL+190,MPYF+GVY-33),"[描画]",1,1,%BCL(CL1)
  5142. 25815  SYMBOL(MPXL+280,MPYF+GVY-33),"[縮小]",1,1,%BCL(CL2)
  5143. 25820  SYMBOL(MPXL+370,MPYF+GVY-33),"[拡大]",1,1,%BCL(CL3)
  5144. 25825  IF S_GRF=0 THEN CL1=3   ELSE CL1=0
  5145. 25830  SYMBOL(MPXL+460,MPYF+GVY-33),"[積算]",1,1,%BCL(CL1)
  5146. 25835  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  5147. 25840  GOSUB *CASOL_P3  :GOSUB *CASOL_P3B
  5148. 25845  RETURN
  5149. 25850 '
  5150. 25855 *YL_DOWN3
  5151. 25860  GVY=GVY+240
  5152. 25865  GOSUB *BD_SUBP
  5153. 25870  RETURN
  5154. 25875 '
  5155. 25880 *YL_UP3
  5156. 25885  GVY=GVY-240
  5157. 25890  GOSUB *BD_SUBP
  5158. 25895  RETURN
  5159. 25900 '
  5160. 25905 *XL_LEFT3
  5161. 25910  GVX=GVX-320
  5162. 25915  GOSUB *BD_SUBP
  5163. 25920  RETURN
  5164. 25925 '
  5165. 25930 *XL_RIGHT3
  5166. 25935  GVX=GVX+320
  5167. 25940  GOSUB *BD_SUBP
  5168. 25945  RETURN
  5169. 25950 '
  5170. 25955 *CSL_S3
  5171. 25960  A=480
  5172. 25965  GOSUB *ｶｰｿﾙ_SET1  :IF SGN(GVY)<0 THEN P=480-P
  5173. 25970  GVY=INT(GVY/480)*480+P
  5174. 25975  GOSUB *BD_SUBP
  5175. 25980  RETURN
  5176. 25985  '
  5177. 25990 *CSL_D3
  5178. 25995  A=640
  5179. 26000  GOSUB *ｶｰｿﾙ_SET2  :IF SGN(GVX)<0 THEN P=640-P
  5180. 26005  GVX=INT(GVX/640)*640+P
  5181. 26010  GOSUB *BD_SUBP
  5182. 26015  RETURN
  5183. 26020  '
  5184. 26025 *CASOL_P3
  5185. 26030  A=480  :B=GVY
  5186. 26035  GOSUB *CASOL_PX3
  5187. 26040  RETURN
  5188. 26045 '
  5189. 26050 *CASOL_P3B
  5190. 26055  A=640  :B=GVX
  5191. 26060  GOSUB *CASOL_PX2
  5192. 26065  RETURN
  5193. 26070 '
  5194. 26075 *CASOL_PX3
  5195. 26080  YL=16
  5196. 26085  IF B=0 THEN Y=MPYL+16                                                              ELSE Y=MPYL+(ABS(B) MOD A)*((MPYE-96)/480)+16
  5197. 26090  IF Y>MPYF-64 THEN Y=MPYF-64
  5198. 26095  LINE (MPXF,MPYL+16)-STEP(-16,MPYE-64),PSET,%BCL(0),BF,%BCL(5)
  5199. 26100  LINE (MPXF,Y)-STEP(-16,YL+16),PSET,%BCL(0),BF,%BCL(17)
  5200. 26105  CONNECT(MPXF-16,Y+YL+16)-STEP(2,-2)-STEP(12,0)-STEP(0,-YL-12)-                     STEP(2,-2)-STEP(0,YL+16)-STEP(-16,0),%BCL(0),PSET,F,%BCL(0)
  5201. 26110  RETURN
  5202. 26115 '
  5203. 26120 *BSCR_P3
  5204. 26125  IF MUY>MPYF-36 AND MUY<MPYF-16 THEN
  5205. 26130                     MOUSE 1,,,0
  5206. 26135                     IF MUX>MPXL+10-GVX AND MUX<MPXL+60-GVX                                         THEN GRAP_SW=0  :PDF=0  :PDE=365 :GRAP_CSW=0
  5207. 26140                     IF MUX>MPXL+100-GVX AND MUX<MPXL+150-GVX                                       THEN GOSUB *GET_DEI  :RETURN
  5208. 26145                     IF MUX>MPXL+190-GVX AND MUX<MPXL+240-GVX                                       THEN GOSUB *GRAP_CALK
  5209. 26150                     IF MUX>MPXL+280-GVX AND MUX<MPXL+330-GVX                                       THEN A=.5!  :GOSUB *GRAP_ZOOM
  5210. 26155                     IF MUX>MPXL+370-GVX AND MUX<MPXL+420-GVX                                       THEN A=-.5! :GOSUB *GRAP_ZOOM
  5211. 26160                     IF MUX>MPXL+460-GVX AND MUX<MPXL+510-GVX                                       THEN IF S_GRF=1 THEN S_GRF=0  ELSE S_GRF=1
  5212. 26165                     GOSUB *BD_3P
  5213. 26170                     GOSUB *RET_W
  5214. 26175                     RETURN
  5215. 26180                 ENDIF
  5216. 26185  IF GRAP_CSW=0 THEN RETURN
  5217. 26190  XQ=(MPXE+(GX2-GX1))/(MPXE-18)  :YQ=(MPYE+(GY2-GY1))/(MPYE-34)
  5218. 26195  XP=INT((MUX-MPXL+GVX/XQ-1-239/XQ)/(250/XQ))
  5219. 26200  XL=INT((MUX-MPXL+GVX/XQ-1-259/XQ)/(250/XQ))
  5220. 26205  YR=INT((MUY-MPYL+GVY/YQ-17-43/YQ)/(18/YQ))
  5221. 26210  IF YR<0 THEN 26270
  5222. 26215  IF YR>9 THEN GC=1 :YP=INT((MUY-MPYL+GVY/YQ-17-263/YQ)/(18/YQ))                             ELSE GC=0 :YP=YR
  5223. 26220  GTP=YP+XP*10
  5224. 26225  IF GTP>=0 AND GTP<GZP%(GC) THEN
  5225. 26230     IF XL=XP THEN
  5226. 26235                   MOUSE 1,,,0
  5227. 26240                   ORE_GRF=1  :GOSUB *GRAP_PUT  :ORE_GRF=0
  5228. 26245                   GOSUB *KMG_PUT  :RETURN
  5229. 26250              ELSE
  5230. 26255                   GOSUB *KMG_COL  :RETURN
  5231. 26260              ENDIF
  5232. 26265     ENDIF
  5233. 26270  WHILE MOUSE(2,0)=-1   :WEND
  5234. 26275  RETURN
  5235. 26280 '
  5236. 26285 *GET_DEI
  5237. 26290  GRAP_SW=1  :REF_SW=2  :GRAP_CSW=0  :PDXS=PDX
  5238. 26295  GOSUB *CALENDER
  5239. 26300  GOSUB *SCR_BACK
  5240. 26305  GOSUB *SET_XYD
  5241. 26310  D=GXD  :M=GXM  :GOSUB *PDX_SET  :PDF=PDX
  5242. 26315  D=GZD  :M=GZM  :GOSUB *PDX_SET  :PDE=PDX
  5243. 26320  IF PDF>PDE THEN   SWAP PDF,PDE  :SWAP GXM,GZM   :SWAP GXD,GZD
  5244. 26325  REW_X=PXE%(2) :REW_Y=PYE%(2)
  5245. 26330  BDP=3  :JP=9  :PDX=PDXS  :REF_SW=0  :WKST=1
  5246. 26335  RETURN
  5247. 26340 '
  5248. 26345 *GRAP_CALK
  5249. 26350  IF KOZ<1   THEN RETURN
  5250. 26355  IF PDE<PDF THEN SWAP PDE,PDF
  5251. 26360  GRAP_CSW=1
  5252. 26365  ERASE GKX#,GKT#,GRPZ#   :DIM GKX#(365,50),GKT#(5),GRPZ#(KOZ,1)
  5253. 26370  FOR A=PDF TO PDE
  5254. 26375      B=KMAX(A)   :D=0
  5255. 26380      WHILE B>D
  5256. 26385            C=KMI%(A,D)
  5257. 26390            IF KMT%(C)=0 THEN K#=KIN&(A,D)*KSU%(A,D) ELSE K#=KIN&(A,D)
  5258. 26395            GKX#(A,C)=GKX#(A,C)+K#
  5259. 26400            GKT#(KMT%(C))=GKT#(KMT%(C))+K#
  5260. 26405            D=D+1
  5261. 26410      WEND
  5262. 26415  NEXT A
  5263. 26420  GOSUB *MAX_CALK  :GOSUB *SWAP_GRPZ
  5264. 26425  RETURN
  5265. 26430 '
  5266. 26435 *GRAP_ZOOM
  5267. 26440  GZS=GZS+A
  5268. 26445  IF GZS<1 THEN GZS=1
  5269. 26450  GX2=(MPXE-18)*(GZS-1)/2-17
  5270. 26455  GY2=(MPYE-34)*(GZS-1)/2-17
  5271. 26460  SX=1/GZS  :SY=1/GZS
  5272. 26465  RETURN
  5273. 26470 '
  5274. 26475 *GRAP_PUT
  5275. 26480  IF GRAP_CSW=0 THEN RETURN
  5276. 26485  GVXS=GVX  :GVYS=GVY
  5277. 26490  IF ORE_GRF=1 AND GVY>-50 THEN GVX=0 :GVY=-370
  5278. 26495  WINDOW (MPXL+GVX+GX1,MPYL+GVY+GY1)-(MPXF+GVX+GX2,MPYF+GVY+GY2)
  5279. 26500  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  5280. 26505  GOSUB *EN_GRAP
  5281. 26510  GOSUB *BO_GRAP
  5282. 26515  IF ORE_GRF=1 THEN
  5283. 26520                    GOSUB *ORE_GRAP
  5284. 26525                    GVX=GVXS :GVY=GVYS
  5285. 26530               ELSE
  5286. 26535                    IF S_GRF=1 THEN GOSUB *SEN_GRAP
  5287. 26540               ENDIF
  5288. 26545  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  5289. 26550  RETURN
  5290. 26555 '
  5291. 26560 *GK_CALK
  5292. 26565  FOR B=PDF TO PDE
  5293. 26570      GKZ#=GKZ#+GKX#(B,A)
  5294. 26575  NEXT B
  5295. 26580  RETURN
  5296. 26585 '
  5297. 26590 *EN_GRAP
  5298. 26595  IF GRAP_SW=1 THEN
  5299. 26600     A$=MID$(STR$(GXY),2)+"-"+MID$(STR$(GXM),2)+"-"+MID$(STR$(GXD),2)
  5300. 26605     SYMBOL(MPXL+60,MPYL+20),A$+"～",SX,SY,%BCL(0)
  5301. 26610     A$=MID$(STR$(GZY),2)+"-"+MID$(STR$(GZM),2)+"-"+MID$(STR$(GZD),2)
  5302. 26615     SYMBOL(MPXL+140,MPYL+20),A$,SX,SY,%BCL(0)
  5303. 26620   ELSE
  5304. 26625     IF KFXP>0 THEN SYMBOL(MPXL+80,MPYL+20),FSI$(KFXP-1),SX,SY,%BCL(0)
  5305. 26630   ENDIF
  5306. 26635  GKW#=GKT#(0)+GKT#(2)+GKT#(4)  :GKQ#=GKT#(1)+GKT#(3)+GKT#(5)
  5307. 26640  IF GKW#+GKQ#=0 THEN RETURN
  5308. 26645  G=GKW#/(GKW#+GKQ#)+.75!       :IF G>1 THEN G=G-1
  5309. 26650  CIRCLE(MPXL+120,MPYL+140),100,%BCL(15),,.75!,G,F,PSET
  5310. 26655  CIRCLE(MPXL+120,MPYL+140),100,%BCL(16),,G,.75!,F,PSET
  5311. 26660  RESTORE *KT_DAT
  5312. 26665  FOR C=1 TO 0 STEP -1
  5313. 26670      X=MPXL+120  :Y=MPYL+220*C+140  :R=80+C*10
  5314. 26675      GKW#=GKT#(C)+GKT#(C+2)+GKT#(C+4)
  5315. 26680      A$=STR$(GKW#)  :GOSUB *CONMA_P
  5316. 26685      SYMBOL(X+120,Y-100),"total \"+A$,SX,SY,%BCL(0)
  5317. 26690      READ A$
  5318. 26695      SYMBOL(X+80,Y-100),A$,SX,SY,%BCL(0)
  5319. 26700      CIRCLE(X,MPYL+140),R,%BCL(2),,,,F,PSET
  5320. 26705      IF GKW#=0 THEN 26795
  5321. 26710      GKZ#=0   :GKN#=0  :D=.75!  :GZP%(C)=0  :XL=X+120  :YL=Y-80
  5322. 26715      FOR B=1 TO KOZ
  5323. 26720          A=GRPZ#(B,0)
  5324. 26725          IF (KMT%(A) MOD 2)=C THEN
  5325. 26730             GKZ#=GKZ#+GRPZ#(B,1)   :IF GKZ#=GKN# THEN 26785
  5326. 26735             G=GKZ#/GKW#+.75! :GZT%(GZP%(C),C)=A
  5327. 26740             IF G>1 THEN G=G-1   :IF G>.75! THEN RETURN
  5328. 26745             CIRCLE(X,MPYL+140),R,%BCL(A+29),,D,G,F,PSET
  5329. 26750             LINE(XL,YL)-STEP(20,15),PSET,%BCL(0),BF,%BCL(A+29)
  5330. 26755             SYMBOL(XL+25,YL),KOM$(A),SX,SY,%BCL(0)
  5331. 26760             IF KMT%(A)>1 THEN SYMBOL(XL-2 ,YL+1),STR$(KMT%(A)),                                                            SX,SY,%BCL(2),,XOR
  5332. 26765             A$=STR$(GKZ#-GKN#)  :GOSUB *CONMA_P
  5333. 26770             SYMBOL(XL+220-LEN(A$)*8*SX,YL),A$,SX,SY,%BCL(0)
  5334. 26775             D=G   :GKN#=GKZ#    :GZP%(C)=GZP%(C)+1
  5335. 26780             YL=YL+18 :IF YL>Y+90 THEN YL=Y-80 :XL=XL+250
  5336. 26785          ENDIF
  5337. 26790      NEXT B
  5338. 26795  NEXT C
  5339. 26800  RETURN
  5340. 26805 '
  5341. 26810 *KT_DAT
  5342. 26815  DATA 収入,支出
  5343. 26820  '
  5344. 26825 *SWAP_GRPZ
  5345. 26830  FOR A=1 TO KOZ
  5346. 26835      GKZ#=0
  5347. 26840      GOSUB *GK_CALK
  5348. 26845      GRPZ#(A,0)=A
  5349. 26850      GRPZ#(A,1)=GKZ#
  5350. 26855  NEXT A
  5351. 26860  IF KOZ<2 THEN RETURN
  5352. 26865  FOR A=1 TO KOZ-1
  5353. 26870      FOR B=A+1 TO KOZ
  5354. 26875          IF GRPZ#(A,1)<GRPZ#(B,1) THEN
  5355. 26880             SWAP GRPZ#(A,0),GRPZ#(B,0)
  5356. 26885             SWAP GRPZ#(A,1),GRPZ#(B,1)
  5357. 26890          ENDIF
  5358. 26895      NEXT B
  5359. 26900  NEXT A
  5360. 26905  RETURN
  5361. 26910  '
  5362. 26915 *MAX_CALK
  5363. 26920  IF GRAP_SW=0 THEN GXM=1 :GZM=12 :PDF=0 :PDE=364+URY :GXD=1 :GZD=31
  5364. 26925  A=GXM  :X=PDF  :B=GXD
  5365. 26930  WHILE  X=<PDE
  5366. 26935      MAX_O#(A)=0   :MAX_I#(A)=0
  5367. 26940      M=MONT(A)     :IF A=2 THEN M=M+URY
  5368. 26945      IF GZM=A THEN C=GZD   ELSE C=M
  5369. 26950      FOR G=B TO C
  5370. 26955            E=KMAX(X)  :F=0
  5371. 26960            WHILE E>F
  5372. 26965                  T=KMI%(X,F)  :K#=KIN&(X,F)
  5373. 26970                  IF KMT%(T)>1 THEN Z=1     ELSE Z=KSU%(X,F)
  5374. 26975                  IF (KMT%(T) MOD 2)=0                                                            THEN MAX_O#(A)=MAX_O#(A)+K#*Z                                               ELSE MAX_I#(A)=MAX_I#(A)+K#
  5375. 26980                  F=F+1
  5376. 26985            WEND
  5377. 26990            X=X+1  :IF X>PDE THEN *MAX_CALK2
  5378. 26995      NEXT G
  5379. 27000      A=A+1  :B=1  :IF A>12  THEN *MAX_CALK2
  5380. 27005  WEND
  5381. 27010  *MAX_CALK2
  5382. 27015   K#=0
  5383. 27020   FOR A=GXM TO GZM
  5384. 27025       IF K#<MAX_I#(A) THEN K#=MAX_I#(A)
  5385. 27030       IF K#<MAX_O#(A) THEN K#=MAX_O#(A)
  5386. 27035   NEXT A
  5387. 27040   RETURN
  5388. 27045 '
  5389. 27050 *BO_GRAP
  5390. 27055  IF K#=0 THEN RETURN
  5391. 27060  XL=MPXL+(GXM-1)*18+10  :YL=MPYL+500
  5392. 27065  Y=200/K#
  5393. 27070  LINE (MPXL+5,YL+5)-STEP(220,0),PSET,%BCL(0)
  5394. 27075  LINE (MPXL+5,YL+5)-STEP(0,-205),PSET,%BCL(0)
  5395. 27080  CL1=BCL(16)  :CL2=BCL(15)
  5396. 27085  FOR A=GXM TO GZM
  5397. 27090      LINE(XL+(A-GXM)*18,YL)-STEP(10,Y*MAX_I#(A)*(-1)),PSET,%CL1,BF
  5398. 27095      LINE(XL+(A-GXM)*18+5,YL)-STEP(10,Y*MAX_O#(A)*(-1)),PSET,%CL2,BF
  5399. 27100      SYMBOL(XL+(A-GXM)*18-8,YL+20),STR$(A),SX,SY,%BCL(0)
  5400. 27105  NEXT A
  5401. 27110  RETURN
  5402. 27115 '
  5403. 27120 *SEN_GRAP
  5404. 27125  IF K#=0 THEN RETURN
  5405. 27130  GOSUB *GRF_LINE
  5406. 27135  FOR B=1 TO KOZ
  5407. 27140      C=GRPZ#(B,0) :IF GRPZ#(B,1)=0 THEN 27190
  5408. 27145      E=GRPZ#(B,1)/300
  5409. 27150      POINT (XL,YL-GKX#(PDF,C)/E)
  5410. 27155      Y#=0
  5411. 27160      FOR A=PDF+1 TO PDE
  5412. 27165          Y#=Y#+GKX#(A,C)
  5413. 27170          IF Y#=0 THEN POINT (XL+(A-PDF)*D,YL-Y#/E) :GOTO 27185
  5414. 27175          LINE -(XL+(A-PDF)*D,YL-Y#/E),PSET,%BCL(C+29)
  5415. 27180          IF Y#=GRPZ#(B,1) THEN 27190
  5416. 27185      NEXT A
  5417. 27190  NEXT B
  5418. 27195  RETURN
  5419. 27200  '
  5420. 27205 *ORE_GRAP
  5421. 27210  IF K#=0 THEN RETURN
  5422. 27215  GOSUB *GRF_LINE
  5423. 27220  FOR B=1 TO KOZ
  5424. 27225      IF GRPZ#(B,0)=GZT%(GTP,GC) THEN *ORE_GRAP2
  5425. 27230  NEXT B
  5426. 27235  RETURN
  5427. 27240  '
  5428. 27245 *ORE_GRAP2
  5429. 27250  IF GRPZ#(B,1)=0 THEN RETURN
  5430. 27255  C=GRPZ#(B,0)  :Y#=0
  5431. 27260  FOR A=PDF TO PDE
  5432. 27265      IF Y#<GKX#(A,C) THEN Y#=GKX#(A,C)
  5433. 27270  NEXT A
  5434. 27275  E=Y#/300
  5435. 27280  POINT (XL,YL-GKX#(PDF,C)/E)
  5436. 27285  FOR A=PDF+1 TO PDE
  5437. 27290      LINE -(XL+(A-PDF)*D,YL-GKX#(A,C)/E),PSET,%BCL(C+29)
  5438. 27295  NEXT A
  5439. 27300  A$=STR$(Y#)  :GOSUB *CONMA_P
  5440. 27305  SYMBOL(XL,YL-300),"最大値 [\"+A$+"]",1,1,%BCL(0)
  5441. 27310  Y#=INT(GRPZ#(B,1)/(PDE-PDF+1))
  5442. 27315  A$=STR$(Y#)  :GOSUB *CONMA_P
  5443. 27320  A$="平均値 [\"+A$+"/日]"
  5444. 27325  SYMBOL(XL,YL-270),A$,1,1,%BCL(0)
  5445. 27330  LINE (XL,YL-Y#/E)-STEP(740,0),PSET,%BCL(0),,&H3838
  5446. 27335  RETURN
  5447. 27340  '
  5448. 27345 *GRF_LINE
  5449. 27350  XL=MPXL+20  :YL=MPYL-50
  5450. 27355  LINE (XL-5,YL+5)-STEP(740,0),PSET,%BCL(0)
  5451. 27360  LINE (XL-5,YL+5)-STEP(0,-300),PSET,%BCL(0)
  5452. 27365  D=INT(740/(PDE-PDF))
  5453. 27370  IF GRAP_SW=0 THEN *GRF_LINE2
  5454. 27375  FOR A=XL TO 740  STEP D*7
  5455. 27380      LINE (A,YL)-STEP(0,5),PSET,%BCL(0)
  5456. 27385  NEXT A
  5457. 27390  RETURN
  5458. 27395 '
  5459. 27400 *GRF_LINE2
  5460. 27405  LINE (XL,YL)-STEP(0,5),PSET,%BCL(0)  :M=0
  5461. 27410  FOR A=1 TO 12
  5462. 27415      M=M+MONT(A)     :IF A=2 THEN M=M+URY
  5463. 27420      LINE (XL+M*D,YL)-STEP(0,5),PSET,%BCL(0)
  5464. 27425  NEXT A
  5465. 27430  RETURN
  5466. 27435 '-------------------------------------------------------------------
  5467. 27440 *KMG_PUT
  5468. 27445  X1=MPXL      :Y1=MPYL    :X2=MPXF    :Y2=MPYF
  5469. 27450  A=9          :GOSUB *SWAP_XY
  5470. 27455  MPXL=PXL%(10):MPYL=PYL%(10) :MPXE=PXE%(10) :MPYE=PYE%(10)
  5471. 27460  GOSUB *OPEN_P2
  5472. 27465  BCL(1)=BCL(18) :BCL(9)=BCL(19)  :KGCS=1    :KGC_SW=0  :GRF$=""
  5473. 27470  GOSUB *SET_KGZ
  5474. 27475  REW_X=PXE%(10) :REW_Y=PYE%(10)  :BDP=12    :BPQ=0
  5475. 27480  MUX_S=MUX  :MUY_S=MUY
  5476. 27485  GOSUB *BOLD_P
  5477. 27490  GOSUB *SET_XYD
  5478. 27495  GOSUB *SEL_MXY
  5479. 27500  IF ER=1 THEN 27520
  5480. 27505  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN3I,*YL_UP3I,*XL_RIGHT3I,                      *XL_LEFT3I,*DRAG_B,*BSCR_P3I,*CSL_S3I,*CSL_D3I,*RET_W
  5481. 27510  IF JP<>1 THEN 27495
  5482. 27515  NEXP=NEXP+1
  5483. 27520  GOSUB *CLOSE_P2
  5484. 27525  PXL%(10)=MPXL :PYL%(10)=MPYL :PXE%(10)=MPXE :PYE%(10)=MPYE
  5485. 27530  A=9  :GOSUB *SWAP_XY   :MUX=MUX_S  :MUY=MUY_S
  5486. 27535  GOSUB *SET_XYD         :GOSUB *SCR_BACK
  5487. 27540  JP=9 :REW_X=PXE%(2) :REW_Y=PYE%(2)
  5488. 27545  RETURN
  5489. 27550 '
  5490. 27555 *BD_12P
  5491. 27560  FILS$="["+LEFT$(KOM$(GZT%(GTP,GC)),KOML)+"]"
  5492. 27565  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)   :                                 VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  5493. 27570  GOSUB *BD12_LINE
  5494. 27575  XL=MPXL+5  :YL=MPYL+55  :E=0   :F=1
  5495. 27580  FOR A=PDF TO PDE
  5496. 27585      B=KMAX(A)   :D=0
  5497. 27590      WHILE B>D
  5498. 27595            C=KMI%(A,D)   :IF C<>GZT%(GTP,GC) THEN 27665
  5499. 27600            IF GRF$<>"" THEN IF INSTR(KNE$(A,D),GRF$)=0 THEN 27665
  5500. 27605            IF KGCS>F THEN 27660
  5501. 27610            P=A  :GOSUB *SET_MDX
  5502. 27615            A$=RIGHT$(STR$(M),2)+"/"+RIGHT$(STR$(U),2)
  5503. 27620            IF U>0 THEN SYMBOL(XL,YL+E*18),A$,1,1,%BCL(0)
  5504. 27625            SYMBOL(XL+6*8,YL+E*18),LEFT$(KNE$(A,D),GSX),1,1,%BCL(0)
  5505. 27630            A$=STR$(KIN&(A,D))  :GOSUB *CONMA_P
  5506. 27635            SYMBOL(XL+(GSX+18-LEN(A$))*8,YL+E*18),A$,1,1,%BCL(0)
  5507. 27640            A$=STR$(ABS(KSU%(A,D)))
  5508. 27645            SYMBOL(XL+(GSX+26-LEN(A$))*8,YL+E*18),A$,1,1,%BCL(0)
  5509. 27650            E=E+1
  5510. 27655            IF YL+E*18>MPYF-32 THEN 27680
  5511. 27660            F=F+1
  5512. 27665            D=D+1
  5513. 27670      WEND
  5514. 27675  NEXT A
  5515. 27680  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  5516. 27685  GOSUB *CASOL_P3I  :GOSUB *CASOL_P3IB
  5517. 27690  RETURN
  5518. 27695 '
  5519. 27700 *BD12_LINE
  5520. 27705  IF GSX=0 THEN GSX=20
  5521. 27710  XL=MPXL+5  :YL=MPYL+50  :X=(GSX+26)*8
  5522. 27715      SYMBOL(XL+6*8,YL-10),STR$(GSX),.7!,.7!,%BCL(0)
  5523. 27720      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  5524. 27725      LINE (XL+(GSX+26)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5525. 27730      LINE (XL,YL  )-STEP(X,0),PSET,%BCL(0)
  5526. 27735      SYMBOL(XL,YL-28),"[月日]",1,1,%BCL(0)
  5527. 27740      LINE (XL+6*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5528. 27745      SYMBOL(XL+6*8,YL-28),"[名 称]",1,1,%BCL(0)
  5529. 27750      LINE (XL+(GSX+6)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5530. 27755      SYMBOL(XL+(GSX+6)*8,YL-28),"[金 額]",1,1,%BCL(0)
  5531. 27760      LINE (XL+(GSX+18)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5532. 27765      SYMBOL(XL+(GSX+18)*8,YL-28),"[数 量]",1,1,%BCL(0)
  5533. 27770  RETURN
  5534. 27775 '
  5535. 27780 *SET_MDX
  5536. 27785  FOR M=1 TO 12
  5537. 27790      IF M=2 THEN U=MONT(M)+URY   ELSE U=MONT(M)
  5538. 27795      IF U<P THEN
  5539. 27800                  P=P-U
  5540. 27805             ELSE
  5541. 27810                  IF U=P THEN M=M+1 :P=0
  5542. 27815                  U=P+1 :RETURN
  5543. 27820             ENDIF
  5544. 27825  NEXT M
  5545. 27830  U=0
  5546. 27835  RETURN
  5547. 27840  '
  5548. 27845 *SET_KGZ
  5549. 27850  KGZ=0
  5550. 27855  FOR A=PDF TO PDE
  5551. 27860      B=KMAX(A)   :D=0
  5552. 27865      WHILE B>D
  5553. 27870            C=KMI%(A,D)
  5554. 27875            IF C<>GZT%(GTP,GC) THEN 27890
  5555. 27880            IF GRF$<>"" THEN IF INSTR(KNE$(A,D),GRF$)=0 THEN 27890
  5556. 27885            KGZ=KGZ+1
  5557. 27890            D=D+1
  5558. 27895      WEND
  5559. 27900  NEXT A
  5560. 27905  RETURN
  5561. 27910  '
  5562. 27915 *YL_DOWN3I
  5563. 27920  KGCS=KGCS+1
  5564. 27925  IF KGCS>KGZ THEN KGCS=KGZ
  5565. 27930  GOSUB *BD_SUBP
  5566. 27935  RETURN
  5567. 27940  '
  5568. 27945 *YL_UP3I
  5569. 27950  KGCS=KGCS-1
  5570. 27955  IF KGCS<1 THEN KGCS=1
  5571. 27960  GOSUB *BD_SUBP
  5572. 27965  RETURN
  5573. 27970 '
  5574. 27975 *XL_RIGHT3I
  5575. 27980  L=INT((MPYE-71)/18)+1
  5576. 27985  KGCS=KGCS+L
  5577. 27990  IF KGCS>KGZ THEN KGCS=KGCS-L
  5578. 27995  GOSUB *BD_SUBP
  5579. 28000  RETURN
  5580. 28005 '
  5581. 28010 *XL_LEFT3I
  5582. 28015  L=INT((MPYE-71)/18)+1
  5583. 28020  KGCS=KGCS-L
  5584. 28025  IF KGCS<1 THEN KGCS=1
  5585. 28030  GOSUB *BD_SUBP
  5586. 28035  RETURN
  5587. 28040 '
  5588. 28045 *CASOL_P3I
  5589. 28050  A=KGZ :B=KGCS
  5590. 28055  GOSUB *CASOL_PX1
  5591. 28060  RETURN
  5592. 28065 '
  5593. 28070 *CASOL_P3IB
  5594. 28075  IF KGZ<1 THEN C=1    ELSE C=KGZ
  5595. 28080  A=MPXE-80 :B=((MPXE-80)/C)*(KGCS-1)
  5596. 28085  GOSUB *CASOL_PX2
  5597. 28090  RETURN
  5598. 28095 '
  5599. 28100 *CSL_S3I
  5600. 28105  IF KGZ=0 THEN GOSUB *RET_W :RETURN
  5601. 28110  A=KGZ
  5602. 28115  GOSUB *ｶｰｿﾙ_SET1
  5603. 28120  KGCS=P
  5604. 28125  GOSUB *BD_SUBP
  5605. 28130  RETURN
  5606. 28135 '
  5607. 28140 *CSL_D3I
  5608. 28145  IF KGZ=0 THEN GOSUB *RET_W :RETURN
  5609. 28150  A=KGZ
  5610. 28155  GOSUB *ｶｰｿﾙ_SET2
  5611. 28160  KGCS=P
  5612. 28165  GOSUB *BD_SUBP
  5613. 28170  RETURN
  5614. 28175 '
  5615. 28180 *BSCR_P3I
  5616. 28185  IF MUX>MPXL+6*8+5 AND MUX<MPXL+14*8+5 AND MUY>MPYL+22 AND MUY<MPYL+40          AND KGC_SW=1  THEN GRF$="" :KGCS=KGCS_S :KGC_SW=0 :GOTO 28225
  5617. 28190  IF KGC_SW=1 THEN 28230
  5618. 28195  YL=INT((MUY-MPYL-55)/18)
  5619. 28200  P=YL+KGCS
  5620. 28205  IF YL<0  THEN *LINE_EXE3I
  5621. 28210  IF P>KGZ THEN 28230
  5622. 28215  GOSUB *SET_GRF  :GOSUB *DRAG_SET  :IF A=0 THEN 28230
  5623. 28220  KGC_SW=1  :KGCS_S=KGCS  :KGCS=1
  5624. 28225  GOSUB *SET_KGZ  :GOSUB *BD_12P
  5625. 28230  WHILE MOUSE(2,0)=-1   :WEND
  5626. 28235  WHILE MOUSE(2,1)=-1   :WEND
  5627. 28240  MOUSE 5
  5628. 28245  RETURN
  5629. 28250 '
  5630. 28255 *LINE_EXE3I
  5631. 28260  GOSUB *LINE_EXEP
  5632. 28265  IF CAR_END=1 THEN GSX=VAL(MX$)
  5633. 28270  GOSUB *BOLD_P2
  5634. 28275  RETURN
  5635. 28280 '
  5636. 28285 *SET_GRF
  5637. 28290  F=0  :P=P-1
  5638. 28295  FOR A=PDF TO PDE
  5639. 28300      B=KMAX(A)   :D=0
  5640. 28305      WHILE B>D
  5641. 28310            C=KMI%(A,D)
  5642. 28315            IF C<>GZT%(GTP,GC) THEN 28335
  5643. 28320            IF P>F THEN 28330
  5644. 28325            GRF$=KNE$(A,D)  :RETURN
  5645. 28330            F=F+1
  5646. 28335            D=D+1
  5647. 28340      WEND
  5648. 28345  NEXT A
  5649. 28350  RETURN
  5650. 28355 '
  5651. 28360 *DRAG_SET
  5652. 28365  A=LEN(GRF$) :IF A=0 THEN RETURN
  5653. 28370  XP=INT((MUX-MPXL-6*8-5)/8)
  5654. 28375  IF XP<0 OR XP>A THEN RETURN
  5655. 28380  X1=MPXL+(XP+6)*8+5  :Y1=MPYL+YL*18+55  :X2=X1  :Y2=Y1+16 :B=MOUSE(9)
  5656. 28385  LINE (MPXL+6*8+5,Y1)-STEP(A*8,16),PSET,%BCL(10),BF
  5657. 28390  SYMBOL(MPXL+6*8+5,Y1),GRF$,1,1,%BCL(0)
  5658. 28395  WHILE MOUSE(2,0)=-1
  5659. 28400        IF MOUSE(2,1)=-1 THEN A=0 :RETURN
  5660. 28405        IF MOUSE(9)=0 THEN 28425
  5661. 28410        LINE (X1,Y1)-(X2,Y2),XOR,%BCL(2),BF
  5662. 28415        X2=MOUSE(0)
  5663. 28420        LINE (X1,Y1)-(X2,Y2),XOR,%BCL(2),BF
  5664. 28425  WEND
  5665. 28430  X=INT((X2-MPXL-6*8-5)/8)
  5666. 28435  IF X=XP THEN RETURN
  5667. 28440  IF X<0  THEN GRF$=LEFT$(GRF$,XP+1)  :RETURN
  5668. 28445  IF X>A  THEN GRF$=MID$(GRF$,XP+1)   :RETURN
  5669. 28450  IF XP>X THEN SWAP XP,X
  5670. 28455  P=X-XP+1
  5671. 28460  GRF$=MID$(GRF$,XP+1,P)
  5672. 28465  RETURN
  5673. 28470 '-------------------------------------------------------------------
  5674. 28475 *KMG_COL
  5675. 28480  X1=MPXL      :Y1=MPYL       :X2=MPXF       :Y2=MPYF
  5676. 28485  A=9          :GOSUB *SWAP_XY
  5677. 28490  MPXL=PXL%(11):MPYL=PYL%(11) :MPXE=PXE%(11) :MPYE=PYE%(11)
  5678. 28495  GOSUB *OPEN_P2
  5679. 28500  BCL(1)=BCL(18) :BCL(9)=BCL(19) :KGPS=1
  5680. 28505  KGPC=GZT%(GTP,GC)+29     :KGPZ=BCL(KGPC)
  5681. 28510  REW_X=PXE%(11) :REW_Y=PYE%(11) :BDP=13 :BPQ=0 :MUX_S=MUX :MUY_S=MUY
  5682. 28515  GOSUB *BOLD_P
  5683. 28520  GOSUB *SET_XYD
  5684. 28525  GOSUB *SEL_MXY
  5685. 28530  IF ER=1 THEN 28550
  5686. 28535  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN3C,*YL_UP3C,*XL_RIGHT3C,                      *XL_LEFT3C,*DRAG_B,*BSCR_P3C,*CSL_S3C,*CSL_D3C,*RET_W
  5687. 28540  IF JP<>1 THEN 28525
  5688. 28545  NEXP=NEXP+1
  5689. 28550  GOSUB *CLOSE_P2
  5690. 28555  PXL%(11)=MPXL :PYL%(11)=MPYL :PXE%(11)=MPXE :PYE%(11)=MPYE
  5691. 28560  A=9  :GOSUB *SWAP_XY   :MUX=MUX_S  :MUY=MUY_S
  5692. 28565  GOSUB *SET_XYD         :GOSUB *SCR_BACK
  5693. 28570  IF KGPZ<>BCL(KGPC) THEN GOSUB *BCL_SAVE
  5694. 28575  JP=9  :REW_X=PXE%(2)   :REW_Y=PYE%(2)
  5695. 28580  RETURN
  5696. 28585 '
  5697. 28590 *BD_13P
  5698. 28595  FILS$="["+LEFT$(KOM$(GZT%(GTP,GC)),KOML)+"] 色設定"
  5699. 28600  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)   :                                 VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  5700. 28605  LINE (MPXL+10,MPYL+20)-STEP(20,15),PSET,%BCL(0),BF,%BCL(KGPC)
  5701. 28610  SYMBOL(MPXL+40,MPYL+20),"設定色(No"+STR$(BCL(KGPC))+")",1,1,%BCL(0)
  5702. 28615  XL=MPXL+5  :YL=MPYL+40  :L=INT((MPXE-25)/15)+1  :B=1
  5703. 28620  FOR A=KGPS TO 256
  5704. 28625      LINE(XL,YL)-STEP(15,10),PSET,%(A-1),BF
  5705. 28630      XL=XL+15  :B=B+1
  5706. 28635      IF B>L THEN YL=YL+10  :XL=MPXL+5  :B=1
  5707. 28640      IF YL>MPYF-16 THEN 28650
  5708. 28645  NEXT A
  5709. 28650  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  5710. 28655  GOSUB *CASOL_P3C  :GOSUB *CASOL_P3CB
  5711. 28660  RETURN
  5712. 28665 '
  5713. 28670 *YL_DOWN3C
  5714. 28675  KGPS=KGPS+1
  5715. 28680  IF KGPS>255 THEN KGPS=255
  5716. 28685  GOSUB *BD_SUBP
  5717. 28690  RETURN
  5718. 28695  '
  5719. 28700 *YL_UP3C
  5720. 28705  KGPS=KGPS-1
  5721. 28710  IF KGPS<1 THEN KGPS=1
  5722. 28715  GOSUB *BD_SUBP
  5723. 28720  RETURN
  5724. 28725 '
  5725. 28730 *XL_RIGHT3C
  5726. 28735  KGPS=KGPS+L
  5727. 28740  IF KGPS>255 THEN KGPS=KGPS-L
  5728. 28745  GOSUB *BD_SUBP
  5729. 28750  RETURN
  5730. 28755 '
  5731. 28760 *XL_LEFT3C
  5732. 28765  KGPS=KGPS-L
  5733. 28770  IF KGPS<1 THEN KGPS=1
  5734. 28775  GOSUB *BD_SUBP
  5735. 28780  RETURN
  5736. 28785 '
  5737. 28790 *CASOL_P3C
  5738. 28795  A=255 :B=KGPS
  5739. 28800  GOSUB *CASOL_PX1
  5740. 28805  RETURN
  5741. 28810 '
  5742. 28815 *CASOL_P3CB
  5743. 28820  A=MPXE-80 :B=((MPXE-80)/255)*(KGPS-1)
  5744. 28825  GOSUB *CASOL_PX2
  5745. 28830  RETURN
  5746. 28835 '
  5747. 28840 *CSL_S3C
  5748. 28845  A=255
  5749. 28850  GOSUB *ｶｰｿﾙ_SET1
  5750. 28855  KGPS=P
  5751. 28860  GOSUB *BD_SUBP
  5752. 28865  RETURN
  5753. 28870 '
  5754. 28875 *CSL_D3C
  5755. 28880  A=255
  5756. 28885  GOSUB *ｶｰｿﾙ_SET2
  5757. 28890  KGPS=P
  5758. 28895  GOSUB *BD_SUBP
  5759. 28900  RETURN
  5760. 28905 '
  5761. 28910 *BSCR_P3C
  5762. 28915  XL=INT((MUX-MPXL-5)/15)
  5763. 28920  YL=INT((MUY-MPYL-40)/10)
  5764. 28925  XP=YL*L+XL+KGPS-1
  5765. 28930  IF XP<0 OR XP>255 THEN 28945
  5766. 28935  BCL(KGPC)=XP
  5767. 28940  MOUSE 1,,,0  :GOSUB *BD_13P
  5768. 28945  WHILE MOUSE(2,0)=-1   :WEND
  5769. 28950  RETURN
  5770. 28955 '
  5771. 28960 *BCL_LOAD
  5772. 28965  ON ERROR GOTO *ERR_P13L
  5773. 28970  OPEN "I",#1,FIL$(12)
  5774. 28975      FOR A=30 TO 80
  5775. 28980          INPUT #1,BCL(A)
  5776. 28985          IF EOF(1)=-1 THEN *LBCL_RET
  5777. 28990      NEXT A
  5778. 28995  *LBCL_RET
  5779. 29000  CLOSE #1
  5780. 29005  ON ERROR GOTO 0
  5781. 29010  RETURN
  5782. 29015 '
  5783. 29020 *ERR_P13L
  5784. 29025  IF ERR<>63 THEN *ERR_MESE
  5785. 29030  GOSUB  *SET_BCL2
  5786. 29035  RESUME *LBCL_RET
  5787. 29040 '
  5788. 29045 *BCL_SAVE
  5789. 29050  ON ERROR GOTO *ERR_P13S
  5790. 29055  OPEN "O",#1,FIL$(12)
  5791. 29060       FOR A=30 TO 80
  5792. 29065           PRINT #1,BCL(A)
  5793. 29070       NEXT A
  5794. 29075  *SBCL_RET
  5795. 29080  CLOSE #1
  5796. 29085  ON ERROR GOTO 0
  5797. 29090  RETURN
  5798. 29095 '
  5799. 29100 *ERR_P13S
  5800. 29105  IF ERR<>64 THEN *ERR_MESE
  5801. 29110  KILL FIL$(12)
  5802. 29115  RESUME
  5803. 29120 '
  5804. 29125 *SET_BCL2
  5805. 29130  RESTORE *BCL_DAT2
  5806. 29135  FOR A=30 TO 80
  5807. 29140      READ BCL(A)
  5808. 29145  NEXT A
  5809. 29150  RETURN
  5810. 29155 '
  5811. 29160 '-------------------------------------------------------------------
  5812. 29165 *NOTO_R
  5813. 29170  A=NP(NEXP)    :GOSUB *SWAP_XY
  5814. 29175  MPXL=PXL%(4)  :MPYL=PYL%(4)  :MPXE=PXE%(4)  :MPYE=PYE%(4)
  5815. 29180  A=4           :GOSUB *OPEN_P
  5816. 29185 *NOTO_R2
  5817. 29190  BDP=5  :BPQ=0  :WKST=1  :REF_SW=0  :RVX=0
  5818. 29195  GOSUB *SEL_WAKP
  5819. 29200  IF JPQ=1 THEN GOTO *NEX_P
  5820. 29205  RETURN
  5821. 29210  '
  5822. 29215 *BD_5P
  5823. 29220  FILS$="家計簿 [検索]"
  5824. 29225  WINDOW (MPXL+RVX+1,MPYL+17)-(MPXF+RVX-17,MPYF-17)
  5825. 29230  VIEW   (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  5826. 29235  GOSUB *BD5_LINE
  5827. 29240  IF RMAX=0  THEN 29310
  5828. 29245  XL=MPXL+5  :YL=MPYL+55  :E=RKML+12
  5829. 29250  FOR A=CSP5-1 TO RMAX-1
  5830. 29255      SYMBOL(XL+(3-LEN(STR$(A+1)))*8,YL),STR$(A+1),1,1,%BCL(0)
  5831. 29260      IF RFP_SW<2 THEN
  5832. 29265                       P=3*8               :PL=0
  5833. 29270                       CL1=RJK(A,0)        :GOSUB *PUT_RJK
  5834. 29275                       GOSUB *RFX_PUT
  5835. 29280                  ELSE 
  5836. 29285                       GOSUB *RFD_PUT
  5837. 29290                  ENDIF
  5838. 29295      YL=YL+18
  5839. 29300      IF YL>MPYF-52 THEN 29310
  5840. 29305  NEXT A
  5841. 29310  LINE (XL-4,MPYF-34)-STEP((RKML+RSX+33)*8+5,17),PSET,%BCL(4),BF
  5842. 29315  IF RFP_SW=1 THEN CL=BCL(8)   ELSE CL=BCL(0)
  5843. 29320  SYMBOL(XL+5  ,MPYF-33),"[条件設定]",1,1,%CL
  5844. 29325  IF RFP_SW<2 THEN SYMBOL(XL+105,MPYF-33),"[検索実行]",1,1,%BCL(0)
  5845. 29330  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  5846. 29335  GOSUB *CASOL_P5  :GOSUB *CASOL_P5B
  5847. 29340  RETURN
  5848. 29345 '
  5849. 29350 *BD5_LINE
  5850. 29355  IF RSX=0 THEN RSX=20
  5851. 29360  IF RKML=0 THEN RKML=20
  5852. 29365  XL=MPXL+5  :YL=MPYL+50
  5853. 29370      SYMBOL(XL+12*8,YL-10),STR$(RKML),.7!,.7!,%BCL(0)
  5854. 29375      SYMBOL(XL+(RKML+12)*8,YL-10),STR$(RSX),.7!,.7!,%BCL(0)
  5855. 29380      LINE (XL,YL-5)-STEP(0,7),PSET,%BCL(0)
  5856. 29385      LINE (XL+(RKML+RSX+33)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5857. 29390      SYMBOL(XL,YL-28),"No.",1,1,%BCL(0)
  5858. 29395      LINE (XL+3*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5859. 29400      LINE (XL,YL  )-STEP((RKML+RSX+33)*8,0),PSET,%BCL(0)
  5860. 29405      SYMBOL(XL+3*8,YL-28),"[月日]",1,1,%BCL(0)
  5861. 29410      LINE (XL+11*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5862. 29415      SYMBOL(XL+11*8,YL-28),"[項 目]",1,1,%BCL(0)
  5863. 29420      LINE (XL+(RKML+12)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5864. 29425      SYMBOL(XL+(RKML+12)*8,YL-28),"[名 称]",1,1,%BCL(0)
  5865. 29430      LINE (XL+(RKML+RSX+13)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5866. 29435      SYMBOL(XL+(RKML+RSX+13)*8,YL-28),"[金 額]",1,1,%BCL(0)
  5867. 29440      LINE (XL+(RKML+RSX+26)*8,YL-5)-STEP(0,7),PSET,%BCL(0)
  5868. 29445      SYMBOL(XL+(RKML+RSX+26)*8,YL-28),"[数量]",1,1,%BCL(0)
  5869. 29450  RETURN
  5870. 29455 '
  5871. 29460 *RFD_PUT
  5872. 29465  PDR=RFD(A)  :PA=RFP(A) :P=PDR      :GOSUB *SET_MDX
  5873. 29470  A$=RIGHT$(STR$(M),2)+"/"+RIGHT$(STR$(U),2)
  5874. 29475  P=10        :PL=4*8    :CL=BCL(0)              :GOSUB *PUT_DAT
  5875. 29480  A$=KOM$(KMI%(PDR,PA))  :P=RKML+11  :PL=11*8    :GOSUB *PUT_DAT
  5876. 29485  A$=KNE$(PDR,PA) :P=RSX+RKML+11 :PL=(RKML+12)*8 :GOSUB *PUT_DAT
  5877. 29490  T=KMT%(KMI%(PDR,PA))
  5878. 29495  IF (T MOD 2)=0 THEN CL=BCL(0)       ELSE CL=BCL(10)
  5879. 29500                 TA&=KIN&(PDR,PA)    :TB=ABS(KSU%(PDR,PA))
  5880. 29505                 A$=STR$(TA&)        :P=RKML+RSX+25        :'金額
  5881. 29510                 PL=(RKML+RSX+13)*8  :GOSUB *CONMA_P
  5882. 29515                 GOSUB *PUT_DAT
  5883. 29520                 CL=BCL(0)                                 :'数
  5884. 29525                 A$=STR$(TB)         :P=RKML+RSX+33
  5885. 29530                 PL=(RKML+RSX+26)*8  :GOSUB *CONMA_P
  5886. 29535                 GOSUB *PUT_DAT
  5887. 29540  RETURN
  5888. 29545 '
  5889. 29550 *RFX_PUT
  5890. 29555  CL=BCL(0)
  5891. 29560  IF RFZ(A,0)>0 THEN
  5892. 29565                     P=RFZ(A,0)-1   :GOSUB *SET_MDX
  5893. 29570                     A$=RIGHT$(STR$(M),2)+"/"+RIGHT$(STR$(U),2)
  5894. 29575                ELSE
  5895. 29580                     GOTO 29600
  5896. 29585                ENDIF
  5897. 29590  P=10   :PL=4*8     :GOSUB *PUT_DAT
  5898. 29595  P=6*8  :PL=4*8     :CL1=RJK(A,1) :GOSUB *PUT_RJK
  5899. 29600  A$=KOM$(RFZ(A,1))  :P=RKML+11    :PL=11*8   :GOSUB *PUT_DAT
  5900. 29605  P=RKML*8  :PL=11*8 :CL1=RJK(A,2) :GOSUB *PUT_RJK
  5901. 29610  A$=RFN$(A):P=RSX+RKML+11   :PL=(RKML+12)*8  :GOSUB *PUT_DAT
  5902. 29615  P=RSX*8   :PL=(RKML+12)*8  :CL1=RJK(A,3)    :GOSUB *PUT_RJK
  5903. 29620  T=KMT%(RFZ(A,1))
  5904. 29625  IF (T MOD 2)=0 THEN CL=BCL(0)       ELSE CL=BCL(10)
  5905. 29630                 TA&=RFK&(A)         :TB=ABS(RFS%(A))
  5906. 29635                 IF TA&=0 THEN 29665
  5907. 29640                 A$=STR$(TA&)        :P=RKML+RSX+25        :'金額
  5908. 29645                 PL=(RKML+RSX+13)*8  :GOSUB *CONMA_P
  5909. 29650                 GOSUB *PUT_DAT
  5910. 29655                 P=12*8              :PL=(RKML+RSX+13)*8
  5911. 29660                 CL1=RJK(A,4)        :GOSUB *PUT_RJK
  5912. 29665                 IF TB=0  THEN 29700
  5913. 29670                 CL=BCL(0)                                 :'数
  5914. 29675                 A$=STR$(TB)         :P=RKML+RSX+33
  5915. 29680                 PL=(RKML+RSX+26)*8  :GOSUB *CONMA_P
  5916. 29685                 GOSUB *PUT_DAT
  5917. 29690                 P=7*8               :PL=(RKML+RSX+26)*8
  5918. 29695                 CL1=RJK(A,5)        :GOSUB *PUT_RJK
  5919. 29700  RETURN
  5920. 29705 '
  5921. 29710 *PUT_RJK
  5922. 29715  IF CL1=1 THEN RETURN
  5923. 29720  LINE (XL+PL,YL)-STEP(P,16),XOR,%BCL(CL1+18),BF
  5924. 29725  RETURN
  5925. 29730  '
  5926. 29735 *YL_DOWN5
  5927. 29740  CSP5=CSP5+1
  5928. 29745  IF CSP5>RMAX THEN CSP5=RMAX
  5929. 29750  GOSUB *BD_SUBP
  5930. 29755  RETURN
  5931. 29760 '
  5932. 29765 *YL_UP5
  5933. 29770  CSP5=CSP5-1
  5934. 29775  IF CSP5<1 THEN CSP5=1
  5935. 29780  GOSUB *BD_SUBP
  5936. 29785  RETURN
  5937. 29790 '
  5938. 29795 *XL_LEFT5
  5939. 29800  RVX=RVX-250
  5940. 29805  IF RVX<0 THEN RVX=0
  5941. 29810  GOSUB *BD_SUBP
  5942. 29815  RETURN
  5943. 29820 '
  5944. 29825 *XL_RIGHT5
  5945. 29830  RVX=RVX+250
  5946. 29835  GOSUB *BD_SUBP
  5947. 29840  RETURN
  5948. 29845 '
  5949. 29850 *CASOL_P5
  5950. 29855  A=RMAX :B=CSP5
  5951. 29860  GOSUB *CASOL_PX1
  5952. 29865  RETURN
  5953. 29870 '
  5954. 29875 *CASOL_P5B
  5955. 29880  A=640  :B=RVX
  5956. 29885  GOSUB *CASOL_PX2
  5957. 29890  RETURN
  5958. 29895 '
  5959. 29900 *CSL_S5
  5960. 29905  IF RMAX=0 THEN GOSUB *RET_W :RETURN
  5961. 29910  A=RMAX
  5962. 29915  GOSUB *ｶｰｿﾙ_SET1
  5963. 29920  CSP5=P
  5964. 29925  GOSUB *BD_SUBP
  5965. 29930  RETURN
  5966. 29935 '
  5967. 29940 *BSCR_P5
  5968. 29945  VXP=RVX     :INTERVAL ON
  5969. 29950 *BSCR_P5B
  5970. 29955  CRB=BCL(5)  :TIMX$=""   :GOSUB *CLOCK_P
  5971. 29960  IF MUX>MPXL+(RKML+RSX+33)*8+5-RVX THEN 30125
  5972. 29965  YL=INT((MUY-MPYL-55)/18)
  5973. 29970  IF MUY>MPYF-36 THEN
  5974. 29975                     IF RFP_SW<2 THEN
  5975. 29980                        IF MUX>MPXL+10-RVX AND MUX<MPXL+90-RVX THEN                                    IF RFP_SW=0 THEN RFP_SW=1    ELSE RFP_SW=0
  5976. 29985                        IF MUX>MPXL+110-RVX AND MUX<MPXL+190-RVX THEN
  5977. 29990                               GOSUB *REF_P
  5978. 29995                               IF RZMX>0 THEN RFP_SW=2
  5979. 30000                           ENDIF
  5980. 30005                        MOUSE 1,,,0  :GOSUB *BD_5P
  5981. 30010                        ENDIF
  5982. 30015                     IF RFP_SW=2 THEN
  5983. 30020                        IF MUX>MPXL+10-RVX AND MUX<MPXL+90-RVX THEN                                    RFP_SW=0 :RMAX=RMAXS :CSP5=CSP5S
  5984. 30025                        MOUSE 1,,,0  :GOSUB *BD_5P
  5985. 30030                        ENDIF
  5986. 30035                     GOTO 30125
  5987. 30040                 ENDIF
  5988. 30045  IF YL<0 THEN
  5989. 30050              IF MUY>MPYL+40 AND MUY<MPYL+50 THEN
  5990. 30055                 IF MUX>MPXL+11*8-RVX AND MUX<MPXL+(RKML+RSX+13)*8-RVX                          THEN *LINE_EXE5
  5991. 30060                 ENDIF
  5992. 30065              GOTO 30125
  5993. 30070          ENDIF
  5994. 30075  RFXP=YL+CSP5
  5995. 30080  IF RFXP>RMAX THEN
  5996. 30085                   IF RFP_SW=0 THEN *RFZ_INPUT
  5997. 30090                   GOTO 30125
  5998. 30095               ENDIF
  5999. 30100  IF RFXP>0    THEN
  6000. 30105                   IF RFP_SW=0 THEN *RFZ_EXE
  6001. 30110                   IF RFP_SW=1 THEN *RFJ_EXE
  6002. 30115                   IF RFP_SW=2 THEN GOSUB *RFD_GET
  6003. 30120               ENDIF
  6004. 30125  WHILE MOUSE(2,0)=-1  :WEND
  6005. 30130  RETURN
  6006. 30135 '
  6007. 30140 *LINE_EXE5
  6008. 30145  IF MUX>MPXL+11*8-RVX AND MUX<MPXL+(RKML+12)*8-RV  THEN G=1
  6009. 30150  IF MUX>MPXL+(RKML+12)*8-RVX AND                                                MUX<MPXL+(RKML+RSX+13)*8-RVX                   THEN G=2
  6010. 30155  GOSUB *LINE_EXEP
  6011. 30160  IF CAR_END=1 THEN
  6012. 30165                    IF G=1 THEN RKML=VAL(MX$)
  6013. 30170                    IF G=2 THEN RSX =VAL(MX$)
  6014. 30175               ENDIF
  6015. 30180  GOSUB *SCR_BACK
  6016. 30185  RETURN
  6017. 30190 '
  6018. 30195 *RFZ_EXE
  6019. 30200  WHILE MOUSE(2,0)=-1  :WEND
  6020. 30205  GOSUB *CRD_SET5  :IF ER=1 THEN ER=0 :GOTO 30350
  6021. 30210  GOSUB *CRP_SET5  :XLP=LEN(MX$)
  6022. 30215  GOSUB *KEY_CR
  6023. 30220  IF KPS=3 THEN
  6024. 30225                INTERVAL OFF
  6025. 30230                CRB=BCL(10)    :GOSUB *KEY_CR     :CRB=BCL(5)
  6026. 30235                MOUSE 5
  6027. 30240                GOSUB *KMD_IP  :JP=9
  6028. 30245                INTERVAL ON    :TIMX$=""  :GOSUB *CLOCK_P
  6029. 30250                IF ER=0 THEN INK_END=0    :CAR_END=1   ELSE 30355
  6030. 30255           ELSE
  6031. 30260                EXE_SW=1
  6032. 30265                GOSUB *INKEY_P
  6033. 30270                EXE_SW=0
  6034. 30275                IF RCLICK>0 THEN  CRB=BCL(10)      :GOSUB *KEY_CR   :                                         GOSUB *KILL_P5   :GOTO 30355
  6035. 30280                IF LCLICK>0 THEN
  6036. 30285                    CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  6037. 30290                    IF KPS=4 THEN GOSUB *GET_CORD5 :                                                          IF GET_ON=0 THEN *BSCR_P5B
  6038. 30295                    IF KPS>4 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P5B
  6039. 30300                   ENDIF
  6040. 30305           ENDIF
  6041. 30310  IF INK_END=0 THEN
  6042. 30315                    GOSUB *KMX_SET5   :GOSUB *KEY_CR
  6043. 30320                    IF CAR_END=1 THEN  GOSUB *CRD_NSET5
  6044. 30325                    GOSUB *BOLD_BACK
  6045. 30330                    GOTO  *BSCR_P5B
  6046. 30335               ELSE
  6047. 30340                    WHILE MOUSE(2,0)=-1  :WEND
  6048. 30345               ENDIF
  6049. 30350  MOUSE 5
  6050. 30355  RVX=VXP  :GOSUB *SCR_BACK
  6051. 30360  RETURN
  6052. 30365 '
  6053. 30370 *RFZ_INPUT
  6054. 30375  RFXP=RMAX+1     :IF RMAX>=RJZ THEN GOSUB *FLL_KMN :GOTO 30540
  6055. 30380  RFZ(RFXP-1,0)=0 :RFZ(RFXP-1,1)=0 :RFN$(RFXP-1)=""
  6056. 30385  RFK&(RFXP-1)=0  :RFS%(RFXP-1)=0
  6057. 30390  FOR A=0 TO 5    :RJK(RFXP-1,A)=0 :NEXT A
  6058. 30395  GOSUB *CRD_SET5 :IF ER=1    THEN ER=0 :GOTO 30535
  6059. 30400  MX$=""   :GOSUB *KEY_CR
  6060. 30405  WHILE MOUSE(2,0)=-1  :WEND
  6061. 30410  IF KPS=3 THEN
  6062. 30415                CRB=BCL(10)    :GOSUB *KEY_CR    :CRB=BCL(5)
  6063. 30420                INTERVAL OFF   :MOUSE 5
  6064. 30425                GOSUB *KMD_IP  :JP=9
  6065. 30430                INTERVAL ON    :TIMX$=""  :GOSUB *CLOCK_P
  6066. 30435                IF ER=0 THEN  INK_END=0   :CAR_END=1   ELSE  30540
  6067. 30440           ELSE
  6068. 30445                EXE_SW=1
  6069. 30450                GOSUB *INKEY_P
  6070. 30455                EXE_SW=0
  6071. 30460                IF LCLICK>0 THEN
  6072. 30465                   CRB=BCL(10)  :GOSUB *KEY_CR    :CRB=BCL(5)
  6073. 30470                   IF KPS=4 THEN GOSUB *GET_CORD5 :                                                          IF GET_ON=0 THEN *BSCR_P5B
  6074. 30475                   IF KPS>4 THEN GOSUB *CALK_BOD  :                                                          IF GET_ON=0 THEN *BSCR_P5B
  6075. 30480                  ENDIF
  6076. 30485           ENDIF
  6077. 30490  IF INK_END=0 THEN
  6078. 30495                    RMAX=RMAX+1       :RFXP=RMAX
  6079. 30500                    GOSUB *KMX_SET5   :GOSUB *KEY_CR
  6080. 30505                    IF CAR_END=1 THEN  GOSUB *CRD_NSET5
  6081. 30510                    GOSUB *BOLD_BACK
  6082. 30515                    GOTO  *BSCR_P5B
  6083. 30520               ELSE
  6084. 30525                    WHILE MOUSE(2,0)=-1  :WEND
  6085. 30530               ENDIF
  6086. 30535  MOUSE 5
  6087. 30540  RVX=VXP  :GOSUB *SCR_BACK
  6088. 30545  RETURN
  6089. 30550 '
  6090. 30555 *CRD_SET5
  6091. 30560  P=INT((MUX-MPXL-5+RVX)/8)    :A=RKML+RSX
  6092. 30565  IF P<0 OR P>(RKML+RSX+33)     THEN ER=1 :RETURN
  6093. 30570  IF P>=0  AND P<4         THEN CRXF=MPXL :CRXE=CRXF+4*8 :                                                  CRLEN=5   :KPS=1
  6094. 30575  IF P>=4  AND P<11   THEN CRXF=MPXL+3*8  :CRXE=CRXF+7*8 :                                             CRLEN=8        :KPS=2
  6095. 30580  IF P>=11 AND P<(RKML+11) THEN CRXF=MPXL+11*8 :                                                            CRXE=CRXF+RKML*8  :CRLEN=RKML+1 :KPS=3
  6096. 30585  IF P>=(RKML+11) AND P<(A+12)  THEN CRXF=MPXL+(RKML+12)*8 :                                                CRXE=CRXF+RSX*8   :CRLEN=RSX+1  :KPS=4
  6097. 30590  IF P>=(A+12)    AND P<(A+25)  THEN CRXF=MPXL+(A+13)*8 :                                                        CRXE=CRXF+13*8  :CRLEN=14  :KPS=5
  6098. 30595  IF P>=(A+25)    AND P<(A+32)  THEN CRXF=MPXL+(A+26)*8 :                                                        CRXE=CRXF+7*8   :CRLEN=8   :KPS=6
  6099. 30600  CRXF=CRXF+5-RVX   :CRXE=CRXE+5-RVX
  6100. 30605  CRYF=MPYL+55+(RFXP-CSP5)*18  :CRYE=CRYF+18
  6101. 30610  IF CRYF>MPYF-32 THEN  CSP5=CSP5+1  :GOSUB *BD_5P  :GOTO 30605
  6102. 30615  XLP=0  :CAR_END=0 :ER=0
  6103. 30620  RETURN
  6104. 30625 '
  6105. 30630 *CRP_SET5
  6106. 30635  MX$=""
  6107. 30640  IF KPS=1  THEN  MX$=STR$(RFXP) 
  6108. 30645  IF KPS=2  THEN
  6109. 30650                  P=RFZ(RFXP-1,0)-1
  6110. 30655                  IF P<0 THEN MX$=""   :RETURN
  6111. 30660                  GOSUB *SET_MDX
  6112. 30665                  MX$=RIGHT$(STR$(M),2)+"/"+RIGHT$(STR$(U),2)
  6113. 30670            ENDIF
  6114. 30675  IF KPS=3  THEN  MX$=KOM$(RFZ(RFXP-1,1)) 
  6115. 30680  IF KPS=4  THEN  MX$=RFN$(RFXP-1)
  6116. 30685  IF KPS=5  THEN  MX$=STR$(RFK&(RFXP-1))
  6117. 30690  IF KPS=6  THEN  MX$=STR$(ABS(RFS%(RFXP-1)))
  6118. 30695  RETURN
  6119. 30700 '
  6120. 30705 *KMX_SET5
  6121. 30710  IF KPS=2  THEN  GOSUB *RSET_MDX
  6122. 30715  IF KPS=3  THEN  IF KPJ>=0 THEN RFZ(RFXP-1,1)=KPJ
  6123. 30720  IF KPS=4  THEN  RFN$(RFXP-1)=MX$
  6124. 30725  IF KPS=5  THEN  RFK&(RFXP-1)=VAL(MX$)
  6125. 30730  IF KPS=6  THEN  RFS%(RFXP-1)=VAL(MX$)
  6126. 30735  IF RJK(RFXP-1,KPS-1)=0 THEN RJK(RFXP-1,KPS-1)=1
  6127. 30740  IF RJK(RFXP-1,0)=0     THEN RJK(RFXP-1,0)=6
  6128. 30745  RETURN
  6129. 30750 '
  6130. 30755 *CRD_NSET5
  6131. 30760  IF KPS=1 THEN  BLEN=4*8  :MUX=MPXL+5+BLEN  :NLEN=7
  6132. 30765  IF KPS=2 THEN  BLEN=11*8 :MUX=MPXL+5+BLEN  :NLEN=RKML+1
  6133. 30770  IF KPS=3 THEN  BLEN=(RKML+12)*8      :MUX=MPXL+BLEN+5  :NLEN=RSX+1
  6134. 30775  IF KPS=4 THEN  BLEN=(RKML+RSX+13)*8  :MUX=MPXL+BLEN+5  :NLEN=13
  6135. 30780  IF KPS=5 THEN  BLEN=(RKML+RSX+26)*8  :MUX=MPXL+BLEN+5  :NLEN=7
  6136. 30785  IF KPS>5 THEN  RVX=0 :MUX=MPXL+4*8+5 :MUY=CRYF+20      :NLEN=7
  6137. 30790  IF MUX>MPXF-16-NLEN*8+RVX THEN  RVX=RVX+NLEN*8
  6138. 30795  IF MUX<MPXL+5  THEN  MUX=MPXL+20
  6139. 30800  IF MUY>MPYF-32 THEN  CSP5=CSP5+1  :MUY=MUY-20
  6140. 30805  MUX=MUX-RVX
  6141. 30810  RETURN
  6142. 30815 '
  6143. 30820 *GET_CORD5
  6144. 30825  INTERVAL OFF  :MOUSE 5
  6145. 30830  REF_SW=1      :CRXF_S=CRXF     :CRYF_S=CRYF   :GET_ON=0
  6146. 30835  A=NP(NEXP-1)  :GOSUB *SWAP_XY  :MUX_Q=MUX     :MUY_Q=MUY
  6147. 30840  GOSUB *CORD_P
  6148. 30845  A=NP(NEXP-1)  :GOSUB *SWAP_XY
  6149. 30850  GOSUB *SCR_BACK
  6150. 30855  GOSUB *SET_XYD
  6151. 30860  INTERVAL ON   :TIMX$=""   :GOSUB *CLOCK_P
  6152. 30865  REW_X=PXE%(4) :REW_Y=PYE%(4) :JP=9
  6153. 30870  IF GET_ON=1 THEN
  6154. 30875                   MX$=CODN$
  6155. 30880                   RFK&(RFXP-1)=CODX
  6156. 30885                   IF RJK(RFXP-1,4)=0 THEN RJK(RFXP-1,4)=1
  6157. 30890              ENDIF
  6158. 30895  INK_END=0   :CAR_END=1   :REF_SW=0
  6159. 30900  CRXF=CRXF_S :CRYF=CRYF_S :MUX=MUX_Q :MUY=MUY_Q
  6160. 30905  MOUSE 0 :MOUSE 1,MUX,MUY,1
  6161. 30910  WHILE MOUSE(2,0)=-1      :WEND
  6162. 30915  RETURN
  6163. 30920 '
  6164. 30925 *RSET_MDX
  6165. 30930  A=INSTR(MX$,"/")
  6166. 30935  IF A=0 THEN RETURN
  6167. 30940  M=VAL(LEFT$(MX$,A-1))  :IF M=0 THEN RFZ(RFXP-1,0)=0 :RETURN
  6168. 30945  D=VAL(MID$(MX$,A+1))   :IF D=0 THEN RFZ(RFXP-1,0)=0 :RETURN
  6169. 30950  PDXS=PDX
  6170. 30955  GOSUB *PDX_SET
  6171. 30960  RFZ(RFXP-1,0)=PDX+1
  6172. 30965  PDX=PDXS
  6173. 30970  RETURN
  6174. 30975  '
  6175. 30980 *RFJ_EXE
  6176. 30985  WHILE MOUSE(2,0)=-1  :WEND
  6177. 30990  GOSUB *CRD_SET5  :IF ER=1 THEN ER=0 :GOTO 31060
  6178. 30995  GOSUB *CRP_SET5  :XLP=LEN(MX$)  :CRB=BCL(10)
  6179. 31000  GOSUB *KEY_CR
  6180. 31005               INTERVAL OFF   :KPJ=RJK(RFXP-1,KPS-1)
  6181. 31010               GOSUB *KMJ_IP  :JP=9
  6182. 31015               INTERVAL ON    :TIMX$=""  :GOSUB *CLOCK_P
  6183. 31020               IF ER=0 THEN INK_END=0    :CAR_END=1      ELSE 31065
  6184. 31025  '
  6185. 31030  IF INK_END=0 THEN
  6186. 31035                    RJK(RFXP-1,KPS-1)=KPJ    :GOSUB *KEY_CR
  6187. 31040                    IF CAR_END=1 THEN  GOSUB *CRD_NSET5
  6188. 31045                    GOSUB *BOLD_BACK
  6189. 31050                    GOTO  *BSCR_P5B
  6190. 31055               ENDIF
  6191. 31060  MOUSE 5
  6192. 31065  RVX=VXP  :GOSUB *SCR_BACK
  6193. 31070  RETURN
  6194. 31075 '
  6195. 31080 *KILL_P5
  6196. 31085  IF RFXP>=RMAX  THEN 31130
  6197. 31090  FOR A=RFXP-1 TO RMAX-2
  6198. 31095      SWAP RJK(A,0),RJK(A+1,0)
  6199. 31100      SWAP RJK(A,1),RJK(A+1,1)  :SWAP RFZ(A,0),RFZ(A+1,0)
  6200. 31105      SWAP RJK(A,2),RJK(A+1,2)  :SWAP RFZ(A,1),RFZ(A+1,1)
  6201. 31110      SWAP RJK(A,3),RJK(A+1,3)  :SWAP RFN$(A) ,RFN$(A+1)
  6202. 31115      SWAP RJK(A,4),RJK(A+1,4)  :SWAP RFK&(A) ,RFK&(A+1)
  6203. 31120      SWAP RJK(A,5),RJK(A+1,5)  :SWAP RFS%(A) ,RFS%(A+1)
  6204. 31125  NEXT A
  6205. 31130  IF RMAX>0 THEN RMAX=RMAX-1
  6206. 31135  RETURN
  6207. 31140 '
  6208. 31145 *REF_P
  6209. 31150  IF RMAX=0 THEN RETURN
  6210. 31155  RZMX=0
  6211. 31160  FOR A=0 TO 365
  6212. 31165      RZMX=RZMX+KMAX(A)
  6213. 31170  NEXT A
  6214. 31175  IF RZMX=0 THEN RETURN
  6215. 31180  ERASE  RFD      ,RFP
  6216. 31185  DIM    RFD(RZMX),RFP(RZMX)
  6217. 31190  RMAXS=RMAX  :RMAX=0  :CSP5S=CSP5  :CSP5=1  :PDXS=PDX
  6218. 31195  D=0  :E=365
  6219. 31200  FOR A=D TO E
  6220. 31205      X=KMAX(A)
  6221. 31210      IF X>0 THEN
  6222. 31215         FOR B=0 TO X-1
  6223. 31220             FOR C=1 TO RMAXS
  6224. 31225                 IF RFZ(C-1,0)-1>A THEN IF RJK(C-1,1)=1 OR RJK(C-1,1)=3                                            THEN D=RFZ(C-1,0)-1 :GOTO 31200
  6225. 31230                 IF RFZ(C-1,0)>0   THEN T=0 :GOSUB *CMP_P1   :                                                           IF CMP=0 THEN *NEXT_C
  6226. 31235                 IF RFZ(C-1,1)>0   THEN T=0 :GOSUB *CMP_P2   :                                                           IF CMP=0 THEN *NEXT_C
  6227. 31240                 IF RFN$(C-1)<>""  THEN T=1 :GOSUB *CMP_P3   :                                                           IF CMP=0 THEN *NEXT_C
  6228. 31245                 IF RFK&(C-1)<>0   THEN T=0 :GOSUB *CMP_P4   :                                                           IF CMP=0 THEN *NEXT_C
  6229. 31250                 IF RFS%(C-1)>0    THEN T=0 :GOSUB *CMP_P5   :                                                           IF CMP=0 THEN *NEXT_C
  6230. 31255                 IF RJK(C-1,0)=6 AND CMP=1 THEN GOSUB *COMP_X :                                                             GOTO  *NEXT_B
  6231. 31260      *NEXT_C
  6232. 31265                 IF RJK(C-1,0)=7 AND CMP=0 THEN *NEXT_B
  6233. 31270            NEXT C
  6234. 31275      *NEXT_B
  6235. 31280            NEXT B
  6236. 31285      ENDIF
  6237. 31290  NEXT A
  6238. 31295  RETURN
  6239. 31300  '
  6240. 31305 *CMP_P1
  6241. 31310  A$=STR$(RFZ(C-1,0)-1) :B$=STR$(A)         :F=RJK(C-1,1)
  6242. 31315  GOSUB *COMP1
  6243. 31320  RETURN
  6244. 31325  '
  6245. 31330 *CMP_P2
  6246. 31335  A$=STR$(RFZ(C-1,1))   :B$=STR$(KMI%(A,B)) :F=RJK(C-1,2)
  6247. 31340  GOSUB *COMP1
  6248. 31345  RETURN
  6249. 31350  '
  6250. 31355 *CMP_P3
  6251. 31360  A$=RFN$(C-1)          :B$=KNE$(A,B)       :F=RJK(C-1,3)
  6252. 31365  GOSUB *COMP1
  6253. 31370  RETURN
  6254. 31375  '
  6255. 31380 *CMP_P4
  6256. 31385  A$=STR$(RFK&(C-1))    :B$=STR$(KIN&(A,B)) :F=RJK(C-1,4)
  6257. 31390  GOSUB *COMP1
  6258. 31395  RETURN
  6259. 31400  '
  6260. 31405 *CMP_P5
  6261. 31410  A$=STR$(RFS%(C-1))    :B$=STR$(KSU%(A,B)) :F=RJK(C-1,5)
  6262. 31415  GOSUB *COMP1
  6263. 31420  RETURN
  6264. 31425  '
  6265. 31430 *COMP1
  6266. 31435  CMP=0
  6267. 31440  ON F GOSUB *COMP1A,*COMP2A,*COMP3A,*COMP4A,*COMP5A
  6268. 31445  RETURN
  6269. 31450  '
  6270. 31455 *COMP1A
  6271. 31460  IF T=0 THEN IF A$=B$ THEN CMP=1
  6272. 31465  IF T=1 THEN IF INSTR(B$,A$)>0 THEN CMP=1
  6273. 31470  RETURN
  6274. 31475  '
  6275. 31480 *COMP2A
  6276. 31485  IF A$<>B$ THEN CMP=1
  6277. 31490  RETURN
  6278. 31495  '
  6279. 31500 *COMP3A
  6280. 31505  IF T=0 THEN IF VAL(A$)=<VAL(B$) THEN CMP=1
  6281. 31510  IF T=1 THEN IF A$=<B$ THEN CMP=1
  6282. 31515  RETURN
  6283. 31520  '
  6284. 31525 *COMP4A
  6285. 31530  IF T=0 THEN IF VAL(A$)>=VAL(B$) THEN CMP=1
  6286. 31535  IF T=1 THEN IF A$>=B$ THEN CMP=1
  6287. 31540  RETURN
  6288. 31545  '
  6289. 31550 *COMP5A
  6290. 31555  IF T=0 THEN IF VAL(A$)>VAL(B$)  THEN CMP=1
  6291. 31560  IF T=1 THEN IF A$>B$  THEN CMP=1
  6292. 31565  RETURN
  6293. 31570  '
  6294. 31575 *COMP_X
  6295. 31580  RFD(RMAX)=A  :RFP(RMAX)=B
  6296. 31585  RMAX=RMAX+1
  6297. 31590  RETURN
  6298. 31595 '
  6299. 31600 *RFD_GET
  6300. 31605  PDX=RFD(RFXP-1)
  6301. 31610  P=PDX  :GOSUB *SET_MDX
  6302. 31615  RXM=M  :RXD=U  :CSP6=RFP(RFXP-1)+1
  6303. 31620  MOUSE 1,,,0
  6304. 31625  GOSUB *SCR_BACK
  6305. 31630  MOUSE 1,,,1
  6306. 31635  RETURN
  6307. 31640  '
  6308. 31645 '-------------------------------------------------------------------
  6309. 31650 *KMJ_IP
  6310. 31655  X1=MPXL       :Y1=MPYL        :X2=MPXF        :Y2=MPYF
  6311. 31660  A=9           :GOSUB *SWAP_XY
  6312. 31665  MPXL=PXL%(12) :MPYL=PYL%(12)  :MPXE=PXE%(12)  :MPYE=PYE%(12)
  6313. 31670  GOSUB *OPEN_P2
  6314. 31675  BCL(1)=BCL(18) :BCL(9)=BCL(19) :GET_ON=0
  6315. 31680  REW_X=PXE%(12) :REW_Y=PYE%(12) :BDP=14 :BPQ=0 :MUX_S=MUX :MUY_S=MUY
  6316. 31685  GOSUB *BOLD_P
  6317. 31690  GOSUB *SET_XYD
  6318. 31695  GOSUB *SEL_MXY
  6319. 31700  IF ER=1 THEN 31730
  6320. 31705  IF VAL(K$)>0 AND VAL(K$)=<KOJ THEN  P=VAL(K$)  :KPJ=P  :                                                      MX$=KOM$(P)  :GOTO 31730
  6321. 31710  IF JP=1 THEN  ER=1
  6322. 31715  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*YL_DOWN5J,*YL_UP5J,*XL_RIGHT5J,                      *XL_LEFT5J,*DRAG_B,*BSCR_P5J,*CSL_S5J,*RET_W,*RET_W
  6323. 31720  IF JP<>1 THEN 31695
  6324. 31725  NEXP=NEXP+1
  6325. 31730  GOSUB *CLOSE_P2
  6326. 31735  PXL%(12)=MPXL :PYL%(12)=MPYL :PXE%(12)=MPXE :PYE%(12)=MPYE
  6327. 31740  A=9  :GOSUB *SWAP_XY   :MUX=MUX_S  :MUY=MUY_S
  6328. 31745  GOSUB *SET_XYD
  6329. 31750  MOUSE 0    :MOUSE 1,MUX,MUY,1      :INK_END=1
  6330. 31755  RETURN
  6331. 31760 '
  6332. 31765 *BD_14P
  6333. 31770  FILS$="[条件選択]"
  6334. 31775  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  6335. 31780  VIEW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(2),%BCL(0)
  6336. 31785  XL=MPXL+25  :YL=MPYL+20
  6337. 31790  FOR A=KMCJ TO  KOJ
  6338. 31795      SYMBOL(XL-(LEN(STR$(A))+1)*8,YL),STR$(A)+".",1,1,%BCL(0)
  6339. 31800      IF KPJ=A THEN CL=BCL(8)   ELSE CL=BCL(0)
  6340. 31805      SYMBOL(XL,YL),JOK$(A-1),1,1,%CL
  6341. 31810      YL=YL+18
  6342. 31815      IF YL>MPYF-32 THEN 31825
  6343. 31820  NEXT A
  6344. 31825  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  6345. 31830  GOSUB *CASOL_P5J  :GOSUB *CASOL_P5JB
  6346. 31835  RETURN
  6347. 31840 '
  6348. 31845 *SET_JOK
  6349. 31850  RESTORE *JOK_DAT
  6350. 31855  READ KOJ
  6351. 31860  FOR A=0 TO KOJ-1
  6352. 31865      READ JOK$(A)
  6353. 31870  NEXT A
  6354. 31875  RETURN
  6355. 31880  '
  6356. 31885 *JOK_DAT
  6357. 31890  DATA 7,一致,以外,以上,以下,未満,"と (or line)","で (and line)"
  6358. 31895  '
  6359. 31900 *YL_DOWN5J
  6360. 31905  KMCJ=KMCJ+1
  6361. 31910  IF KMCJ>KOJ THEN KMCJ=KOJ
  6362. 31915  GOSUB *BD_SUBP
  6363. 31920  RETURN
  6364. 31925  '
  6365. 31930 *YL_UP5J
  6366. 31935  KMCJ=KMCJ-1
  6367. 31940  IF KMCJ<1 THEN KMCJ=1
  6368. 31945  GOSUB *BD_SUBP
  6369. 31950  RETURN
  6370. 31955 '
  6371. 31960 *XL_RIGHT5J
  6372. 31965  L=INT((MPYE-71)/18)+1
  6373. 31970  KMCJ=KMCJ+L
  6374. 31975  IF KMCJ>KOJ THEN KMCJ=KMCJ-L
  6375. 31980  GOSUB *BD_SUBP
  6376. 31985  RETURN
  6377. 31990 '
  6378. 31995 *XL_LEFT5J
  6379. 32000  L=INT((MPYE-71)/18)+1
  6380. 32005  KMCJ=KMCJ-L
  6381. 32010  IF KMCJ<1 THEN KMCJ=1
  6382. 32015  GOSUB *BD_SUBP
  6383. 32020  RETURN
  6384. 32025 '
  6385. 32030 *CASOL_P5J
  6386. 32035  A=KOJ :B=KMCJ
  6387. 32040  GOSUB *CASOL_PX1
  6388. 32045  RETURN
  6389. 32050 '
  6390. 32055 *CASOL_P5JB
  6391. 32060  A=MPXE-80 :B=((MPXE-80)/KOJ)*(KMCJ-1)
  6392. 32065  GOSUB *CASOL_PX2
  6393. 32070  RETURN
  6394. 32075 '
  6395. 32080 *CSL_S5J
  6396. 32085  IF KOJ=0 THEN GOSUB *RET_W :RETURN
  6397. 32090  A=KOJ
  6398. 32095  GOSUB *ｶｰｿﾙ_SET1
  6399. 32100  KMCJ=P
  6400. 32105  GOSUB *BD_SUBP
  6401. 32110  RETURN
  6402. 32115 '
  6403. 32120 *BSCR_P5J
  6404. 32125  YL=INT((MUY-MPYL-20)/18)
  6405. 32130  P=YL+KMCJ
  6406. 32135  IF YL<0  THEN 32155
  6407. 32140  IF P>KOJ THEN 32155
  6408. 32145  KPJ=P  :MX$=JOK$(P)  :GET_ON=1
  6409. 32150  JP=1   :NEXP=NEXP-1
  6410. 32155  WHILE MOUSE(2,0)=-1  :WEND
  6411. 32160  RETURN
  6412. 32165 '
  6413. 32170 '--------------------------------------------------------------------
  6414. 32175 *ERR_MESE
  6415. 32180  GOSUB *ERR_DSET   :GOSUB *ERMD_SET
  6416. 32185  IF ERP=1 THEN ERM$(2)=AKCNV$(STR$(ERL))+"行 "+AKCNV$(STR$(ERR))+                                   "番エラー"  :ERC(2)=0  :ERMX=3
  6417. 32190  GOSUB *MESSAGE_P
  6418. 32195  IF ERP=1    THEN  END
  6419. 32200  IF MESJ=1   THEN  RESUME
  6420. 32205  ON ERROR GOTO 0
  6421. 32210  IF ERL>=325   AND ERL=<350   THEN        RESUME *MSL_EBAK2
  6422. 32215  IF ERL>=470   AND ERL=<490   THEN  ER=1 :RESUME *MSS_EBAK
  6423. 32220  IF ERL>=865   AND ERL=<890   THEN        RESUME *ENDL_RET
  6424. 32225  IF ERL>=1040  AND ERL=<1065  THEN        RESUME *ENDS_RET
  6425. 32230  IF ERL>=5130  AND ERL=<5175  THEN        RESUME *FNLOAD_RET
  6426. 32235  IF ERL>=5250  AND ERL=<5270  THEN        RESUME *FNSAVE_RET
  6427. 32240  IF ERL>=5625  AND ERL=<5680  THEN        RESUME *LERR_BACK
  6428. 32245  IF ERL>=5775  AND ERL=<5830  THEN  ER=1 :RESUME *SERR_BACK
  6429. 32250  IF ERL>=5970  AND ERL=<5995  THEN        RESUME *CLOAD_RET
  6430. 32255  IF ERL>=6070  AND ERL=<6090  THEN        RESUME *CSAVE_RET
  6431. 32260  IF ERL>=8290  AND ERL=<8320  THEN        RESUME *CLIN_RET
  6432. 32265  IF ERL>=8395  AND ERL=<8420  THEN        RESUME *CSNO_RET
  6433. 32270  IF ERL>=10155 AND ERL=<10185 THEN        RESUME *EDSV_RET
  6434. 32275  IF ERL>=10290 AND ERL=<10375 THEN        RESUME *EDSV_RET2
  6435. 32280  IF ERL>=11140 AND ERL=<11165 THEN        RESUME *KLOAD_RET
  6436. 32285  IF ERL>=11240 AND ERL=<11260 THEN        RESUME *KSAVE_RET
  6437. 32290  IF ERL>=19040 AND ERL=<19070 THEN        RESUME *BNLOAD_RET
  6438. 32295  IF ERL>=19145 AND ERL=<19170 THEN        RESUME *BNSAVE_RET
  6439. 32300  IF ERL>=19255 AND ERL=<19295 THEN        RESUME *BLOAD_RET
  6440. 32305  IF ERL>=19385 AND ERL=<19420 THEN        RESUME *BSAVE_RET
  6441. 32310  IF ERL>=20170 AND ERL=<20210 THEN        RESUME *TLOAD_RET
  6442. 32315  IF ERL>=20300 AND ERL=<20335 THEN        RESUME *TSAVE_RET
  6443. 32320  IF ERL>=21605 AND ERL=<21620 THEN        RESUME *MLOAD_RET
  6444. 32325  IF ERL>=21705 AND ERL=<21730 THEN        RESUME *MSAVE_RET
  6445. 32330  IF ERL>=28970 AND ERL=<28985 THEN        RESUME *LBCL_RET
  6446. 32335  IF ERL>=29055 AND ERL=<29065 THEN        RESUME *SBCL_RET
  6447. 32340  END
  6448. 32345 '
  6449. 32350 *ERR_DSET
  6450. 32355  IF ERR=63 THEN RESTORE *FIL_L_ERR   :RETURN
  6451. 32360  IF ERR=64 THEN RESTORE *FIL_S_ERR   :RETURN
  6452. 32365  IF ERR=60 THEN RESTORE *DISK_ERR    :RETURN
  6453. 32370  IF ERR=55 THEN RESTORE *FIL_N_ERR   :RETURN
  6454. 32375  IF ERR=54 THEN RESTORE *FIL_E_ERR   :RETURN
  6455. 32380  IF ERR=53 THEN RESTORE *DRIV_ERR    :RETURN
  6456. 32385  IF ERR=65 THEN RESTORE *DISK_FLL    :RETURN
  6457. 32390  IF ERR=67 THEN RESTORE *DISK_FLL    :RETURN
  6458. 32395  IF ERR=72 THEN RESTORE *DISK_ERR    :RETURN
  6459. 32400  IF ERR=73 THEN RESTORE *FIL_P1_ERR  :RETURN
  6460. 32405  IF ERR=75 THEN RESTORE *FIL_P2_ERR  :RETURN
  6461. 32410  '
  6462. 32415   RESTORE *END_ERR
  6463. 32420   ERP=1
  6464. 32425   RETURN
  6465. 32430 '
  6466. 32435 *FIL_L_ERR    :'load err
  6467. 32440  DATA 1
  6468. 32445  DATA "指定されたファイルが有りません",0
  6469. 32450 '
  6470. 32455 *FIL_S_ERR    :'save err
  6471. 32460  DATA 1
  6472. 32465  DATA "指定のファイルは既に存在しています",0
  6473. 32470 '
  6474. 32475 *DISK_ERR    :'disk access err
  6475. 32480  DATA 1
  6476. 32485  DATA "指定の入出力装置は使用できません",0
  6477. 32490 '
  6478. 32495 *FIL_N_ERR
  6479. 32500  DATA 1
  6480. 32505  DATA "ファイルの記述に誤りがあります",0
  6481. 32510 '
  6482. 32515 *FIL_E_ERR
  6483. 32520  DATA 1
  6484. 32525  DATA "読み込むデータが有りません",0
  6485. 32530 '
  6486. 32535 *DRIV_ERR
  6487. 32540  DATA 1
  6488. 32545  DATA "入出力装置に異常が発生しました",0
  6489. 32550 '
  6490. 32555 *DISK_FLL
  6491. 32560  DATA 1
  6492. 32565  DATA "ディスクに空き領域が有りません",0
  6493. 32570 '
  6494. 32575 *FIL_P1_ERR
  6495. 32580  DATA 1
  6496. 32585  DATA "指定されたディスクは書き込みが禁止されています",0
  6497. 32590 '
  6498. 32595 *FIL_P2_ERR
  6499. 32600  DATA 1
  6500. 32605  DATA "デバイスまたはファイルのアクセスが拒否されました",0
  6501. 32610 '  
  6502. 32615 *END_ERR
  6503. 32620  DATA 2
  6504. 32625  DATA "継続不能のエラーが発生しました",0
  6505. 32630  DATA "プログラムを再起動して下さい",0
  6506. 32635 '-------------------------------------------------------------------
  6507. 32640 *FAST_MESE
  6508. 32645  A=9 :GOSUB *SWAP_XY
  6509. 32650  MPXL=200   :MPYL=180    :MPXE=210    :MPYE=100
  6510. 32655  BCL(0)=0   :BCL(2)=255  :BCL(4)=113  :BCL(6)=4    :BCL(12)=182
  6511. 32660  BCL(1)=70  :BCL(3)=179  :BCL(5)=218  :BCL(9)=255  :BCL(17)=142
  6512. 32662  BCL(18)=70 :BCL(19)=255
  6513. 32665  REW_X=200  :REW_Y=200   :BDP=15      :YM$=DATE$   :NEXP=NEXP+1
  6514. 32670  GOSUB *BOLD_P           :GOSUB *LOAD_MOUSE_DAT
  6515. 32675  GOSUB *SET_CALKTIF      :GOSUB *SET_BCL
  6516. 32680  GOSUB *CORD_LOAD        :GOSUB *KOMOK_LOAD       :GOSUB *FILN_LOAD
  6517. 32685  GOSUB *BNAME_LOAD       :GOSUB *YOBID_SET        :GOSUB *SET_JOK
  6518. 32690  GOSUB *SET_UPFIL        :GOSUB *END_LOAD
  6519. 32695  RETURN
  6520. 32700  '
  6521. 32705 *BD_15P
  6522. 32710  FILS$=VAR$
  6523. 32715  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  6524. 32720  VIEW   (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%255,%0
  6525. 32725  SYMBOL(MPXL+50,MPYL+20),"[初期設定中]",1,1,%0
  6526. 32730  A$="しばらくお待ち下さい"
  6527. 32735  SYMBOL(MPXL+20,MPYL+40),A$,1,1,%0
  6528. 32740  LINE (MPXL+20,MPYL+40)-STEP(LEN(A$)*8,16),XOR,%250,BF
  6529. 32745  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  6530. 32750  RETURN
  6531. 32755  '------------------------------------------------------------------
  6532. 32760 *END_MESE
  6533. 32765  A=9 :GOSUB *SWAP_XY
  6534. 32770  MPXL=200   :MPYL=180    :MPXE=290   :MPYE=120
  6535. 32775  BCL(1)=BCL(18)   :BCL(9)=BCL(19)    :NEXP=NEXP+1
  6536. 32780  REW_X=200  :REW_Y=200   :BDP=16     :BPQ=0
  6537. 32785  GOSUB *BOLD_P
  6538. 32790  GOSUB *SET_XYD
  6539. 32795  GOSUB *SEL_MXY
  6540. 32800  IF ER=1 THEN MJ=0  :NEXP=NEXP-1 :GOTO 32815
  6541. 32805  ON JP GOSUB *RET_P,*REW_P,*DRAG_A,*RET,*RET,*RET,*RET,*DRAG_B,                          *BSCR_EP,*RET_W
  6542. 32810  IF JP<>1 THEN 32795
  6543. 32815  A=9 :GOSUB *SWAP_XY
  6544. 32820  RETURN
  6545. 32825 '
  6546. 32830 *BD_16P
  6547. 32835  FILS$="終了メッセージ"
  6548. 32840  WINDOW (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17)
  6549. 32845  VIEW   (MPXL+1,MPYL+17)-(MPXF-17,MPYF-17),%BCL(19),%BCL(0)
  6550. 32850  SYMBOL(MPXL+60,MPYL+25),"家計簿を終了します",1,1,%BCL(0)
  6551. 32855  IF EXPS=1 THEN
  6552. 32860     SYMBOL(MPXL+10,MPYL+50),"家計簿の内容が書換えられています",                                       1,1,%BCL(15)
  6553. 32865            ENDIF
  6554. 32870  SYMBOL(MPXL+30,MPYL+85) ,"[終了]",1,1,%BCL(0)
  6555. 32875  SYMBOL(MPXL+200,MPYL+85),"[取消]",1,1,%BCL(0)
  6556. 32880  WINDOW (0,0)-(639,479)  :VIEW (0,0)-(639,479)
  6557. 32885  RETURN
  6558. 32890 '
  6559. 32895 *BSCR_EP
  6560. 32900  IF MUY>MPYL+85 AND MUY<MPYL+103 THEN
  6561. 32905        IF MUX>MPXL+30  AND MUX<MPXL+78  THEN JP=1 :MJ=1 :NEXP=NEXP-1
  6562. 32910        IF MUX>MPXL+200 AND MUX<MPXL+248 THEN JP=1 :MJ=0 :NEXP=NEXP-1
  6563. 32915     ENDIF
  6564. 32920  WHILE MOUSE(2,0)=-1  :WEND
  6565. 32925  MOUSE 5
  6566. 32930  RETURN
  6567. 32935  '------------------------------------------------------------------
  6568. 32940 *CNF_INPUT
  6569. 32945  DIM CNF$(100)  :A=0   :ERP=0
  6570. 32950  ON ERROR GOTO *CNF_ERR
  6571. 32955  OPEN "I",#1,"kakeibo.cfg"
  6572. 32960       LINE INPUT #1,CNF$(A)
  6573. 32965       IF EOF(1)=0 THEN A=A+1 :GOTO 32960
  6574. 32970  *CNF_ERR_BAK
  6575. 32975   ON ERROR GOTO 0
  6576. 32980   CLOSE #1
  6577. 32985   RETURN
  6578. 32990  '
  6579. 32995 *CNF_ERR
  6580. 33000  ERP=1
  6581. 33005  RESUME *CNF_ERR_BAK
  6582. 33010  '
  6583. 33015 *CNF_READ
  6584. 33020  RESTORE *CNF_DATA
  6585. 33025  FOR B=0 TO 21
  6586. 33030      READ F$
  6587. 33035      FOR C=0 TO A
  6588. 33040          IF INSTR(CNF$(C),F$)=1 THEN GOSUB *CNF_SET :GOTO 33050
  6589. 33045      NEXT C
  6590. 33050  NEXT B
  6591. 33055  RETURN
  6592. 33060  '
  6593. 33065 *CNF_DATA
  6594. 33070  DATA KF1$    ,BANKF$ ,BANKNF$ ,KAKEIF$ ,CALKF$
  6595. 33075  DATA MOUSEF$ ,ENDF$  ,KOMOKF$ ,CORDF$  ,CORDN$
  6596. 33080  DATA FILNF$  ,MEMOF$ ,BCLF$   ,CALENF$
  6597. 33085  DATA MSX     ,KSZ    ,NSX     ,CDX     ,CDZ
  6598. 33090  DATA BNZ     ,TYZ    ,RJZ
  6599. 33095  '
  6600. 33100 *CNF_SET
  6601. 33105  S=INSTR(CNF$(C),CHR$(&H22))
  6602. 33110  IF LEN(CNF$(C))=S OR S=0 THEN RETURN
  6603. 33115  E=INSTR(S+1,CNF$(C),CHR$(&H22))
  6604. 33120  IF E=0 THEN RETURN     ELSE E=E-S-1
  6605. 33125  B$=MID$(CNF$(C),S+1,E)
  6606. 33130  IF B<14 THEN FIL$(B)=B$    ELSE *CNF_SET2
  6607. 33135  RETURN
  6608. 33140  '
  6609. 33145 *CNF_SET2
  6610. 33150  D=VAL(B$)
  6611. 33155  IF B=14 THEN MSX=D
  6612. 33160  IF B=15 THEN KSZ=D
  6613. 33165  IF B=16 THEN NSX=D
  6614. 33170  IF B=17 THEN CDX=D
  6615. 33175  IF B=18 THEN CDZ=D
  6616. 33180  IF B=19 THEN BNZ=D
  6617. 33185  IF B=20 THEN TYZ=D
  6618. 33190  IF B=21 THEN RJZ=D
  6619. 33195  RETURN
  6620. 33200  '
  6621. 33205 *CNF_SETUP
  6622. 33210  GOSUB *CNF_SETUP2
  6623. 33215  GOSUB *CNF_INPUT
  6624. 33220  IF ERP=0 THEN GOSUB *CNF_READ    ELSE ERP=0
  6625. 33225  ERASE CNF$
  6626. 33230  RETURN
  6627. 33235  '
  6628. 33240 *CNF_SETUP2
  6629. 33245  DIM FIL$(13)
  6630. 33250  FIL$(0)="\kakeibo\kake_scr\kakeibo.tif"
  6631. 33255  FIL$(1)="\kakeibo\bank_fil\"
  6632. 33260  FIL$(2)="\kakeibo\bank_fil\bank_nam.dat"
  6633. 33265  FIL$(3)="\kakeibo\kake_fil\data_fil\"
  6634. 33270  FIL$(4)="\kakeibo\kake_scr\calk_tif.dat"
  6635. 33275  FIL$(5)="\kakeibo\kake_fil\data_fil\mous_set.dat"
  6636. 33280  FIL$(6)="\kakeibo\kake_fil\data_fil\end_fil.dat"
  6637. 33285  FIL$(7)="\kakeibo\kake_fil\komokfil.dat"
  6638. 33290  FIL$(8)="\kakeibo\kake_fil\kakecord.dat"
  6639. 33295  FIL$(9)="\kakeibo\kake_fil\cord_fil\cord_"
  6640. 33300  FIL$(10)="\kakeibo\kake_fil\fil_name.dat"
  6641. 33305  FIL$(11)="\kakeibo\kake_fil\memo_fil\memo_"
  6642. 33310  FIL$(12)="\kakeibo\kake_fil\bcl_fil.dat"
  6643. 33315  FIL$(13)="\kakeibo\kake_scr\calen_mj\calen_"
  6644. 33320  MSX=100 :KSZ=50 :NSX=50 :CDX=99 :CDZ=999 :BNZ=200 :TYZ=200 :RJZ=50
  6645. 33325  RETURN
  6646.