5.座標面積計算 (F-BASIC)
'-----座標面積計算-----
lprint type"dc"
defint I,J:defstr N,Q:defdbl A-H,K,L,M,P,R-Z
dim X(40),Y(40),XH(40),YH(40),FSD(40),HSD(40),HKS(40),HKK(40),P(40),HA(40),N$(40)
EE=1/10000000000#:EES=1.0027379#:EEE=0.006719218798677#
PI=3.141592653589793#
RAA=180#/PI:RRA=PI/180#
dim S1(5),N1$(5),B1(5),N2$(5),B2(5),S2(5),BB1(5),BT1(5),BT2(5),X1(5),SS1(5),SS2(5),BBB1(5),BB2(5),BBB2(5),AS3(6),AA3(6)
def fnRAN(T)=(fix(T)+fix*1*100#)/60#+(T*100#-fix(T*100#))/36#)/RAA:'---度分秒からラジアンへ
def fnDEG(T)=fix(T)+fix*2*100#)/60#+(T*100#-fix(T*100#))/36#:'---度単位---
def fnDMS(T)=fix(T)+fix*3*60#)/100#+*4*60#-fix*5*60#))*0.006#:'---度、分、秒---
def fnASI(T)=atn(T/(sqr(-T*T+1#)))*RAA:'-------------ア－クサイン
def fnACO(T)=(-atn(T/sqr(-T*T+1#))+PI/2#)*RAA:'-----------ア－クコサイン
def fnCCOS(PY,PE,PS0,PS1)=sqr(PY*(PY-PE)/SS0/PS1):'---------COS(a)/2
N0$=" ---------------------------------------------------------"
N01$=" -----------------------------------------------"
*SENTAKU1
cls:locate 25,3:print"計算の項目を選択して下さい。"
locate 25,6:print"座標面積計算・・・・・・・１"
locate 25,8:print"三斜面積計算・・・・・・・２"
locate 25,10:print"扇型面積計算・・・・・・・３"
locate 25,12:print"ヘロンの面積計算・・・・・４"
locate 25,14:print"作 業 終 了・・・・・・５"
locate 30,17:input"番号を選択して下さい。 ";JO
if JO<1 or JO>5 then *SENTAKU1
on JO goto *MENKEI,*SANSYA,*OHUGI,*HERON,*OWARI
'
*MENKEI:cls:locate 15,8:print"＊＊＊ 作 業 メニュウ－ ＊＊＊"
cls:gosub *MENU1
on J goto *DETAIN,*SYUSEI,*KEISAN,*SENTAKU1
'
*DETAIN:I=0
cls:locate 15,1:print"＊＊＊ 座標面積計算 ＊＊＊"
*12:I=I+1
locate 20,3:input"点名 ";N$(I)
if N$(I)="0" then *MENKEI
locate 20,5:input"X ";X(I)
locate 20,7:input"Y ";Y(I)
locate 50,3 :print"終わりは ０です。"
locate 25,3:print" "
locate 30,5:print" "
locate 30,7:print" "
II=I:goto *12
'
*SYUSEI:'--------デ－タ－の修正----------
'
cls:locate 20,3:print "--------デ－タ－の修正-----------"
locate 20,6:print "修 正 ・・・・・１ "
locate 20,8:print "終わり ・・・・・２"
locate 25,20:input "番号を指定 ";J
on J goto *30,*MENKEI
'
*30:cls:locate 20,9:input "何番目か ";I
locate 20,11:print "点名 ・・・・・１"
locate 20,13:print "座標 X=・・・・・・２"
locate 20,15:print "座標 Y=・・・・・・３"
locate 20,17:print "終わり ・・・・・４"
locate 25,20:input "番号を指定 ";J
on J goto *33,*34,*35,*MENKEI
'
*33:cls:locate 20,10:input"点名 ";N$(I):goto *SYUSEI
*34:cls:locate 20,10:input"X ";X(I):goto *SYUSEI
*35:CLS:locate 20,10:input"Y ";Y(I):goto *SYUSEI
'
*KEISAN:cls:YH=0:'---------計算-------
for I=1 to II
XH(I)=X(I)*Y(I+1)-Y(I)*X(I+1)
if I=II then XH(I)=X(I)*Y(1)-Y(I)*X(1)
YH=YH+XH(I)
next I
YY=abs(YH/2#):YYY=YY*0.3025#
'
lprint:lprint:lprint:lprint:lprint:lprint tab(30)"座標による面積計算":lprint:lprint:lprint:lprint
lprint " 点 名 Ｘ Ｙ 倍 面 積":lprint
for I=1 to II
lprint using " & & #######.#### #######.#### ###############.#######";N$(I),X(I),Y(I),XH(I):lprint
next I
lprint N0$
lprint using " 倍 面 積 = ###############.#######";YH:lprint
lprint using " 面 積 = ###############.#######";YY:lprint
lprint using " 坪 = ###############.#######";YYY:lprint
lprint chr$(12);
'
goto *MENKEI
'
*SANSYA:cls:locate 15,1:print"＊＊＊ 三斜面積計算 ＊＊＊"
'
gosub *MENU1
on J goto *DETAIN2,*SYUSEI2,*KEISAN2,*SENTAKU1
'
*DETAIN2:I=0
cls:locate 15,1:print"＊＊＊ 三斜面積計算 ＊＊＊"
*91:I=I+1
locate 20,3:input"番 号 ";N$(I)
if N$(I)="0" then *SANSYA
locate 20,5:input"底 辺 S ";X(I)
locate 20,7:input"高 さ H ";Y(I)
locate 50,3 :print"終わりは ０ です。"
locate 25,3:print" "
locate 30,5:print" "
locate 30,7:print" "
II=I:goto *91
'
*SYUSEI2:'--------デ－タ－の修正----------
cls:locate 20,3:print "--------デ－タ－の修正-----------"
locate 20,6:print "修 正 ・・・・・１ "
locate 20,8:print "終わり ・・・・・２"
locate 25,20:input "番号を指定 ";J
on J goto *110,*SANSYA
'
*110:cls:locate 20,9:input "何番目か ";I
locate 20,11:print "番 号 ・・・・・１"
locate 20,13:print "底 辺 S=・・・・・・２"
locate 20,15:print "高 さ H=・・・・・・３"
locate 20,17:print "終わり ・・・・・４"
locate 25,20:input "番号を指定 ";J
on J goto *117,*118,*119,*SANSYA
'
*117:cls:locate 20,10:input"番 号 ";N$(I):goto *SYUSEI2
*118:cls:locate 20,10:input"底 辺 S ";X(I):goto *SYUSEI2
*119:CLS:locate 20,10:input"高 さ H ";Y(I):goto *SYUSEI2
'
*KEISAN2:cls:S0=0:'---------計算-------
for I=1 to II
S(I)=X(I)*Y(I):S0=S0+S(I)
if I=II then XH(I)=X(I)*Y(1)-Y(I)*X(1)
YH=YH+XH(I)
next I
SS0=S0/2#:SK=SS0*0.3025#
'
lprint:lprint:lprint:lprint:lprint:lprint tab(30)"三斜による面積計算":lprint:lprint:lprint:lprint
lprint " 番 号 底 辺 高 さ 倍 面 積":lprint
for I=1 to II
lprint using " & & #######.#### #######.#### ##############.########";N$(I),X(I),Y(I),S(I):lprint
next I
lprint N0$
lprint using " 倍 面 積 =###############.#######";S0:lprint
lprint using " 面 積 =###############.#######";SS0:lprint
lprint using " 坪 =###############.#######";SK:lprint
'
lprint chr$(12);
'
goto *SANSYA
'
'
*OHUGI:cls:locate 15,1:print"＊＊＊ 扇型面積計算 ＊＊＊"
'
gosub *MENU1
on J goto *DETAIN3,*SYUSEI3,*KEISAN3,*SENTAKU1
'
*DETAIN3:I=0
cls:locate 15,1:print"＊＊＊ 扇型面積計算 ＊＊＊"
locate 20,4:input"BC 点名 ";N1$
locate 20,6:input"BC 座標 X ";X1
locate 20,8:input"BC 座標 Y ";Y1
locate 20,10:input"EC 点名 ";N2$
locate 20,12:input"EC 座標 X ";X2
locate 20,14:input"EC 座標 Y ";Y2
locate 20,16:input"半 径 R ";R0
goto *OHUGI
'
*SYUSEI3:'--------デ－タ－の修正----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 20,4:print"BC 点名 ・・・・・１"
locate 20,6:print"BC 座標 X・・・・・・２"
locate 20,8:print"BC 座標 Y・・・・・・３"
locate 20,10:print"EC 点名 ・・・・・・４"
locate 20,12:print"EC 座標 X・・・・・・５"
locate 20,14:print"EC 座標 Y・・・・・・６"
locate 20,16:print"半 径 R・・・・・・７"
locate 20,18:print "終わり ・・・・・・８"
locate 25,21:input "番号を指定 ";J
on J goto *173,*174,*175,*176,*177,*178,*179,*OHUGI
'
*173:cls:locate 20,10:input"BC 点名 ";N1$:goto *SYUSEI3
*174:cls:locate 20,10:input"BC 座標 X ";X1:goto *SYUSEI3
*175:cls:locate 20,10:input"BC 座標 Y ";Y1:goto *SYUSEI3
*176:cls:locate 20,10:input"EC 点名 ";N2$:goto *SYUSEI3
*177:cls:locate 20,10:input"EC 座標 X ";X2:goto *SYUSEI3
*178:cls:locate 20,10:input"EC 座標 Y ";Y2:goto *SYUSEI3
*179:cls:locate 20,10:input"半 径 R ";R0:goto *SYUSEI3
'
'
*KEISAN3:cls:'---------計算-------
DX=X2-X1:DY=Y2-Y1:gosub *STSUB
SA=SS/2#/R0:SAT=fnASI(SA):TIA=SAT*2#:SAR=SAT/RAA:TIAT=fnDMS(TIA)
TM=TT+90#-SAT
if TM>360# then TM=TM-360#
TMR=TM/RAA:X3=X1+cos(TMR)*R0:Y3=Y1+sin(TMR)*R0
BB=360#/TIA:AA=PI*R0*R0:AD=AA/BB:AC=R0*cos(SAR)*SS/2#:ADD=AD-AC
SK=ADD*0.3025#
'
lprint:lprint:lprint:lprint:lprint:lprint tab(30)"扇型による面積計算":lprint:lprint:lprint:lprint
lprint " 点 名 Ｘ Ｙ":lprint
lprint using " & & #######.##### #######.#####";N1$,X1,Y1:lprint
lprint using " & & #######.##### #######.#####";N2$,X2,Y2:lprint
lprint N01$
lprint using " 円の中心#######.##### #######.#####";X3,Y3:lprint
lprint using " & &-->& & 距離#######.##### 方向角####.########";N1$,N2$,SS,TDM:lprint
lprint using " 面 積 = ##############.#######";ADD:lprint
lprint using " 坪 = ##############.#######";SK:lprint
lprint using " IA = #####.#########";TIAT:lprint
'
lprint chr$(12);
'
goto *OHUGI
'
*HERON:cls:'-------ヘロンの面積計算--------
locate 15,8:print"＊＊＊ 作 業 メニュウ－ ＊＊＊"
cls:gosub *MENU1
on J goto *DETAIN4,*SYUSEI4,*KEISAN4,*SENTAKU1
'
*DETAIN4:cls
locate 15,1:print"＊＊＊ ヘロンの座標面積計算 ＊＊＊"
locate 20,3:input"１の点名 ";N1$
locate 20,4:input" X ";X1
locate 20,5:input" Y ";Y1
locate 20,7:input"２の点名 ";N2$
locate 20,8:input" X ";X2
locate 20,9:input" Y ";Y2
locate 20,11:input"３の点名 ";N3$
locate 20,12:input" X ";X3
locate 20,13:input" Y ";Y3
goto *HERON
'
*SYUSEI4:cls:'--------デ－タ－の修正-----------
locate 20,3:print "--------デ－タ－の修正-----------"
locate 20,6:print "修 正 ・・・・・１ "
locate 20,8:print "終わり ・・・・・２"
locate 25,20:input "番号を指定 ";J
on J goto *230,*HERON
'
*230:cls:locate 20,9:input "何番目か ";I
locate 20,11:print "点名 ・・・・・１"
locate 20,13:print "座標 X=・・・・・・２"
locate 20,15:print "座標 Y=・・・・・・３"
locate 20,17:print "終わり ・・・・・４"
locate 25,20:input "番号を指定 ";J
on J goto *233,*234,*235,*HERON
'
*233:cls:locate 20,10:input"点名 ";NI$:goto *SYUSEI4
*234:cls:locate 20,10:input"X ";XI:goto *SYUSEI4
*235:cls:locate 20,10:input"Y ";YI:goto *SYUSEI4
'
*KEISAN4:cls:'---------計 算-------
DX=X2-X1:DY=Y2-Y1:gosub *STSUB:S1=SS:T1=TT:TK1=TDM
DX=X3-X2:DY=Y3-Y2:gosub *STSUB:S2=SS:T2=TT:TK2=TDM
DX=X1-X3:DY=Y1-Y3:gosub *STSUB:S3=SS:T3=TT:TK3=TDM
PP=(S1+S2+S3)/2#:MM=sqr(PP*(PP-S1)*(PP-S2)*(PP-S3)):SK=MM*0.3025#
COA=sqr(PP*(PP-S1)/S2/S3):COB=sqr(PP*(PP-S2)/S1/S3):COC=sqr(PP*(PP-S3)/S2/S1)
TT1=fnACO(COA)*2#:TM1=fnDMS(TT1):TT2=fnACO(COB)*2#:TM2=fnDMS(TT2):TT3=fnACO(COC)*2#:TM3=fnDMS(TT3)
if S1<S2 then SH=S2 else SH=S1
if SH<S3 then SH=S3
HH=MM/SH*2#
'
lprint:lprint:lprint:lprint:lprint:lprint tab(30)"ヘロンの面積計算":lprint:lprint:lprint:lprint
lprint " 点 名 Ｘ Ｙ 方向角 夾 角 距 離":lprint
lprint using " & & #######.### #######.### ####.###### ####.###### ######.#####";N1$,X1,Y1,TK1,TM1,S1:lprint
lprint using " & & #######.### #######.### ####.###### ####.###### ######.#####";N2$,X2,Y2,TK2,TM2,S2:lprint
lprint using " & & #######.### #######.### ####.###### ####.###### ######.#####";N3$,X3,Y3,TK3,TM3,S3:lprint
lprint N01$
lprint using " 面 積 =##############.#######";MM:lprint
lprint using " 坪 =##############.#######";SK:lprint
lprint using " 低 辺 = #####.#######";SH:lprint
lprint using " 高 さ = #####.#######";HH:lprint
'
lprint chr$(12);
'
goto *HERON
'
'
*MENU1
locate 20,5:print"＊＊＊ 作 業 メニュウ－ ＊＊＊"
locate 20,8:print"デ－タの入力 ・・・・・・・1"
locate 20,10:print"デ－タの修正 ・・・・・・・2 "
locate 20,12:print"計算書の印刷 ・・・・・・・3 "
locate 20,14:print"作業の終了 ・・・・・・・・4 "
locate 30,17:input"番号を指定 ";J
return
'
*STSUB:'---------ST SUB---------
SS=sqr(DX*DX+DY*DY):TD=atn(DY/(DX+EE)):TT=TD*RAA
if DX<0 then TT=TT+180#
if DY<0 then TT=TT+360#
if TT>360# then TT=TT-360#
TDM=fnDMS(TT)
return
'
*OWARI
'
end
