秤のプログラム

　　秤のプログラム shino 2004/02/12 12:45:30 
　　├EXTERNALPICTUREbody shino 2004/02/12 12:50:14 
　　│└EXTERNALSUBttc(ox,oy,n) shino 2004/02/12 12:52:55 
　　│　└EXTERNALSUBsetting shino 2004/02/12 12:56:28 
　　│　　└EXTERNALSUBsetting2 shino 2004/02/12 12:59:11 
　　│　　　└EXTERNALSUBpcheck shino 2004/02/12 13:03:02 
　　│　　　　└FORk=1TO2 shino 2004/02/12 13:04:12 
　　│　　　　　└EXTERNALSUBpcheck2 shino 2004/02/12 13:05:13 
　　│　　　　　　└EXTERNALSUBchanger0(i) shino 2004/02/12 13:06:26 
　　│　　　　　　　└EXTERNALSUBchanger2(i) shino 2004/02/12 13:07:26 
　　│　　　　　　　　└プログラムはここまでです。 shino 2004/02/12 13:28:47 
　　└メニューができ もりの 2004/02/12 19:27:02 
　　　└目盛りが曲がってしまうことは私も気になっ... shino 2004/02/12 22:11:22

　　秤のプログラム shino 2004/02/12 12:45:30  ツリーへ

秤のプログラム 返事を書く

shino 2004/02/12 12:45:30

とりあえず、各種設定を変更できるようにしました。

PUBLIC NUMERIC gs(2),m1,m2,m3,m4,ws,bi,ci,di,rate,c(3,10),cf(3,10),fon(6),loc,c2(3),aa,w
PUBLIC STRING line$(12)
SET COLOR mode "NATIVE"
OPTION ANGLE DEGREES
SET TEXT JUSTIFY "center","half"
DECLARE EXTERNAL PICTURE body,memori,hari,checked,rectangle,sbg,botan
DECLARE EXTERNAL SUB mover,bg,setting,setting2,pcheck,pcheck2,mon,changer0,changer1,changer2,changer3,nus,nut,ttc

LET ws=300 !画面のサイズ
SET bitmap SIZE 2*ws,2*ws
SET WINDOW -ws,ws,-ws,ws

REM 初期化
CALL nus
LET w=0.03125
LET bi=ws/2
LET ci=2*ws/3
CALL nut(0)

CALL pcheck

REM 本体
SET DRAW mode hidden
LET di=90
CALL bg
SET DRAW mode explicit
DO
SET DRAW mode hidden
mouse poll x,y,l,r
IF l=1 AND ABS(x)<bi AND ABS(y)<bi THEN
CALL mover
ELSEIF ABS(0.82*ws-x)<=0.2*ci AND ABS(-0.92*ws-y)<=0.1*ci THEN
CALL ttc(0.82*ws,-0.92*ws,1)
ELSEIF ABS(bi-x)<=0.2*ci AND ABS(-0.92*ws-y)<=0.1*ci THEN
CALL ttc(bi,-0.92*ws,2)
END IF
SET DRAW mode explicit
WAIT DELAY 0.01
loop

END

　　├EXTERNALPICTUREbody shino 2004/02/12 12:50:14  ツリーへ

Re: 秤のプログラム 返事を書く

shino 2004/02/12 12:50:14

