var FRUN as long,FEND as long
var TT&(50), RR$(4-1, 50) as string * 13 'データ保管領域確保
var TIMER1 as object
var CM$, R$(4-1), CNT1&, CNT2&, I&
TIMER1.ATTACH GETDLGITEM("TIMER1")
TIMER1.SETINTERVAL 50 ' (10ms単位)
baud 0,9600
CM$="COM0:(S7N2N7NNN)"
open CM$ for output as #2 : open CM$ for input as #1
TEST2_SETSTATE 2 '←ファイル番号の対応COM設定を強制変更する
wait 100
if not eof(1) then R$(0)=input$(lof(1),#1):R$(0)="" '最初の(00h)を捨てる
while CHECKEVENT :CALLEVENT :wend
TIMER1.ENABLE -1 'タイマー通知開始
*LOOP1
'イベント発生して処理されるまで待つ(かつ変数FRUNでタイマーイベントを待つ)
while FRUN=0 :WAITEVENT :wend
if FEND then *ENDING '中止して終了する
CNT1&=CNT1&+1
print#2,"D";chr$(13);
TT&(CNT1&)=millitime ' 00:00:00からの通算時間の値(1ms単位)
if CHECKEVENT then CALLEVENT
wait 10 '受信データ作成待ち
while eof(1) and FEND=0 :CALLEVENT :wend ' 受信開始までループ
if FEND then *ENDING
if lof(1) < 14 and FEND=0 then wait 5 :CALLEVENT ' １行受信までもう少し待つ
if CHECKEVENT then CALLEVENT
if lof(1) < 14 then
print "!!データ受信エラー!!";lof(1)
R$(0)="":if lof(1) <> 0 then R$(0)=input$(lof(1),#1)
R$(1)="":R$(2)="":R$(3)=""
else
line input#1,R$(0) :if CHECKEVENT then CALLEVENT
line input#1,R$(1) :line input#1,R$(2) :line input#1,R$(3)
endif
RR$(0,CNT1&)=R$(0):RR$(1,CNT1&)=R$(1):RR$(2,CNT1&)=R$(2):RR$(3,CNT1&)=R$(3)
CNT2&=CNT2&+1
while CHECKEVENT :CALLEVENT :wend '未処理イベントの処理
FRUN=0 '次のタイマー通知へ
if CNT1& < 50 then *LOOP1 '繰り返し
*ENDING
if CHECKOBJECT(TIMER1) then TIMER1.ENABLE 0 'タイマー停止
if CHECKEVENT then CALLEVENT
if CHECKOBJECT(TIMER1) then TIMER1.DETACH 'オブジェクトと切り離し
close
'これはテスト：データ画面表示
for I&=1 to 50:print TT&(I&),RR$(0,I&);RR$(1,I&);RR$(2,I&);RR$(3,I&):next
return
'================================================================
' タイマーイベント プロシージャ
declare sub TIMER1_TIMER edecl ()
sub TIMER1_TIMER()
shared FRUN as long, FEND as long
shared TIMER1 as object
var RES as long
'print "Test:タイマー";time$
if FRUN then
TIMER1.ENABLE 0 'タイマー停止
FRUN=-1:FEND=-1 '終了
RES=MESSAGEBOX("TIMER1","処理時間があふれました！",0,0)
exit sub
end if
FRUN=-1 'タイマー通知があった
end sub
'================================================================
' メインフォーム が閉じられようとしている
declare sub MAINFORM_QUERYCLOSE edecl ( CANCEL%, byval MODE% )
sub MAINFORM_QUERYCLOSE( CANCEL%, byval MODE% )
shared FRUN as long, FEND as long
FRUN=-1
FEND=-1 '処理終了させる
end sub
OWARI =(millitime/1000.0)
do
NOW =(millitime/1000.0):if NOW < OWARI then NOW=NOW+86400
if NOW >= OWARI+KANKAKU then print date$,time$,millitime :OWARI=NOW
loop
KAISU%=KAISU%+1 :loop
'
stop:end
*KAKE: print date$,time$ :return
'
*JUSTTIME2:return
*JUSTTIME
OWARI=KANKAKU-(time mod KANKAKU)
if OWARI >= 2 then '差が2秒以上あるならば、
interval OWARI-1 '秒単位の割り込み。ただし１秒残す。
on interval gosub *JUSTTIME2
interval on
waiti '設定している割り込みが発生するまで停止します。
interval off
end if
OWARI=1000-(millitime mod 1000)
if OWARI >= 100 then
wait (OWARI \ 100)*10 '1/100秒単位：0.1秒粗く待つ
endif
OWARI=1000-(millitime mod 1000)
if MUGEN_NN then for MUGEN_CC=(MUGEN_NN / 1000)*(OWARI \ 10)*10 to 0 step -1:MUGEN_NN=MUGEN_NN:next
if KANKAKU-((millitime \ 1000) mod KANKAKU)>= 2 then print "Time Over!!"
OWARI=1000-(millitime mod 1000)
MUGEN_CC=0
do 'ループしてmillitimeを秒単位チェック待ち
MUGEN_CC=MUGEN_CC+1
NOW=(millitime \ 1000) mod KANKAKU
loop until NOW=0
return
'
*MUGENSENS2 :MUGEN_NN=MUGEN_CC :return
*MUGENSENS
interval 1
on interval gosub *MUGENSENS2
MUGEN_CC=0:MUGEN_NN=0
interval on
waiti '１回目発生待ち
for KAISU%=1 to 3
do '２回目以降でループ回数カウント
MUGEN_CC=MUGEN_CC+1
loop until MUGEN_NN
if MUGEN_NN < MUGEN_NN2 or MUGEN_NN2=0 then MUGEN_NN2=MUGEN_NN
MUGEN_NN=0:MUGEN_CC=0
next KAISU%
MUGEN_NN=MUGEN_NN2
interval off
return
end
if NOW >= OWARI+KANKAKU
この方法の場合、計測間隔の精度はいいのですが、時間的確度はだんだん正の方にずれて行ってしまいます。やはり、millitimeを基本に計測間隔±0.005秒とかの設定にした方がいいみたいです。ただし、この方法では一度ずれてしまうと、戻らなくなる可能性があります。
いかに無限ループでmillitimeを観測しようと、プリエンティブなマルチタスクOSなので、
どこかで実行権を剥奪されるので、タスク切り換え単位以下の精度を維持しつづけることは
できないので、計測時間範囲で平均値を維持するのがやっとのはずです。
まあ極論、OSをWindows Ver.3.1、F-BASIC for Windows (V3.1)にすればということですが。
CHK_TIME%=((time mod 60)+2) mod 60 'リミットをおよそ2秒後に設定
do while lof(1) < 90
if (time mod 60) = CHK_TIME% then print "＊＊受信エラー＊＊" :exit do
loop
if lof(1) < 90 then GPGGA$=input$(lof(1), #1) else GPGGA$=input$(90, #1)
if right$(GPGGA$,1)=chr$(13) then GPGGA$=left$(GPGGA$, len(GPGGA$) - 1)
ソフト・ハード両環境によるが、次の1行を順次変更することで精度を上げられるかもしれません。
→→ if OWARI>=30 and OWARI < 100 then wait (1+(OWARI \ 10)) :return
1. if OWARI>=30 and OWARI < 100 then wait (0+(OWARI \ 10)) :return
2. if OWARI>=30 and OWARI < 100 then wait (0+(OWARI \ 10))
3.コメントアウトしてプログラムから外す。
※2、3の変更案は、負荷がかかります。
*JUSTTIME2:return
*JUSTTIME
OWARI=millitime
if (OWARI mod 1000)>=900 and KANKAKU>=2 then
OWARI=1000-(OWARI mod 1000)
wait 1+(OWARI \ 10) 'ここは越えるようにする
endif
OWARI=KANKAKU-((millitime \ 1000) mod KANKAKU)
if OWARI >= 2 then '差が2秒以上あるならば、
interval OWARI-1 '秒単位の割り込み。ただし１秒残す。
on interval gosub *JUSTTIME2
interval on
waiti '設定している割り込みが発生するまで停止します。
interval off
end if
OWARI=1000-(millitime mod 1000)
if OWARI >= 100 then
wait (OWARI \ 100)*10 '1/100秒単位：0.1秒粗く待つ
endif
OWARI=1000-(millitime mod 1000)
if OWARI>= 100 then MUGEN_CC=-1:return '←TIME OVER!!
OWARI=millitime
if KANKAKU-((OWARI \ 1000) mod KANKAKU)>= 2 then
MUGEN_CC=-1 :return '←TIME OVER!!
OWARI=1000-(OWARI mod 1000)
else
OWARI=1000-(OWARI mod 1000)
endif
OWARI=1000-(millitime mod 1000)
MUGEN_CC=0
if OWARI >= 100 then return
if OWARI>=30 and OWARI < 100 then wait (1+(OWARI \ 10)) :return
if KANKAKU < 2 then
do 'ループしてmillitimeを秒未満チェック待ち
MUGEN_CC=MUGEN_CC+1
NOW=(millitime mod 1000)
loop until NOW<900
else
do 'ループしてmillitimeを秒単位チェック待ち
MUGEN_CC=MUGEN_CC+1
NOW=(millitime \ 1000) mod KANKAKU
loop until NOW=0
endif
return
KAISU%=KAISU%+1 :loop
'
stop:end
*KAKE: print date$,time$ :return
'
*JUSTTIME2:return
*JUSTTIME
OWARI=millitime
if (OWARI mod 1000)>=900 and KANKAKU>=2 then
OWARI=1000-(OWARI mod 1000)
wait 1+(OWARI \ 10) 'ここは越えるようにする
endif
OWARI=KANKAKU-((millitime \ 1000) mod KANKAKU)
if OWARI >= 2 then '差が2秒以上あるならば、
interval OWARI-1 '秒単位の割り込み。ただし１秒残す。
on interval gosub *JUSTTIME2
interval on
waiti '設定している割り込みが発生するまで停止します。
interval off
end if
OWARI=1000-(millitime mod 1000)
if OWARI >= 100 then
wait (OWARI \ 100)*10 '1/100秒単位：0.1秒粗く待つ
endif
OWARI=1000-(millitime mod 1000)
if OWARI>= 100 then MUGEN_CC=-1:return '←TIME OVER!!
OWARI=millitime
if KANKAKU-((OWARI \ 1000) mod KANKAKU)>= 2 then
MUGEN_CC=-1 :return '←TIME OVER!!
OWARI=1000-(OWARI mod 1000)
else
OWARI=1000-(OWARI mod 1000)
endif
OWARI=1000-(millitime mod 1000)
MUGEN_CC=0
if OWARI >= 100 then return
if OWARI>=30 and OWARI < 100 then wait (1+(OWARI \ 10)) :return
if KANKAKU < 2 then
do 'ループしてmillitimeを秒未満チェック待ち
MUGEN_CC=MUGEN_CC+1
NOW=(millitime mod 1000)
loop until NOW<900
else
do 'ループしてmillitimeを秒単位チェック待ち
MUGEN_CC=MUGEN_CC+1
NOW=(millitime \ 1000) mod KANKAKU
loop until NOW=0
endif
return
CHK_TIME%=((time mod 60)+2) mod 60 'リミットをおよそ2秒後に設定
do while lof(1) < 90
if (time mod 60) = CHK_TIME% then print "＊＊受信エラー＊＊" :exit do
loop
if lof(1) < 90 then GPGGA$=input$(lof(1), #1) else GPGGA$=input$(90, #1)
if right$(GPGGA$,1)=chr$(13) then GPGGA$=left$(GPGGA$, len(GPGGA$) - 1)
size as single 'フォントサイズ
bold as integer 'ボールド(太字)指定の有無
italic as integer 'イタリック(斜体)指定の有無
underline as integer 'アンダーライン(下線)指定の有無
strikeout as integer '消し線指定の有無
ffname as string * 32 'フォント名
end type
なお、このFONT構造体はF-BASIC専用です。Windows APIのFONT構造体等とは違いますので、
F-BASICの組込命令を使用せずにフォント選択ダイアログを呼び出したり、
Windows APIでフォント操作をする場合には適用できません。
