新しく発言する EXIT インデックスへ
秤のプログラム

  秤のプログラム 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) !5の目盛り(50の目盛り)
IF fon(3)=1 THEN !10の目盛り(100の目盛り)
DRAW memori(ci/5000,1,9) WITH SCALE(bi-10)*ROTATE(-theta)
END IF
IF MOD(gg,5)=0 THEN !50の目盛り(500の目盛り)
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 !100の目盛り(1000の目盛り)
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
メニューができ
設定も各種変更できるように
なってよかったです
明日使ってみます
ただ、気になるところがあります

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

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

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

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


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