EXTERNAL PICTURE body
OPTION ANGLE DEGREES
IF di>90 THEN LET di=di-360
LET dy=0.1*(270+di)
LET i=0
DO
SET AREA COLOR colorindex(0.005*c(1,1)*(0.5*i+0.1*dy),0.005*c(2,1)*(0.5*i+0.1*dy),0.005*c(3,1)*(0.5*i+0.1*dy)) !重りの色
PLOT AREA:-0.5*ci+2*i+dy,1.25*ci-36+dy;-0.5*ci+2*i+dy,1.25*ci+36-dy-2*i;0.5*ci-2*i-dy,1.25*ci+36-dy-2*i;0.5*ci-2*i-dy,1.25*ci-36+dy
SET AREA COLOR colorindex(0.15*i+0.25,0.15*i+0.25,0.15*i+0.25) !支柱の色
PLOT AREA:-0.25*ci+i-10,bi;-0.25*ci-10+i,ci-36+dy;-0.25*ci+10-i,ci-36+dy;-0.25*ci+10-i,bi
PLOT AREA:0.25*ci+i-10,bi;0.25*ci-10+i,ci-36+dy;0.25*ci+10-i,ci-36+dy;0.25*ci+10-i,bi
SET AREA COLOR colorindex(0.005*c(1,2)*i+0.2,0.005*c(2,2)*i+0.2,0.005*c(3,2)*i+0.2) !皿の色
PLOT AREA:-ci+3*i,1.25*ci-36+dy;-bi+i,ci-36+dy+3*i;bi-i,ci-36+dy+3*i;ci-3*i,1.25*ci-36+dy
SET AREA COLOR colorindex(0.005*c(1,3)*i+0.2,0.005*c(2,3)*i+0.2,0.005*c(3,3)*i+0.2) !本体の色
PLOT AREA:-bi+2*i,-bi+2*i;bi-2*i,-bi+2*i;bi-2*i,bi-2*i;-bi+2*i,bi-2*i
SET AREA COLOR colorindex(0.005*c(1,4)*i+0.2,0.005*c(2,4)*i+0.2,0.005*c(3,4)*i+0.2)!土台の色
PLOT AREA:-ci+i,-bi-2*i;-1.25*ci+4*i,-1.25*ci;1.25*ci-4*i,-1.25*ci;ci-i,-bi-2*i
LET i=i+1
LOOP WHILE i<=5
LET i=0
DO
SET AREA COLOR colorindex(i,i,i) !表示板
DRAW disk WITH SCALE(bi-10-2*SIN(90*i))*SHIFT(0,2.5-5*SIN(90*i))
LET i=i+0.2
LOOP WHILE i<=1
SET LINE COLOR colorindex(0,0,0)
PLOT LINES:-1.25*ci,-1.25*ci;1.25*ci,-1.25*ci
PLOT LINES:-ci,1.25*ci-36+dy;ci,1.25*ci-36+dy
LET theta=0
LET dtheta=3600/gs(2)
LET num=0
LET gg=0
SET TEXT COLOR colorindex(0,0,0)
DO
IF fon(4)=1 THEN DRAW memori(ci/10000,1,10) WITH SCALE(bi-10)*ROTATE(-theta-0.5*dtheta) !５の目盛り(５０の目盛り）
IF fon(3)=1 THEN !１０の目盛り(１００の目盛り）
DRAW memori(ci/5000,1,9) WITH SCALE(bi-10)*ROTATE(-theta)
END IF
IF MOD(gg,5)=0 THEN !５０の目盛り(５００の目盛り）
IF fon(2)=1 THEN DRAW memori(ci/2500,1,8) WITH SCALE(bi-10)*ROTATE(-theta)
SET AREA COLOR colorindex(COS(theta),COS(theta),COS(theta))
DRAW disk WITH SCALE(0.06*ci-ci/10000*theta)
END IF
IF MOD(gg,10)=0 THEN !１００の目盛り(１０００の目盛り）
IF fon(1)=1 THEN DRAW memori(ci/2000,2,7) WITH SCALE(bi-10)*ROTATE(-theta)
IF fon(5)=1 THEN PLOT TEXT,AT (0.5*ci)*COS(90-theta),(0.5*ci)*SIN(90-theta):STR$(num)
DRAW hari WITH SCALE(0.5*ci)*ROTATE(di)
LET num=num+100*rate
END IF
LET theta=theta+dtheta
LET gg=gg+1
LOOP WHILE theta<360
END PICTURE

　　│└EXTERNALSUBttc(ox,oy,n) shino 2004/02/12 12:52:55  ツリーへ

Re: EXTERNALPICTUREbody 返事を書く

shino 2004/02/12 12:52:55

EXTERNAL SUB ttc(ox,oy,n)
DRAW botan(0.16,n)
SET DRAW mode explicit
DO
SET DRAW mode hidden
mouse poll x,y,l,r
IF ABS(ox-x)>=0.2*ci OR ABS(oy-y)>=0.1*ci THEN EXIT DO
IF l=1 THEN
SELECT CASE n
CASE 1
STOP
CASE 2
CALL pcheck
CASE ELSE
END SELECT
END IF
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP
DRAW botan(0.2,n)
END SUB

EXTERNAL PICTURE botan(h,n)
FOR i=0 TO 5
IF n=1 THEN DRAW rectangle(0.2*ci-i,0.1*ci-i,0.2*ci-i,0.1*ci-i,colorindex(h*i,h*i,h*i),2) WITH SHIFT(0.82*ws,-0.92*ws)
IF n=2 THEN DRAW rectangle(0.2*ci-i,0.1*ci-i,0.2*ci-i,0.1*ci-i,colorindex(h*i,h*i,h*i),2) WITH SHIFT(bi,-0.92*ws)
NEXT i
SET TEXT COLOR colorindex(0,0,0)
SET TEXT font "",12
PLOT TEXT,AT 0.82*ws,-0.92*ws:"終了"
PLOT TEXT,AT bi,-0.92*ws:"設定"
END PICTURE

EXTERNAL PICTURE memori(ta,lw,mc)
SET LINE COLOR colorindex(w*c(1,mc),w*c(2,mc),w*c(3,mc))
SET LINE width lw
PLOT LINES:0,1;0,1-ta
END picture

EXTERNAL PICTURE hari
SET LINE COLOR colorindex(w*c(1,5),w*c(2,5),w*c(3,5))
SET LINE width 2
SET AREA COLOR colorindex(w*c(1,6),w*c(2,6),w*c(3,6))
PLOT LINES:0,0;1,0
PLOT AREA:1,0;1.1,0.05;1.35,0;1.1,-0.05
SET LINE COLOR colorindex(0,0,0)
SET LINE width 1
END PICTURE

EXTERNAL SUB mover
OPTION ANGLE DEGREES
DO
SET DRAW mode hidden
mouse poll x,y,l,r
LET di=ANGLE(x,y)
IF l=0 THEN EXIT DO
CALL bg
SET DRAW mode explicit
WAIT DELAY 0.03
LOOP
IF m4=0 THEN
LET dtheta=3600/gs(2)
ELSE
LET dtheta=1800/gs(2)
END IF
LET di=90-dtheta*INT((90-di+0.5*dtheta)/dtheta)
CALL bg
END SUB

EXTERNAL SUB bg
OPTION ANGLE DEGREES
CLEAR
DRAW rectangle(ws,ws,ws,ws,colorindex(1,1,1),2)
DRAW body
IF fon(6)=1 THEN
SET TEXT font "",48
SET TEXT COLOR colorindex(0,0,0)
PLOT TEXT,AT 0,-ci:STR$(gs(1)) & "g"
SET TEXT COLOR colorindex(0.025*c(1,4)+0.2,0.025*c(2,4)+0.2,0.025*c(3,4)+0.2)
PLOT TEXT,AT 0,-ci+3:STR$(gs(1)) & "g"
SET TEXT font "",12
END IF
FOR i=0 TO 5
DRAW rectangle(0.2*ci-i,0.1*ci-i,0.2*ci-i,0.1*ci-i,colorindex(0.2*i,0.2*i,0.2*i),2) WITH SHIFT(0.82*ws,-0.92*ws)
DRAW rectangle(0.2*ci-i,0.1*ci-i,0.2*ci-i,0.1*ci-i,colorindex(0.2*i,0.2*i,0.2*i),2) WITH SHIFT(bi,-0.92*ws)
NEXT i
SET TEXT COLOR colorindex(0,0,0)
SET TEXT font "",12
PLOT TEXT,AT 0.82*ws,-0.92*ws:"終了"
PLOT TEXT,AT bi,-0.92*ws:"設定"
END SUB

　　│　└EXTERNALSUBsetting shino 2004/02/12 12:56:28  ツリーへ

Re: EXTERNALSUBttc(ox,oy,n) 返事を書く

shino 2004/02/12 12:56:28

EXTERNAL SUB setting
LET di=0
LET ss=0.8*ws
DRAW rectangle(ws-20,ss,ws-20,ss,colorindex(0.5,0.8,0.6),2)
DRAW rectangle(ws-22,ss-20,ws-22,ss-2,colorindex(1,1,1),2)
SET LINE COLOR colorindex(0.3,0.6,0.4)
PLOT LINES:-ws+20,-ss;ws-20,-ss;ws-20,ss
PLOT LINES:ws-22,ss-20;-ws+22,ss-20;-ws+22,-ss+2
SET TEXT COLOR colorindex(1,1,1)
PLOT TEXT,AT -ws+50,ss-10:"設定"
SET TEXT COLOR colorindex(0,0,0)
DRAW rectangle(0.45*ws,0.45*ws,0.45*ws,0.45*ws,colorindex(0.3,0.3,0.3),1) WITH SHIFT(-0.8*bi,0.5*bi)
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET TEXT font "",24
LET x=-ss
LET cord$="-"
SET LINE COLOR colorindex(0.5,0.5,0.5)
FOR k=1 TO 2
PLOT LINES:-ss+0.2*ci,-0.25*ci-50;ci-ss,-0.25*ci-50
DRAW rectangle(0.1*ci,0.1*ci,0.1*ci,0.1*ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25*ci-50)
PLOT TEXT,AT x,-0.25*ci-50:cord$
LET x=0
LET cord$="+"
NEXT k
SET TEXT font "",12
PLOT TEXT,AT 0.75*ci,ci:"秤の大きさ"
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,bi)
SET TEXT font "",24
PLOT TEXT,AT 0.75*ci,bi:STR$(gs(1)) &"g"
FOR i=1 TO 6
SET LINE COLOR colorindex(0.5,0.5,0.5)
DRAW rectangle(0.05*ci,0.05*ci,0.05*ci,0.05*ci,colorindex(1,1,1),3) WITH SHIFT(0.25*ci,0.5*ci-25*i+20)
SET TEXT font "",12
PLOT TEXT,AT bi,0.5*ci-25*i+20:line$(i+6) & "を表示する"
SET TEXT font "",10
DRAW checked(fon(i)) WITH SHIFT(0.25*ci,0.5*ci-25*i+20)
NEXT i
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5*ci,-ci)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-bi)
PLOT TEXT,AT 0.5*ci,-ci:"OK"
PLOT TEXT,AT ci,-ci:"キャンセル"
PLOT TEXT,AT 0.75*ci,-0.5*ci:"初期設定に戻す"
PLOT TEXT,AT 0.75*ci,-bi:"色の設定"
DRAW rectangle(0.02*ci,0.07*ci,0.02*ci,0.07*ci,colorindex(1,1,1),3) WITH SHIFT(-0.8*ws+0.2*ci+0.008*ci*gs(1)/100,-0.25*ci-50)
SET DRAW mode explicit
SET TEXT font "",12
END SUB

EXTERNAL PICTURE rectangle(x1,y1,x2,y2,col,dtype)
SET AREA COLOR col
SELECT CASE dtype
CASE 1
SET LINE COLOR col
PLOT LINES:x1,y1;x1,-y2;-x2,-y2;-x2,y1;x1,y1
CASE 2
PLOT AREA:x1,y1;x1,-y2;-x2,-y2;-x2,y1
CASE ELSE
PLOT AREA:x1,y1;x1,-y2;-x2,-y2;-x2,y1
PLOT LINES:x1,y1;x1,-y2;-x2,-y2;-x2,y1;x1,y1
END select
END picture

EXTERNAL PICTURE checked(chc)
SET AREA COLOR colorindex(1-chc,1-chc,1-chc)
PLOT AREA:-3,3;0,0;7,5;0,-5
END PICTURE

　　│　　└EXTERNALSUBsetting2 shino 2004/02/12 12:59:11  ツリーへ

Re: EXTERNALSUBsetting 返事を書く

shino 2004/02/12 12:59:11

EXTERNAL SUB setting2
LET di=0
LET ss=0.8*ws
DRAW rectangle(ws-20,ss,ws-20,ss,colorindex(0.5,0.8,0.6),2)
DRAW rectangle(ws-22,ss-20,ws-22,ss-2,colorindex(1,1,1),2)
SET LINE COLOR colorindex(0.3,0.6,0.4)
PLOT LINES:-ws+20,-ss;ws-20,-ss;ws-20,ss
PLOT LINES:ws-22,ss-20;-ws+22,ss-20;-ws+22,-ss+2
SET TEXT COLOR colorindex(1,1,1)
PLOT TEXT,AT -ws+50,ss-10:"設定"
SET TEXT COLOR colorindex(0,0,0)
DRAW rectangle(0.45*ws,0.45*ws,0.45*ws,0.45*ws,colorindex(0.3,0.3,0.3),1) WITH SHIFT(-0.8*bi,0.5*bi)
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET TEXT font "",24
LET x=-ss
LET cord$="-"
SET LINE COLOR colorindex(0.5,0.5,0.5)
FOR k=1 TO 2
FOR i=1 TO 3
DRAW rectangle(0.1*ci,0.1*ci,0.1*ci,0.1*ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25*ci-50*i)
PLOT TEXT,AT x,-0.25*ci-50*i:cord$
IF k=1 THEN DRAW sbg(i,c(i,aa)/32) WITH SHIFT(x+0.1*ci,-0.25*ci-50*i)
NEXT i
LET x=0
LET cord$="+"
NEXT k
SET TEXT font "",12
FOR i=1 TO 10
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(c(1,i)*w,c(2,i)*w,c(3,i)*w),3) WITH SHIFT(ss,ci-25*i+20)
SET LINE COLOR colorindex(0.5,0.5,0.5)
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(1,1,1),3) WITH SHIFT(0.25*ci,ci-25*i+20)
SET TEXT font "",12
PLOT TEXT,AT bi,ci-25*i+20:line$(i) & "の色"
SET TEXT font "",10
PLOT TEXT,AT 0.25*ci,ci-25*i+20:"変更"
NEXT i
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5*ci,-ci)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci)
PLOT TEXT,AT 0.5*ci,-ci:"OK"
PLOT TEXT,AT ci,-ci:"キャンセル"
PLOT TEXT,AT 0.75*ci,-0.5*ci:"初期設定に戻す"
SET DRAW mode explicit
SET TEXT font "",12
FOR k=1 TO 3
FOR i=1 TO 10
LET cf(k,i)=c(k,i)
NEXT i
NEXT k
END SUB

