10 'save "mapset0.bas",a '1999/06/12 '1999/07/12(07:23) 20 '-------------------------------------- 30 'qpon@mtd.biglobe.ne.jp 40 'http://www2a.biglobe.ne.jp/~qpon/ 50 '-------------------------------------- 60 dim xy(200,1),dt$(200) 70 console 0,25:width 100,40:color 7,0:cls 80 print :gosub *doc 90 color 7,0 100 locate 10:print "ok=[<┘]";:color 0,7:print " ":yn$=input$(1):color 7,0 110 cls 120 '===================================== 130 *msg 140 color 7,0:cls 150 data "ｲﾒｰｼﾞ ﾌｧｲﾙ","データ 表示／修正／削除","読 込","保 存"," ↓ "," ↑ ","修 正","削 除" 160 restore 150 170 color 0,6 180 read k$:locate 1,0:print using "& &";k$; 190 read k$:locate 12+1,0:print using "& &";k$; 200 color 7,2 210 for i=0 to 1:read k$:locate i*6+1,1:print using "& &";k$;:next i 220 color 7,1 230 for i=2 to 5:read k$:locate (i)*6+1,1:print using "& &";k$;:next i 240 color 7,0 250 console 2,38 260 line(0,28*16)-(100*8,28*16),7 270 locate 1,29:print "・最初にクリッカブルマップを作りたいイメージファイル（bmp形式）を読み込んで下さい。" 280 locate 1,30:print "・クリッカブルマップを作成したら、そのイメージファイル（bmp形式）を保存して下さい。" 290 locate 1,31:print "・イメージファイルの保存が行われると、自動的に対応するHTMLファイル（html/htm形式）と" 300 locate 1,32:print "　データファイル（txt形式）が同じディレクトリにでき上がります。" 310 '-- 320 on mouse(2) gosub *st.menu 330 mouse(2) on 340 yn$=input$(1):goto 340 350 '-------- 360 *st.menu 370 if mouse(1)<16 or mouse(1)>32 then beep:return 380 if mouse(0)>8*1 and mouse(0)<8*6 then *yomikomi 390 beep:return 400 '------ 410 *yomikomi 415 mouse(2) stop 420 locate 40,0:line input "イメージファイル名：";na$; 430 locate 40,0:print string$(50," "); 440 l=instr(na$,".") 450 if l>0 then na$=left$(na$,l-1) 460 if na$="" then 640 470 on error goto *new.load 480 bload na$+".img" ,a(0) 490 on error goto 0 500 return *start 510 '------ 520 *new.load 530 resume 540 540 on error goto 0 550 on error goto *no.img 560 bload na$+".bmp",a(0) 570 bsave na$+".img",a(0) 580 bload na$+".img",a(0) 590 on error goto 0 600 return *start 610 '------ 620 *no.img 630 resume 640 640 beep:locate 40,0:color 2,0:print "イメージファイル「";na$;".bmp」がありません ok=[<┘]";:color 0,7:print " "; 650 color 7,0:yn$=input$(1) 660 locate 40,0:print string$(50," "); 670 on error goto 0:return 680 '================================================= 690 *start 700 cls:iro=3:maru=3 701 locate 1,1:color 7,2:print "色 ●";:locate 3,1:color 7,0:print " "; 710 mouse(2) off 720 dt.n=0:hozon$=na$ 730 gosub *dt.load 731 if iro>7 or iro<0 then iro=3 732 if maru>8 or maru<1 then maru=3 740 xx=int((100*8-a(0))/2):yy=40 750 put@(xx,yy),a(0),pset 760 if dt.n>1 then gosub *new.put:no=dt.n:gosub *dt.print 770 on mouse(2) gosub *point.set 780 on mouse(3) gosub *point.reset 790 '-- 800 *loop 810 if no<1 then no=1 820 if no>dt.n then no=dt.n 830 if no<>pr.no then gosub *dt.print:pr.no=no 840 mouse(2) on 850 mouse(3) on 860 ud$=inkey$ 870 mx=mouse(0)-xx 880 my=mouse(1)-yy 890 if ud$="" then 860 900 if ud$=chr$(30) or ud$=chr$(29) then no=no-1 910 if ud$=chr$(31) or ud$=chr$(28) then no=no+1 920 if ud$=chr$(27) then gosub *me5 922 if ud$=chr$(127) then gosub *me6 930 goto *loop 940 '- 950 *load.error 960 beep:print:print "ファイルがありません ok=[<┘]";:yn$=input$(1) 970 resume 980 980 on error goto 0 990 goto 70 1000 '- 1010 *menu 1020 if mouse(1)<16 or mouse(1)>32 then return 1030 me=int((mx+xx-4)/48)+1:if me>8 then me=5 1040 on me gosub *me1,*me2,*me3,*me4,*me5,*me6 1050 return 1060 '- 1070 *me1 1071 if mouse(0)>28 then gosub *maru else gosub *iro 1080 return 1220 '-- 1230 *me3 1240 ud$=chr$(31):return 900 1250 '- 1260 *me4 1270 ud$=chr$(30):return 900 1280 '-- 1290 *point.set 1300 if my+yy<32 then if my+yy>16 then *menu 1310 if int((my-a(1))/16)=1 then if mx>280 then *me5 1320 if my<0 or my>a(1) then beep:return 1330 if mx<0 or mx>a(0) then beep:return 1340 no=0 1350 for i=1 to dt.n 1360 if (xy(i,0)<(mx+(maru+2)) and xy(i,0)>(mx-(maru+2))) and (xy(i,1)<(my+(maru+2)) and xy(i,1) >(my-(maru+2))) then no=i 1370 next i 1380 if no>0 then beep:goto 1410 1390 dt.n=dt.n+1:xy(dt.n,0)=mx:xy(dt.n,1)=my 1400 no=dt.n 1410 gosub *dt.print:gosub *dt.input 1420 return 1430 '-- 1440 *me5 1443 if dt.n=0 then beep:return 1450 *dt.input 1460 mouse(2) off:mouse(3) off 1470 dt.x=49:dt.y=1:dt.l=80 1480 dm$=dt$(no):gosub *dt.in:dt$(no)=dm$ 1490 mouse(2) on:on mouse(2) gosub *point.set 1500 mouse(3) on:on mouse(3) gosub *point.reset 1510 color 7,0 1520 return 1530 '-- 1540 *dt.in 1550 mouse(2) on:on mouse(2) gosub 1800 1560 dm$=left$( dm$+string$(dt.l," "),dt.l) 1570 pp=0:p=instr(dm$," "):if p>50 then pp=p-50:p=50 1580 if p>50 then pp=pp+1:p=50 1590 if pp>30 then pp=30 1600 if p<1 then p=1:pp=pp-1 1610 if pp<0 then pp=0 1620 color 0,7:locate dt.x,dt.y:print mid$(dm$,pp+1,50) 1630 locate dt.x+p-1,dt.y 1640 color 7,2 1650 print mid$(dm$,p+pp,1) 1660 in$=input$(1) 1670 d$=inkey$:if d$<>"" then 1670 1680 color 0,7 1690 if in$>=" " and in$<chr$(127) then gosub *in.sub:p=p+1 1700 if in$=chr$(8) then gosub *bs.sub:p=p-1 1710 if in$=chr$(127) then gosub *dl.sub 1720 if in$=chr$(28) then p=p+1 1730 if in$=chr$(29) then p=p-1 1740 if in$<>chr$(13) then 1580 1750 mouse(2) off 1760 locate dt.x,dt.y:print mid$(dm$,pp+1,50) 1770 d=instr(dm$," ")-1:if d<0 then d=0 1780 dm$=left$(dm$,d) 1790 return 1800 in$=chr$(13) :return 1680 1810 '-- 1820 *in.sub 1830 l$=left$(dm$,pp+p-1):r$=mid$(dm$,pp+p):dm$=left$(l$+in$+r$,dt.l):return 1840 *bs.sub 1850 if p=1 then dm$=mid$(dm$,2)+" ":return 1860 l$=left$(dm$,pp+p-2):r$=mid$(dm$,pp+p):dm$=left$(l$+r$+" ",dt.l):return 1870 *dl.sub 1880 l$=left$(dm$,pp+p-1):r$=mid$(dm$,pp+p+1):dm$=left$(l$+r$+" ",dt.l):return 1890 '-- 1900 *point.reset 1910 no=0 1920 for i=1 to dt.n 1930 if (xy(i,0)<(mx+maru) and xy(i,0)>(mx-maru)) and (xy(i,1)<(my+maru) and xy(i,1) >(my-maru)) then no=i 1940 next i 1950 if no=0 then beep:return 1960 gosub *dt.print 1970 '-- 1980 *me6 1985 if dt.n<=0 then beep:return 1986 mouse(2) stop 1990 color 2,7:locate 49,1:print string$(50," "); 2000 color 2,7:locate 49,1:print "削除していいですね？ y/n";:yn$=input$(1) 2005 mouse(2) on 2010 color 7,0:if instr("yY",yn$)>0 then 2030 2020 gosub *dt.print:return 2030 CIRCLE (xy(no,0)+xx,xy(no,1)+yy),maru,0,,,,F,0 2040 dt.n=dt.n-1 2050 for i=no to dt.n 2060 xy(i,0)=xy(i+1,0):xy(i,1)=xy(i+1,1):dt$(i)=dt$(i+1) 2070 next i 2080 dt$(i)="":xy(i,0)=0:xy(i,1)=0 2090 gosub *new.put:no=no-1 2092 gosub *dt.print 2100 return 2110 '- 2111 *maru 2112 maru=maru+1:if maru>8 then maru=1 2113 goto *new.put 2114 '-- 2115 *iro 2116 iro=iro+1:if iro>7 then iro=0 2117 goto *new.put 2118 '-- 2120 *new.put 2130 put@( xx,yy),a(0),pset 2140 for i=1 to dt.n 2150 cr=iro :if i=pr.no then cr=7 xor iro 2160 CIRCLE (xy(i,0)+xx,xy(i,1)+yy),maru,iro,,,,F,cr 2170 next i 2180 return 2190 '- 2200 *dt.print 2220 locate 37,0 2230 print " no| Ｘ| Ｙ| リンク先(href=' '"; 2231 if no=0 then color 7,0:locate 37,1:print string$(62," ");:return 2240 color 0,7 2250 locate 37,1:print using "###";no; 2260 locate 37+4,1:print using "###";xy(no,0); 2270 locate 37+8,1:print using "###";xy(no,1); 2280 locate 37+12,1:print using "& &";dt$(no); 2290 color 7,0 2300 line (37*8,0)-(100*8-1,33),6,b 2310 line (37*8,15)-(100*8-1,15),6 2320 if dno=0 then 2340 2330 CIRCLE (xy(dno,0)+xx,xy(dno,1)+yy),maru,iro,,,,F,iro 2340 CIRCLE (xy(no,0)+xx,xy(no,1)+yy),maru,iro,,,,F,(7 xor iro) 2350 ud$=inkey$:if ud$<>"" then 2350 2360 pr.no=no:dno=no 2370 return 2380 '- 2390 *htm.save 2400 open hozon$+".htm" for output as #1 2410 print #1, "<html>" 2420 print #1,"<head>","<title>mapxyset_test</title>","</head>" 2430 print #1, "<body>" 2440 print #1,"<center>" 2450 print #1,"<h1>"+hozon$+"</h1>" 2460 print #1, "<img src='"+hozon$+".bmp' usemap='#"+hozon$+"'>" 2470 print #1, "<map name='"+hozon$+"'>" 2480 for i=1 to dt.n 2490 dt$=dt$(i):l=instr(dt$," "):if l>2 then dt$=left$(dt$,l-1) 2500 print #1,"<area shape='circle' coords='"+str$(xy(i,0))+","+str$(xy(i,1))+","+str$(maru)+"' href='"+dt$+"'>" 2510 next i 2520 print #1,"</map>" 2530 print #1,"</body>" 2540 print #1,"</html>" 2550 close #1 2560 return 2570 '-- 2580 *map.save 2590 CIRCLE (xy(no,0)+xx,xy(no,1)+yy),maru,iro,,,,F,iro 2600 get@( xx,yy)-(xx+a(0),yy+a(1)),b(0) 2610 bsave hozon$+".bmp",b(0) 2620 return 2630 '- 2640 close #1:beep:print "ファイルがありません ok=[<┘]";:yn$=input$(1) 2650 resume 2660 2660 on error goto 0 2670 return 2680 '-- 2690 *dt.load 2691 dt.n=0 2700 open hozon$+".txt" as #1:close #1 2710 open hozon$+".txt" for input as #1 2715 if eof(1) then close #1:return 2716 input #1,maru 2717 if eof(1) then close #1:return 2718 input #1,iro 2720 '- 2730 if eof(1) then close #1:return 2740 dt.n=dt.n+1:line input #1,a$ 2750 xy(dt.n,0)=val(mid$(a$,1,4)) 2760 xy(dt.n,1)=val(mid$(a$,5,4)) 2770 dt$(dt.n)=mid$(a$,9) 2780 goto 2730 2790 '- 2800 *dt.save 2810 open hozon$+".txt" for output as #1 2811 print #1,maru 2812 print #1,iro 2820 for i=1 to dt.n 2830 print #1,using"### ### ";xy(i,0),xy(i,1); 2840 us$="&"+string$(78," ")+"&" 2850 print #1,using us$;dt$(i) 2860 next i 2870 close #1 2880 return 2890 '- 2900 *end.sub 2910 *me2 2920 'gosub *hozon.na 2930 gosub *map.save 2940 gosub *htm.save 2950 gosub *dt.save 2960 mouse(2) off:mouse(3) off 2970 cls 2980 print "完成しました。" 2990 print "データーファイルは「"+hozon$+".txt」で保存しました。" 3000 print "イメージファイルは「"+hozon$+".bmp」で保存しました。" 3010 print "ＨＴＭＬファイルは「"+hozon$+".htm」で保存しました。" 3020 print "ok=[<┘]"; 3030 color 0,7:print " ";:color 7,0:yn$=input$(1) 3040 system 3050 '-- 3060 *doc 3070 print:restore *doc 3080 read d$:if d$="/" then return 3090 locate 10:print d$:goto 3080 3100 data "＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝操作説明＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝" 3110 data "クリッカブルマップを作るイメージファイルはプログラムファイルmapset0.basと" 3120 data "同じディレクトリ（フォルダー）に置いて下さい。" 3130 data " " 3140 data "マーク設定＝イメージ上の空いた所で左クリック" 3150 data "リンク修正＝マークを左クリックor入力位置又は修正ボタンを左クリックor[ESC]キー" 3160 data "マーク削除＝マークを右クリックor削除ボタンを左クリックor[DEL]キー" 3170 data "データ表示＝[↑][↓]キーを押すor[ ↑ ][ ↓ ]ボタンを左クリック" 3180 data "以前に作ったデータを読込再現＝「読込」ボタンを左クリック" 3190 data "保存＝「保存」ボタンを左クリック" 3200 data " 保存ファイル名は原画のイメージファイル名から拡張子を除いたものを共通に使い" 3201 data " ＨＴＭＬが「*.htm」、イメージが「*.bmp」、データが「*.txt」です" 3205 data "（イメージの原画は「*.bmp」を「*.img」に改名して保存してある、削除しないこと）" 3210 data "＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝" 3220 data "/"