EXTERNAL SUB mon(otype,ss,i,l,code$)
SET LINE COLOR colorindex(0,0,0)
IF l=0 THEN
LET lc=1
ELSE
IF loc>6 THEN LET aa=loc-6
LET lc=0.8
END IF
SELECT CASE otype
CASE 1
IF l=1 THEN CALL changer2(i)
SET TEXT font "",24
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.1*ci,0.1*ci,0.1*ci,0.1*ci,colorindex(lc,lc,lc),3) WITH SHIFT(ss,-0.25*ci-50*i)
PLOT TEXT,AT ss,-0.25*ci-50*i:code$
CASE 2
IF l=1 THEN
FOR k=1 TO 3
DRAW sbg(k,c(k,aa)/32) WITH SHIFT(-0.8*ws+0.1*ci,-0.25*ci-50*k)
NEXT k
END IF
SET TEXT font "",10
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(lc,lc,lc),3) WITH SHIFT(ss,ci-25*i+20)
PLOT TEXT,AT ss,ci-25*i+20:code$
CASE ELSE
END SELECT
SET TEXT font "",12
END sub

　　│　　　└EXTERNALSUBpcheck shino 2004/02/12 13:03:02  ツリーへ

Re: EXTERNALSUBsetting2 返事を書く

shino 2004/02/12 13:03:02

EXTERNAL SUB pcheck
LET mm=1
CALL setting
DO
LET ss=0.8*ws
SET DRAW mode hidden
mouse poll x,y,l,r
SET LINE COLOR colorindex(0.5,0.5,0.5)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5*ci,-ci)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci)
FOR i=1 TO 2
IF ABS(-ci-y)<=20 AND ABS(x-0.5*ci*i)<=0.2*ci THEN
SET TEXT font "",12
SET LINE COLOR colorindex(0,0,0)
IF l=1 AND dd=0 THEN
LET ll=i
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.5*ci*i,-ci)
ELSE
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(0,0,0),1) WITH SHIFT(0.5*ci*i,-ci)
END IF
ELSE
END IF
NEXT i
SET TEXT font "",12
PLOT TEXT,AT 0.5*ci,-ci:"OK"
PLOT TEXT,AT ci,-ci:"キャンセル"
FOR i=0 TO 1
SET LINE COLOR colorindex(0.5,0.5,0.5)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci-0.25*ci*i)
IF ABS(0.75*ci-x)<=0.4*ci AND ABS(-0.5*ci-y-0.25*ci*i)<=20 THEN
SET LINE COLOR colorindex(0,0,0)
IF l=0 THEN
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci-0.25*ci*i)
ELSEIF l=1 THEN
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.75*ci,-0.5*ci-0.25*ci*i)
IF i=0 THEN CALL nus
IF i=1 THEN CALL pcheck2
DRAW rectangle(0.45*ci,15,0.45*ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8*bi,-0.25*ci-50)
PLOT LINES:-ss+0.2*ci,-0.25*ci-50;ci-ss,-0.25*ci-50
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.02*ci,0.07*ci,0.02*ci,0.07*ci,colorindex(1,1,1),3) WITH SHIFT(-0.8*ws+0.2*ci+0.008*ci*gs(1)/100,-0.25*ci-50)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,bi)
SET TEXT font "",24
PLOT TEXT,AT 0.75*ci,bi:STR$(gs(1)) &"g"
SET TEXT font "",12
END IF
END IF
NEXT i
PLOT TEXT,AT 0.75*ci,-0.5*ci:"初期設定に戻す"
PLOT TEXT,AT 0.75*ci,-0.5*ci-0.25*ci:"色の設定"
IF l=0 THEN
IF ll=0 THEN
LET dd=0
ELSEIF ll<3 THEN
EXIT DO
END IF
END IF
LET code$="-"

　　│　　　　└FORk=1TO2 shino 2004/02/12 13:04:12  ツリーへ

Re: EXTERNALSUBpcheck 返事を書く

shino 2004/02/12 13:04:12

FOR k=1 TO 2
IF ABS(-ss-x)<=20 AND ABS(-0.25*ci-50-y)<=20 THEN
LET loc=k
IF l=1 THEN CALL changer0(k)
ELSEIF ABS(-0.8*bi-x)<=0.5*ci AND ABS(-0.25*ci-50-y)<=10 AND l=1 THEN
CALL changer1
ELSE
DRAW rectangle(0.1*ci,0.1*ci,0.1*ci,0.1*ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(-ss,-0.25*ci-50)
END if
LET ss=0
LET code$="+"
NEXT k
FOR i=1 TO 6
DRAW checked(fon(i)) WITH SHIFT(0.25*ci,0.5*ci-25*i+20)
IF ABS(0.25*ci-x)<=0.05*ci AND ABS(0.5*ci-25*i+20-y)<=0.05*ci THEN
LET loc=i+2
IF l=1 AND dd=0 THEN LET ll=2+i
IF l=0 AND ll>=3 THEN
CALL changer0(i)
LET ll=0
END IF
ELSE
DRAW rectangle(0.05*ci,0.05*ci,0.05*ci,0.05*ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(0.25*ci,0.5*ci-25*i+20)
END IF
NEXT i
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP
SELECT CASE ll
CASE 1
CASE 2
CASE ELSE
END select
call bg
END SUB

EXTERNAL PICTURE sbg(co,cc)
FOR k=1 TO 3
IF k=co THEN
LET c2(k)=0.2
ELSE
LET c2(k)=0
END IF
NEXT k
DRAW rectangle(ci,10,0,10,colorindex(0.3,0.3,0.3),2)
IF ci*cc>=6.25 THEN
FOR ii=0 TO 5
DRAW rectangle(ci*cc-ii,10-ii,-ii,10-ii,colorindex(c2(1)*ii,c2(2)*ii,c2(3)*ii),2)
NEXT ii
ELSE
DRAW rectangle(ci*cc,10,0,10,colorindex(c2(1),c2(2),c2(3)),2)
end if
END PICTURE

　　│　　　　　└EXTERNALSUBpcheck2 shino 2004/02/12 13:05:13  ツリーへ

Re: FORk=1TO2 返事を書く

shino 2004/02/12 13:05:13

EXTERNAL SUB pcheck2
LET aa=1
LET dd=1
LET ll=0
CALL setting2
DO
SET DRAW mode hidden
mouse poll x,y,l,r
LET ss=-0.8*ws
SET LINE COLOR colorindex(0.5,0.5,0.5)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5*ci,-ci)
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci)
FOR i=1 TO 2
IF ABS(-ci-y)<=20 AND ABS(x-0.5*ci*i)<=0.2*ci THEN
SET TEXT font "",12
SET LINE COLOR colorindex(0,0,0)
IF l=1 AND dd=0 THEN
LET ll=i
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.5*ci*i,-ci)
ELSE
DRAW rectangle(0.2*ci,20,0.2*ci,20,colorindex(0,0,0),1) WITH SHIFT(0.5*ci*i,-ci)
END IF
ELSE
END IF
NEXT i
SET TEXT font "",12
PLOT TEXT,AT 0.5*ci,-ci:"OK"
PLOT TEXT,AT ci,-ci:"キャンセル"
SET TEXT font "",12
SET LINE COLOR colorindex(0.5,0.5,0.5)
IF ABS(0.75*ci-x)<=0.4*ci AND ABS(-0.5*ci-y)<=20 THEN
SET LINE COLOR colorindex(0,0,0)
IF l=0 THEN
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci)
ELSEIF l=1 THEN
CALL nut(1)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.75*ci,-0.5*ci)
END IF
ELSE
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,-0.5*ci)
END IF
PLOT TEXT,AT 0.75*ci,-0.5*ci:"初期設定に戻す"
IF l=0 THEN
IF ll=0 THEN
LET dd=0
ELSE
EXIT DO
END IF
END IF
LET code$="-"
FOR k=1 TO 2
FOR i=1 TO 3
IF ABS(ss-x)<=20 AND ABS(-0.25*ci-50*i-y)<=20 THEN
LET loc=i+3*k-3
CALL mon(1,ss,i,l,code$)
ELSEIF ABS(-0.8*bi-x)<=0.5*ci AND ABS(-0.25*ci-50*i-y)<=10 AND l=1 THEN
CALL changer3(i)
ELSE
DRAW rectangle(0.1*ci,0.1*ci,0.1*ci,0.1*ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(ss,-0.25*ci-50*i)
END if
NEXT i
LET ss=0
LET code$="+"
NEXT k
FOR i=1 TO 10
IF ABS(0.25*ci-x)<=20 AND ABS(ci-25*i+20-y)<=10 THEN
LET loc=i+6
CALL mon(2,0.25*ci,i,l,"変更")
ELSE
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(0.5,0.5,0.5),1) WITH SHIFT(0.25*ci,ci-25*i+20)
END IF
IF i=aa THEN DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(0.9,0.4,0.4),1) WITH SHIFT(0.25*ci,ci-25*i+20)
NEXT i
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP
SELECT CASE ll
CASE 1
CASE 2
FOR k=1 TO 3
FOR i=1 TO 10
LET c(k,i)=cf(k,i)
NEXT i
NEXT k
CASE ELSE
END select
CALL setting
END sub

　　│　　　　　　└EXTERNALSUBchanger0(i) shino 2004/02/12 13:06:26  ツリーへ

Re: EXTERNALSUBpcheck2 返事を書く

shino 2004/02/12 13:06:26

EXTERNAL SUB changer0(i)
LET ss=0.8*ws
SELECT CASE loc
CASE 1
IF gs(1)>=200 THEN LET gs(1)=gs(1)-100
CASE 2
IF gs(1)<=9900 THEN LET gs(1)=gs(1)+100
CASE ELSE
IF fon(i)=0 THEN
LET fon(i)=1
ELSE
LET fon(i)=0
END IF
END select
IF gs(1)>2000 THEN
LET gs(2)=gs(1)/10
LET rate=10
ELSEIF gs(1)<=200 THEN
LET gs(2)=gs(1)*10
LET rate=0.1
ELSE
LET gs(2)=gs(1)
LET rate=1
END IF
DRAW rectangle(0.45*ci,15,0.45*ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8*bi,-0.25*ci-50)
PLOT LINES:-ss+0.2*ci,-0.25*ci-50;ci-ss,-0.25*ci-50
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.02*ci,0.07*ci,0.02*ci,0.07*ci,colorindex(1,1,1),3) WITH SHIFT(-0.8*ws+0.2*ci+0.008*ci*gs(1)/100,-0.25*ci-50)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,bi)
SET TEXT font "",24
PLOT TEXT,AT 0.75*ci,bi:STR$(gs(1)) &"g"
SET TEXT font "",12
END SUB

EXTERNAL SUB changer1
LET ss=0.8*ws
DO
SET DRAW mode hidden
mouse poll x,y,l,r
IF ABS(-0.8*bi-x)<=0.4*ci THEN
IF x+ss-0.2*ci>0 AND x>-ss+0.2*ci+1 AND x<-0.2*ci THEN LET gs(1)=100*INT((x+ss-0.2*ci)*100/(0.008*ci*100)+0.5)
IF gs(1)>2000 THEN
LET gs(2)=gs(1)/10
LET rate=10
ELSEIF gs(1)<=200 THEN
LET gs(2)=gs(1)*10
LET rate=0.1
ELSE
LET gs(2)=gs(1)
LET rate=1
END IF
DRAW rectangle(0.45*ci,15,0.45*ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8*bi,-0.25*ci-50)
PLOT LINES:-ss+0.2*ci,-0.25*ci-50;ci-ss,-0.25*ci-50
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.02*ci,0.07*ci,0.02*ci,0.07*ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25*ci-50)
DRAW rectangle(0.4*ci,20,0.4*ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75*ci,bi)
SET TEXT font "",24
PLOT TEXT,AT 0.75*ci,bi:STR$(gs(1)) &"g"
SET TEXT font "",12
END IF
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP WHILE l=1
LET gs(1)=100*INT(gs(1)/100)
IF gs(1)>2000 THEN
LET gs(2)= gs(1)/10
LET rate=10
ELSEIF gs(1)<=200 THEN
LET gs(2)=gs(1)*10
LET rate=0.1
ELSE
LET gs(2)=gs(1)
LET rate=1
END IF
END SUB

　　│　　　　　　　└EXTERNALSUBchanger2(i) shino 2004/02/12 13:07:26  ツリーへ

Re: EXTERNALSUBchanger0(i) 返事を書く

shino 2004/02/12 13:07:26

EXTERNAL SUB changer2(i)
SELECT CASE loc
CASE 1,2,3
IF c(i,aa)>=1 THEN LET c(i,aa)=c(i,aa)-1
CASE 4,5,6
IF c(i,aa)<=31 THEN LET c(i,aa)=c(i,aa)+1
CASE ELSE
END SELECT
DRAW sbg(i,c(i,aa)/32) WITH SHIFT(-0.8*ws+0.1*ci,-0.25*ci-50*i)
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(c(1,aa)*w,c(2,aa)*w,c(3,aa)*w),3) WITH SHIFT(0.8*ws,ci-25*aa+20)
SET TEXT font "",12
END sub

EXTERNAL SUB changer3(i)
DO
SET DRAW mode hidden
mouse poll x,y,l,r
IF ABS(-0.8*bi-x)<=0.5*ci THEN
LET cc=(x+0.8*ws-0.1*ci)/ci
LET c(i,aa)=32*cc
END IF
DRAW sbg(i,cc) WITH SHIFT(-0.8*ws+0.1*ci,-0.25*ci-50*i)
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(c(1,aa)*w,c(2,aa)*w,c(3,aa)*w),3) WITH SHIFT(0.8*ws,ci-25*aa+20)
SET TEXT font "",12
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP WHILE l=1
LET c(i,aa)=INT(cc/w)
LET cc=c(i,aa)/32
END sub

EXTERNAL SUB nus
LET gs(1)=1000
LET gs(2)=1000
LET rate=1
FOR i=1 TO 6
LET fon(i)=1
NEXT i
LET fon(4)=0
LET fon(6)=0
END SUB

EXTERNAL SUB nut(ve)
DATA 32,10,4 !おもりの色　
DATA 32,6,2 !皿の色　　　
DATA 32,6,2 !本体の色　　
DATA 32,6,2 !土台の色　　
DATA 10,10,20 !指針の色　
DATA 32,3,3 !指針の先の色
DATA 1,1,1 !目盛り(大)の色
DATA 1,1,1 !目盛り(中)の色
DATA 1,1,1 !目盛り(小)の色
DATA 1,1,1 !目盛り(極小)の色
DATA "重り"
DATA "皿"
DATA "本体"
DATA "土台"
DATA "指針"
DATA "指針の先"
DATA "目盛り(大)"
DATA "目盛り(中)"
DATA "目盛り(小)"
DATA "補助目盛り"
DATA "文字盤"
DATA "秤の種類"
LET n=1
DO
IF n<=10 THEN READ IF MISSING THEN EXIT DO:c(1,n),c(2,n),c(3,n)
IF n>10 THEN READ IF MISSING THEN EXIT DO:line$(n-10)
LET n=n+1
LOOP
IF ve=1 THEN
FOR i=1 TO 3
DRAW sbg(i,c(i,aa)/32) WITH SHIFT(-0.8*ws+0.1*ci,-0.25*ci-50*i)
NEXT i
SET TEXT font "",7
DRAW body WITH SCALE(0.5)*SHIFT(-0.8*bi,0.5*bi)
SET LINE COLOR colorindex(0,0,0)
FOR i=1 TO 10
DRAW rectangle(0.1*ci,10,0.1*ci,10,colorindex(c(1,i)*w,c(2,i)*w,c(3,i)*w),3) WITH SHIFT(0.8*ws,ci-25*i+20)
NEXT i
SET TEXT font "",12
END IF
END sub

　　│　　　　　　　　└プログラムはここまでです。 shino 2004/02/12 13:28:47  ツリーへ

Re: EXTERNALSUBchanger2(i) 返事を書く

shino 2004/02/12 13:28:47

プログラムはここまでです。
また何かあれば教えて下さい。

　　└メニューができ もりの 2004/02/12 19:27:02  ツリーへ

Re: 秤のプログラム 返事を書く

もりの 2004/02/12 19:27:02

メニューができ
設定も各種変更できるように
なってよかったです
明日使ってみます
ただ、気になるところがあります

5ｇ
10ｇのめもりのはりの線がまがって
いることです
あと

重さを表示する針のねもとの部分が
ちょっとシンプルすぎますね
せっかくですから
はりの根元のところを
こだわってもらえますか？
よろしく
＾＾
改良ありがとうございます。
またアップしてくださいね

　　　└目盛りが曲がってしまうことは私も気になっ... shino 2004/02/12 22:11:22  ツリーへ

Re: メニューができ 返事を書く

shino 2004/02/12 22:11:22

目盛りが曲がってしまうことは私も気になっていましたが、
基本的に直しようがありません。
しかし、画面のサイズを大きくすればある程度軽減できます。
あとで画面のサイズ変更に対応したプログラムを書きますので、
試してみて下さい。
また、針の根元のデザインは、
あまり凝ったものにすることはできません。
とりあえず、
どういうものにしたいか
具体的に案があれば教えて下さい。

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。

秤のプログラム	返事を書く
shino 2004/02/12 12:45:30
とりあえず、各種設定を変更できるようにしました。 PUBLIC NUMERIC gs(2),m1,m2,m3,m4,ws,bi,ci,di,rate,c(3,10),cf(3,10),fon(6),loc,c2(3),aa,w PUBLIC STRING line$(12) SET COLOR mode "NATIVE" OPTION ANGLE DEGREES SET TEXT JUSTIFY "center","half" DECLARE EXTERNAL PICTURE body,memori,hari,checked,rectangle,sbg,botan DECLARE EXTERNAL SUB mover,bg,setting,setting2,pcheck,pcheck2,mon,changer0,changer1,changer2,changer3,nus,nut,ttc LET ws=300 !画面のサイズ SET bitmap SIZE 2ws,2ws SET WINDOW -ws,ws,-ws,ws REM 初期化 CALL nus LET w=0.03125 LET bi=ws/2 LET ci=2ws/3 CALL nut(0) CALL pcheck REM 本体 SET DRAW mode hidden LET di=90 CALL bg SET DRAW mode explicit DO SET DRAW mode hidden mouse poll x,y,l,r IF l=1 AND ABS(x)<bi AND ABS(y)<bi THEN CALL mover ELSEIF ABS(0.82ws-x)<=0.2ci AND ABS(-0.92ws-y)<=0.1ci THEN CALL ttc(0.82ws,-0.92ws,1) ELSEIF ABS(bi-x)<=0.2ci AND ABS(-0.92ws-y)<=0.1ci THEN CALL ttc(bi,-0.92*ws,2) END IF SET DRAW mode explicit WAIT DELAY 0.01 loop END

Re: 秤のプログラム	返事を書く
shino 2004/02/12 12:50:14
EXTERNAL PICTURE body OPTION ANGLE DEGREES IF di>90 THEN LET di=di-360 LET dy=0.1(270+di) LET i=0 DO SET AREA COLOR colorindex(0.005c(1,1)(0.5i+0.1dy),0.005c(2,1)(0.5i+0.1dy),0.005c(3,1)(0.5i+0.1dy)) !重りの色 PLOT AREA:-0.5ci+2i+dy,1.25ci-36+dy;-0.5ci+2i+dy,1.25ci+36-dy-2i;0.5ci-2i-dy,1.25ci+36-dy-2i;0.5ci-2i-dy,1.25ci-36+dy SET AREA COLOR colorindex(0.15i+0.25,0.15i+0.25,0.15i+0.25) !支柱の色 PLOT AREA:-0.25ci+i-10,bi;-0.25ci-10+i,ci-36+dy;-0.25ci+10-i,ci-36+dy;-0.25ci+10-i,bi PLOT AREA:0.25ci+i-10,bi;0.25ci-10+i,ci-36+dy;0.25ci+10-i,ci-36+dy;0.25ci+10-i,bi SET AREA COLOR colorindex(0.005c(1,2)i+0.2,0.005c(2,2)i+0.2,0.005c(3,2)i+0.2) !皿の色 PLOT AREA:-ci+3i,1.25ci-36+dy;-bi+i,ci-36+dy+3i;bi-i,ci-36+dy+3i;ci-3i,1.25ci-36+dy SET AREA COLOR colorindex(0.005c(1,3)i+0.2,0.005c(2,3)i+0.2,0.005c(3,3)i+0.2) !本体の色 PLOT AREA:-bi+2i,-bi+2i;bi-2i,-bi+2i;bi-2i,bi-2i;-bi+2i,bi-2i SET AREA COLOR colorindex(0.005c(1,4)i+0.2,0.005c(2,4)i+0.2,0.005c(3,4)i+0.2)!土台の色 PLOT AREA:-ci+i,-bi-2i;-1.25ci+4i,-1.25ci;1.25ci-4i,-1.25ci;ci-i,-bi-2i LET i=i+1 LOOP WHILE i<=5 LET i=0 DO SET AREA COLOR colorindex(i,i,i) !表示板 DRAW disk WITH SCALE(bi-10-2SIN(90i))SHIFT(0,2.5-5SIN(90i)) LET i=i+0.2 LOOP WHILE i<=1 SET LINE COLOR colorindex(0,0,0) PLOT LINES:-1.25ci,-1.25ci;1.25ci,-1.25ci PLOT LINES:-ci,1.25ci-36+dy;ci,1.25ci-36+dy LET theta=0 LET dtheta=3600/gs(2) LET num=0 LET gg=0 SET TEXT COLOR colorindex(0,0,0) DO IF fon(4)=1 THEN DRAW memori(ci/10000,1,10) WITH SCALE(bi-10)ROTATE(-theta-0.5dtheta) !５の目盛り(５０の目盛り） IF fon(3)=1 THEN !１０の目盛り(１００の目盛り） DRAW memori(ci/5000,1,9) WITH SCALE(bi-10)ROTATE(-theta) END IF IF MOD(gg,5)=0 THEN !５０の目盛り(５００の目盛り） IF fon(2)=1 THEN DRAW memori(ci/2500,1,8) WITH SCALE(bi-10)ROTATE(-theta) SET AREA COLOR colorindex(COS(theta),COS(theta),COS(theta)) DRAW disk WITH SCALE(0.06ci-ci/10000theta) END IF IF MOD(gg,10)=0 THEN !１００の目盛り(１０００の目盛り） IF fon(1)=1 THEN DRAW memori(ci/2000,2,7) WITH SCALE(bi-10)ROTATE(-theta) IF fon(5)=1 THEN PLOT TEXT,AT (0.5ci)COS(90-theta),(0.5ci)SIN(90-theta):STR$(num) DRAW hari WITH SCALE(0.5ci)ROTATE(di) LET num=num+100*rate END IF LET theta=theta+dtheta LET gg=gg+1 LOOP WHILE theta<360 END PICTURE

Re: EXTERNALPICTUREbody	返事を書く
shino 2004/02/12 12:52:55
EXTERNAL SUB ttc(ox,oy,n) DRAW botan(0.16,n) SET DRAW mode explicit DO SET DRAW mode hidden mouse poll x,y,l,r IF ABS(ox-x)>=0.2ci OR ABS(oy-y)>=0.1ci THEN EXIT DO IF l=1 THEN SELECT CASE n CASE 1 STOP CASE 2 CALL pcheck CASE ELSE END SELECT END IF SET DRAW mode explicit WAIT DELAY 0.01 LOOP DRAW botan(0.2,n) END SUB EXTERNAL PICTURE botan(h,n) FOR i=0 TO 5 IF n=1 THEN DRAW rectangle(0.2ci-i,0.1ci-i,0.2ci-i,0.1ci-i,colorindex(hi,hi,hi),2) WITH SHIFT(0.82ws,-0.92ws) IF n=2 THEN DRAW rectangle(0.2ci-i,0.1ci-i,0.2ci-i,0.1ci-i,colorindex(hi,hi,hi),2) WITH SHIFT(bi,-0.92ws) NEXT i SET TEXT COLOR colorindex(0,0,0) SET TEXT font "",12 PLOT TEXT,AT 0.82ws,-0.92ws:"終了" PLOT TEXT,AT bi,-0.92ws:"設定" END PICTURE EXTERNAL PICTURE memori(ta,lw,mc) SET LINE COLOR colorindex(wc(1,mc),wc(2,mc),wc(3,mc)) SET LINE width lw PLOT LINES:0,1;0,1-ta END picture EXTERNAL PICTURE hari SET LINE COLOR colorindex(wc(1,5),wc(2,5),wc(3,5)) SET LINE width 2 SET AREA COLOR colorindex(wc(1,6),wc(2,6),wc(3,6)) PLOT LINES:0,0;1,0 PLOT AREA:1,0;1.1,0.05;1.35,0;1.1,-0.05 SET LINE COLOR colorindex(0,0,0) SET LINE width 1 END PICTURE EXTERNAL SUB mover OPTION ANGLE DEGREES DO SET DRAW mode hidden mouse poll x,y,l,r LET di=ANGLE(x,y) IF l=0 THEN EXIT DO CALL bg SET DRAW mode explicit WAIT DELAY 0.03 LOOP IF m4=0 THEN LET dtheta=3600/gs(2) ELSE LET dtheta=1800/gs(2) END IF LET di=90-dthetaINT((90-di+0.5dtheta)/dtheta) CALL bg END SUB EXTERNAL SUB bg OPTION ANGLE DEGREES CLEAR DRAW rectangle(ws,ws,ws,ws,colorindex(1,1,1),2) DRAW body IF fon(6)=1 THEN SET TEXT font "",48 SET TEXT COLOR colorindex(0,0,0) PLOT TEXT,AT 0,-ci:STR$(gs(1)) & "g" SET TEXT COLOR colorindex(0.025c(1,4)+0.2,0.025c(2,4)+0.2,0.025c(3,4)+0.2) PLOT TEXT,AT 0,-ci+3:STR$(gs(1)) & "g" SET TEXT font "",12 END IF FOR i=0 TO 5 DRAW rectangle(0.2ci-i,0.1ci-i,0.2ci-i,0.1ci-i,colorindex(0.2i,0.2i,0.2i),2) WITH SHIFT(0.82ws,-0.92ws) DRAW rectangle(0.2ci-i,0.1ci-i,0.2ci-i,0.1ci-i,colorindex(0.2i,0.2i,0.2i),2) WITH SHIFT(bi,-0.92ws) NEXT i SET TEXT COLOR colorindex(0,0,0) SET TEXT font "",12 PLOT TEXT,AT 0.82ws,-0.92ws:"終了" PLOT TEXT,AT bi,-0.92ws:"設定" END SUB

Re: EXTERNALSUBttc(ox,oy,n)	返事を書く
shino 2004/02/12 12:56:28
EXTERNAL SUB setting LET di=0 LET ss=0.8ws DRAW rectangle(ws-20,ss,ws-20,ss,colorindex(0.5,0.8,0.6),2) DRAW rectangle(ws-22,ss-20,ws-22,ss-2,colorindex(1,1,1),2) SET LINE COLOR colorindex(0.3,0.6,0.4) PLOT LINES:-ws+20,-ss;ws-20,-ss;ws-20,ss PLOT LINES:ws-22,ss-20;-ws+22,ss-20;-ws+22,-ss+2 SET TEXT COLOR colorindex(1,1,1) PLOT TEXT,AT -ws+50,ss-10:"設定" SET TEXT COLOR colorindex(0,0,0) DRAW rectangle(0.45ws,0.45ws,0.45ws,0.45ws,colorindex(0.3,0.3,0.3),1) WITH SHIFT(-0.8bi,0.5bi) SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET TEXT font "",24 LET x=-ss LET cord$="-" SET LINE COLOR colorindex(0.5,0.5,0.5) FOR k=1 TO 2 PLOT LINES:-ss+0.2ci,-0.25ci-50;ci-ss,-0.25ci-50 DRAW rectangle(0.1ci,0.1ci,0.1ci,0.1ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25ci-50) PLOT TEXT,AT x,-0.25ci-50:cord$ LET x=0 LET cord$="+" NEXT k SET TEXT font "",12 PLOT TEXT,AT 0.75ci,ci:"秤の大きさ" DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,bi) SET TEXT font "",24 PLOT TEXT,AT 0.75ci,bi:STR$(gs(1)) &"g" FOR i=1 TO 6 SET LINE COLOR colorindex(0.5,0.5,0.5) DRAW rectangle(0.05ci,0.05ci,0.05ci,0.05ci,colorindex(1,1,1),3) WITH SHIFT(0.25ci,0.5ci-25i+20) SET TEXT font "",12 PLOT TEXT,AT bi,0.5ci-25i+20:line$(i+6) & "を表示する" SET TEXT font "",10 DRAW checked(fon(i)) WITH SHIFT(0.25ci,0.5ci-25i+20) NEXT i DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5ci,-ci) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-bi) PLOT TEXT,AT 0.5ci,-ci:"OK" PLOT TEXT,AT ci,-ci:"キャンセル" PLOT TEXT,AT 0.75ci,-0.5ci:"初期設定に戻す" PLOT TEXT,AT 0.75ci,-bi:"色の設定" DRAW rectangle(0.02ci,0.07ci,0.02ci,0.07ci,colorindex(1,1,1),3) WITH SHIFT(-0.8ws+0.2ci+0.008cigs(1)/100,-0.25*ci-50) SET DRAW mode explicit SET TEXT font "",12 END SUB EXTERNAL PICTURE rectangle(x1,y1,x2,y2,col,dtype) SET AREA COLOR col SELECT CASE dtype CASE 1 SET LINE COLOR col PLOT LINES:x1,y1;x1,-y2;-x2,-y2;-x2,y1;x1,y1 CASE 2 PLOT AREA:x1,y1;x1,-y2;-x2,-y2;-x2,y1 CASE ELSE PLOT AREA:x1,y1;x1,-y2;-x2,-y2;-x2,y1 PLOT LINES:x1,y1;x1,-y2;-x2,-y2;-x2,y1;x1,y1 END select END picture EXTERNAL PICTURE checked(chc) SET AREA COLOR colorindex(1-chc,1-chc,1-chc) PLOT AREA:-3,3;0,0;7,5;0,-5 END PICTURE

Re: EXTERNALSUBsetting	返事を書く
shino 2004/02/12 12:59:11
EXTERNAL SUB setting2 LET di=0 LET ss=0.8ws DRAW rectangle(ws-20,ss,ws-20,ss,colorindex(0.5,0.8,0.6),2) DRAW rectangle(ws-22,ss-20,ws-22,ss-2,colorindex(1,1,1),2) SET LINE COLOR colorindex(0.3,0.6,0.4) PLOT LINES:-ws+20,-ss;ws-20,-ss;ws-20,ss PLOT LINES:ws-22,ss-20;-ws+22,ss-20;-ws+22,-ss+2 SET TEXT COLOR colorindex(1,1,1) PLOT TEXT,AT -ws+50,ss-10:"設定" SET TEXT COLOR colorindex(0,0,0) DRAW rectangle(0.45ws,0.45ws,0.45ws,0.45ws,colorindex(0.3,0.3,0.3),1) WITH SHIFT(-0.8bi,0.5bi) SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET TEXT font "",24 LET x=-ss LET cord$="-" SET LINE COLOR colorindex(0.5,0.5,0.5) FOR k=1 TO 2 FOR i=1 TO 3 DRAW rectangle(0.1ci,0.1ci,0.1ci,0.1ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25ci-50i) PLOT TEXT,AT x,-0.25ci-50i:cord$ IF k=1 THEN DRAW sbg(i,c(i,aa)/32) WITH SHIFT(x+0.1ci,-0.25ci-50i) NEXT i LET x=0 LET cord$="+" NEXT k SET TEXT font "",12 FOR i=1 TO 10 SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(c(1,i)w,c(2,i)w,c(3,i)w),3) WITH SHIFT(ss,ci-25i+20) SET LINE COLOR colorindex(0.5,0.5,0.5) DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(1,1,1),3) WITH SHIFT(0.25ci,ci-25i+20) SET TEXT font "",12 PLOT TEXT,AT bi,ci-25i+20:line$(i) & "の色" SET TEXT font "",10 PLOT TEXT,AT 0.25ci,ci-25i+20:"変更" NEXT i DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5ci,-ci) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci) PLOT TEXT,AT 0.5ci,-ci:"OK" PLOT TEXT,AT ci,-ci:"キャンセル" PLOT TEXT,AT 0.75ci,-0.5ci:"初期設定に戻す" SET DRAW mode explicit SET TEXT font "",12 FOR k=1 TO 3 FOR i=1 TO 10 LET cf(k,i)=c(k,i) NEXT i NEXT k END SUB EXTERNAL SUB mon(otype,ss,i,l,code$) SET LINE COLOR colorindex(0,0,0) IF l=0 THEN LET lc=1 ELSE IF loc>6 THEN LET aa=loc-6 LET lc=0.8 END IF SELECT CASE otype CASE 1 IF l=1 THEN CALL changer2(i) SET TEXT font "",24 SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.1ci,0.1ci,0.1ci,0.1ci,colorindex(lc,lc,lc),3) WITH SHIFT(ss,-0.25ci-50i) PLOT TEXT,AT ss,-0.25ci-50i:code$ CASE 2 IF l=1 THEN FOR k=1 TO 3 DRAW sbg(k,c(k,aa)/32) WITH SHIFT(-0.8ws+0.1ci,-0.25ci-50k) NEXT k END IF SET TEXT font "",10 DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(lc,lc,lc),3) WITH SHIFT(ss,ci-25i+20) PLOT TEXT,AT ss,ci-25i+20:code$ CASE ELSE END SELECT SET TEXT font "",12 END sub

Re: EXTERNALSUBsetting2	返事を書く
shino 2004/02/12 13:03:02
EXTERNAL SUB pcheck LET mm=1 CALL setting DO LET ss=0.8ws SET DRAW mode hidden mouse poll x,y,l,r SET LINE COLOR colorindex(0.5,0.5,0.5) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5ci,-ci) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci) FOR i=1 TO 2 IF ABS(-ci-y)<=20 AND ABS(x-0.5cii)<=0.2ci THEN SET TEXT font "",12 SET LINE COLOR colorindex(0,0,0) IF l=1 AND dd=0 THEN LET ll=i DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.5cii,-ci) ELSE DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(0,0,0),1) WITH SHIFT(0.5cii,-ci) END IF ELSE END IF NEXT i SET TEXT font "",12 PLOT TEXT,AT 0.5ci,-ci:"OK" PLOT TEXT,AT ci,-ci:"キャンセル" FOR i=0 TO 1 SET LINE COLOR colorindex(0.5,0.5,0.5) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci-0.25cii) IF ABS(0.75ci-x)<=0.4ci AND ABS(-0.5ci-y-0.25cii)<=20 THEN SET LINE COLOR colorindex(0,0,0) IF l=0 THEN DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci-0.25cii) ELSEIF l=1 THEN DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.75ci,-0.5ci-0.25cii) IF i=0 THEN CALL nus IF i=1 THEN CALL pcheck2 DRAW rectangle(0.45ci,15,0.45ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8bi,-0.25ci-50) PLOT LINES:-ss+0.2ci,-0.25ci-50;ci-ss,-0.25ci-50 SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.02ci,0.07ci,0.02ci,0.07ci,colorindex(1,1,1),3) WITH SHIFT(-0.8ws+0.2ci+0.008cigs(1)/100,-0.25ci-50) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,bi) SET TEXT font "",24 PLOT TEXT,AT 0.75ci,bi:STR$(gs(1)) &"g" SET TEXT font "",12 END IF END IF NEXT i PLOT TEXT,AT 0.75ci,-0.5ci:"初期設定に戻す" PLOT TEXT,AT 0.75ci,-0.5ci-0.25*ci:"色の設定" IF l=0 THEN IF ll=0 THEN LET dd=0 ELSEIF ll<3 THEN EXIT DO END IF END IF LET code$="-"

Re: EXTERNALSUBpcheck	返事を書く
shino 2004/02/12 13:04:12
FOR k=1 TO 2 IF ABS(-ss-x)<=20 AND ABS(-0.25ci-50-y)<=20 THEN LET loc=k IF l=1 THEN CALL changer0(k) ELSEIF ABS(-0.8bi-x)<=0.5ci AND ABS(-0.25ci-50-y)<=10 AND l=1 THEN CALL changer1 ELSE DRAW rectangle(0.1ci,0.1ci,0.1ci,0.1ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(-ss,-0.25ci-50) END if LET ss=0 LET code$="+" NEXT k FOR i=1 TO 6 DRAW checked(fon(i)) WITH SHIFT(0.25ci,0.5ci-25i+20) IF ABS(0.25ci-x)<=0.05ci AND ABS(0.5ci-25i+20-y)<=0.05ci THEN LET loc=i+2 IF l=1 AND dd=0 THEN LET ll=2+i IF l=0 AND ll>=3 THEN CALL changer0(i) LET ll=0 END IF ELSE DRAW rectangle(0.05ci,0.05ci,0.05ci,0.05ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(0.25ci,0.5ci-25i+20) END IF NEXT i SET DRAW mode explicit WAIT DELAY 0.01 LOOP SELECT CASE ll CASE 1 CASE 2 CASE ELSE END select call bg END SUB EXTERNAL PICTURE sbg(co,cc) FOR k=1 TO 3 IF k=co THEN LET c2(k)=0.2 ELSE LET c2(k)=0 END IF NEXT k DRAW rectangle(ci,10,0,10,colorindex(0.3,0.3,0.3),2) IF cicc>=6.25 THEN FOR ii=0 TO 5 DRAW rectangle(cicc-ii,10-ii,-ii,10-ii,colorindex(c2(1)ii,c2(2)ii,c2(3)ii),2) NEXT ii ELSE DRAW rectangle(cicc,10,0,10,colorindex(c2(1),c2(2),c2(3)),2) end if END PICTURE

Re: FORk=1TO2	返事を書く
shino 2004/02/12 13:05:13
EXTERNAL SUB pcheck2 LET aa=1 LET dd=1 LET ll=0 CALL setting2 DO SET DRAW mode hidden mouse poll x,y,l,r LET ss=-0.8ws SET LINE COLOR colorindex(0.5,0.5,0.5) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(0.5ci,-ci) DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(1,1,1),3) WITH SHIFT(ci,-ci) FOR i=1 TO 2 IF ABS(-ci-y)<=20 AND ABS(x-0.5cii)<=0.2ci THEN SET TEXT font "",12 SET LINE COLOR colorindex(0,0,0) IF l=1 AND dd=0 THEN LET ll=i DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.5cii,-ci) ELSE DRAW rectangle(0.2ci,20,0.2ci,20,colorindex(0,0,0),1) WITH SHIFT(0.5cii,-ci) END IF ELSE END IF NEXT i SET TEXT font "",12 PLOT TEXT,AT 0.5ci,-ci:"OK" PLOT TEXT,AT ci,-ci:"キャンセル" SET TEXT font "",12 SET LINE COLOR colorindex(0.5,0.5,0.5) IF ABS(0.75ci-x)<=0.4ci AND ABS(-0.5ci-y)<=20 THEN SET LINE COLOR colorindex(0,0,0) IF l=0 THEN DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci) ELSEIF l=1 THEN CALL nut(1) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(0.8,0.8,0.8),3) WITH SHIFT(0.75ci,-0.5ci) END IF ELSE DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,-0.5ci) END IF PLOT TEXT,AT 0.75ci,-0.5ci:"初期設定に戻す" IF l=0 THEN IF ll=0 THEN LET dd=0 ELSE EXIT DO END IF END IF LET code$="-" FOR k=1 TO 2 FOR i=1 TO 3 IF ABS(ss-x)<=20 AND ABS(-0.25ci-50i-y)<=20 THEN LET loc=i+3k-3 CALL mon(1,ss,i,l,code$) ELSEIF ABS(-0.8bi-x)<=0.5ci AND ABS(-0.25ci-50i-y)<=10 AND l=1 THEN CALL changer3(i) ELSE DRAW rectangle(0.1ci,0.1ci,0.1ci,0.1ci,colorindex(0.5,0.5,0.5),1) WITH SHIFT(ss,-0.25ci-50i) END if NEXT i LET ss=0 LET code$="+" NEXT k FOR i=1 TO 10 IF ABS(0.25ci-x)<=20 AND ABS(ci-25i+20-y)<=10 THEN LET loc=i+6 CALL mon(2,0.25ci,i,l,"変更") ELSE DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(0.5,0.5,0.5),1) WITH SHIFT(0.25ci,ci-25i+20) END IF IF i=aa THEN DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(0.9,0.4,0.4),1) WITH SHIFT(0.25ci,ci-25*i+20) NEXT i SET DRAW mode explicit WAIT DELAY 0.01 LOOP SELECT CASE ll CASE 1 CASE 2 FOR k=1 TO 3 FOR i=1 TO 10 LET c(k,i)=cf(k,i) NEXT i NEXT k CASE ELSE END select CALL setting END sub

Re: EXTERNALSUBpcheck2	返事を書く
shino 2004/02/12 13:06:26
EXTERNAL SUB changer0(i) LET ss=0.8ws SELECT CASE loc CASE 1 IF gs(1)>=200 THEN LET gs(1)=gs(1)-100 CASE 2 IF gs(1)<=9900 THEN LET gs(1)=gs(1)+100 CASE ELSE IF fon(i)=0 THEN LET fon(i)=1 ELSE LET fon(i)=0 END IF END select IF gs(1)>2000 THEN LET gs(2)=gs(1)/10 LET rate=10 ELSEIF gs(1)<=200 THEN LET gs(2)=gs(1)10 LET rate=0.1 ELSE LET gs(2)=gs(1) LET rate=1 END IF DRAW rectangle(0.45ci,15,0.45ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8bi,-0.25ci-50) PLOT LINES:-ss+0.2ci,-0.25ci-50;ci-ss,-0.25ci-50 SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.02ci,0.07ci,0.02ci,0.07ci,colorindex(1,1,1),3) WITH SHIFT(-0.8ws+0.2ci+0.008cigs(1)/100,-0.25ci-50) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,bi) SET TEXT font "",24 PLOT TEXT,AT 0.75ci,bi:STR$(gs(1)) &"g" SET TEXT font "",12 END SUB EXTERNAL SUB changer1 LET ss=0.8ws DO SET DRAW mode hidden mouse poll x,y,l,r IF ABS(-0.8bi-x)<=0.4ci THEN IF x+ss-0.2ci>0 AND x>-ss+0.2ci+1 AND x<-0.2ci THEN LET gs(1)=100INT((x+ss-0.2ci)100/(0.008ci100)+0.5) IF gs(1)>2000 THEN LET gs(2)=gs(1)/10 LET rate=10 ELSEIF gs(1)<=200 THEN LET gs(2)=gs(1)10 LET rate=0.1 ELSE LET gs(2)=gs(1) LET rate=1 END IF DRAW rectangle(0.45ci,15,0.45ci,15,colorindex(1,1,1),2) WITH SHIFT(-0.8bi,-0.25ci-50) PLOT LINES:-ss+0.2ci,-0.25ci-50;ci-ss,-0.25ci-50 SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.02ci,0.07ci,0.02ci,0.07ci,colorindex(1,1,1),3) WITH SHIFT(x,-0.25ci-50) DRAW rectangle(0.4ci,20,0.4ci,20,colorindex(1,1,1),3) WITH SHIFT(0.75ci,bi) SET TEXT font "",24 PLOT TEXT,AT 0.75ci,bi:STR$(gs(1)) &"g" SET TEXT font "",12 END IF SET DRAW mode explicit WAIT DELAY 0.01 LOOP WHILE l=1 LET gs(1)=100INT(gs(1)/100) IF gs(1)>2000 THEN LET gs(2)= gs(1)/10 LET rate=10 ELSEIF gs(1)<=200 THEN LET gs(2)=gs(1)10 LET rate=0.1 ELSE LET gs(2)=gs(1) LET rate=1 END IF END SUB

Re: EXTERNALSUBchanger0(i)	返事を書く
shino 2004/02/12 13:07:26
EXTERNAL SUB changer2(i) SELECT CASE loc CASE 1,2,3 IF c(i,aa)>=1 THEN LET c(i,aa)=c(i,aa)-1 CASE 4,5,6 IF c(i,aa)<=31 THEN LET c(i,aa)=c(i,aa)+1 CASE ELSE END SELECT DRAW sbg(i,c(i,aa)/32) WITH SHIFT(-0.8ws+0.1ci,-0.25ci-50i) SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(c(1,aa)w,c(2,aa)w,c(3,aa)w),3) WITH SHIFT(0.8ws,ci-25aa+20) SET TEXT font "",12 END sub EXTERNAL SUB changer3(i) DO SET DRAW mode hidden mouse poll x,y,l,r IF ABS(-0.8bi-x)<=0.5ci THEN LET cc=(x+0.8ws-0.1ci)/ci LET c(i,aa)=32cc END IF DRAW sbg(i,cc) WITH SHIFT(-0.8ws+0.1ci,-0.25ci-50i) SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(c(1,aa)w,c(2,aa)w,c(3,aa)w),3) WITH SHIFT(0.8ws,ci-25aa+20) SET TEXT font "",12 SET DRAW mode explicit WAIT DELAY 0.01 LOOP WHILE l=1 LET c(i,aa)=INT(cc/w) LET cc=c(i,aa)/32 END sub EXTERNAL SUB nus LET gs(1)=1000 LET gs(2)=1000 LET rate=1 FOR i=1 TO 6 LET fon(i)=1 NEXT i LET fon(4)=0 LET fon(6)=0 END SUB EXTERNAL SUB nut(ve) DATA 32,10,4 !おもりの色　 DATA 32,6,2 !皿の色　　　 DATA 32,6,2 !本体の色　　 DATA 32,6,2 !土台の色　　 DATA 10,10,20 !指針の色　 DATA 32,3,3 !指針の先の色 DATA 1,1,1 !目盛り(大)の色 DATA 1,1,1 !目盛り(中)の色 DATA 1,1,1 !目盛り(小)の色 DATA 1,1,1 !目盛り(極小)の色 DATA "重り" DATA "皿" DATA "本体" DATA "土台" DATA "指針" DATA "指針の先" DATA "目盛り(大)" DATA "目盛り(中)" DATA "目盛り(小)" DATA "補助目盛り" DATA "文字盤" DATA "秤の種類" LET n=1 DO IF n<=10 THEN READ IF MISSING THEN EXIT DO:c(1,n),c(2,n),c(3,n) IF n>10 THEN READ IF MISSING THEN EXIT DO:line$(n-10) LET n=n+1 LOOP IF ve=1 THEN FOR i=1 TO 3 DRAW sbg(i,c(i,aa)/32) WITH SHIFT(-0.8ws+0.1ci,-0.25ci-50i) NEXT i SET TEXT font "",7 DRAW body WITH SCALE(0.5)SHIFT(-0.8bi,0.5bi) SET LINE COLOR colorindex(0,0,0) FOR i=1 TO 10 DRAW rectangle(0.1ci,10,0.1ci,10,colorindex(c(1,i)w,c(2,i)w,c(3,i)w),3) WITH SHIFT(0.8ws,ci-25*i+20) NEXT i SET TEXT font "",12 END IF END sub

Re: EXTERNALSUBchanger2(i)	返事を書く
shino 2004/02/12 13:28:47
プログラムはここまでです。また何かあれば教えて下さい。

Re: 秤のプログラム	返事を書く
もりの 2004/02/12 19:27:02
メニューができ設定も各種変更できるようになってよかったです明日使ってみますただ、気になるところがあります 5ｇ 10ｇのめもりのはりの線がまがっていることですあと重さを表示する針のねもとの部分がちょっとシンプルすぎますねせっかくですからはりの根元のところをこだわってもらえますか？よろしく＾＾改良ありがとうございます。またアップしてくださいね

Re: メニューができ	返事を書く
shino 2004/02/12 22:11:22
目盛りが曲がってしまうことは私も気になっていましたが、基本的に直しようがありません。しかし、画面のサイズを大きくすればある程度軽減できます。あとで画面のサイズ変更に対応したプログラムを書きますので、試してみて下さい。また、針の根元のデザインは、あまり凝ったものにすることはできません。とりあえず、どういうものにしたいか具体的に案があれば教えて下さい。