private declare function ADDR(byref A as long) as long
function ADDR(A as long) as long
'print "test=";hex$(varadr(A))
ADDR=A
end function
declare function _PBGETDCBNO alias "_$PbGetDCBNo@4" (byval FILENO as long) as long
declare function _PBGETDCB alias "_$PbGetDCB@4" (byval FBDCBNO as long) as long
declare function FB63_GETFILEHANDLE bdecl (byval FILENO as integer) as long
function FB63_GETFILEHANDLE (byval FILENO as integer) as long
var FBDCBNO as long, FBDCBDATA as long
FB63_GETFILEHANDLE= INVALID_HANDLE_VALUE
select case FILENO
case 1 to 255
FBDCBNO= -1
FBDCBNO= _PBGETDCBNO(clng(FILENO))
if FBDCBNO = -1 then error 57:exit function
FBDCBDATA=0
FBDCBDATA=_PBGETDCB(FBDCBNO)
if FBDCBDATA = 0 then error 60:exit function
FB63_GETFILEHANDLE=FBDCBDATA
FBDCBDATA=FBDCBDATA+&H108 'オフセット
FB63_GETFILEHANDLE=ADDR(byval FBDCBDATA)
case else
error 50
end select
end function
declare sub TEST2_SETSTATE(byval FILENO%)
sub TEST2_SETSTATE(byval FILENO%)
var RES as long
var DCB as T_DCB, HFILE as long
var F as long, M as long
HFILE= FB63_GETFILEHANDLE(FILENO%)
if HFILE=0 or HFILE=-1 then HFILE=INVALID_HANDLE_VALUE
if HFILE= INVALID_HANDLE_VALUE then print "Error:open":exit sub
RES=GetCommState(hfile, DCB) 'ポートの設定取得
if res=0 then
print "Error:GetCommState"
else
if DCB.DCBLENGTH<>len(T_DCB) then print "!!DCBlength(hex)=";DCB.DCBLENGTH
print "fBitFields(16進数)変更前=";hex$(DCB.FBITFIELDS)
'＊＊ここで設定を変更する＊＊
F=DCB.FBITFIELDS '＊bit毎設定必要
'----fRtsControl----
F=F and (not FRTSCONTROL) 'ビット消去
M=FRTSCONTROL :M=M and (M \ 2) '※下位ビットを残す
M=M * RTS_CONTROL_TOGGLE '設定値
F=F or M 'ビット設定
print "fRtsControl書換";RTS_CONTROL_TOGGLE ;" (RTS フロー制御:0..3)"
'--------
DCB.FBITFIELDS=F '設定
'＊＊＊＊
print "fBitFields(16進数)変更後=";hex$(DCB.FBITFIELDS)
'設定を強制更新する
RES=SetCommState(hfile, DCB)
if res=0 then
print "Error:SetCommState"
endif
endif
end sub
'－－－－－－－－
var CM$, R$(4-1)
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 print "!!受信バッファが空でない！"
print"!!送信始!!"
print#2,"D";chr$(13);
wait 50
while eof(1) :print"*"; :wend ' 受信開始までループ
print:print"!!受信始!!"
wait 5
while lof(1) < 14*4 :print"."; :wait 5 :wend ' 全フレーム受信までループ
print:print"!!受信終!!"
line input#1,R$(0) :print "!!Frame-1入力"
line input#1,R$(1) :print "!!Frame-2入力"
line input#1,R$(2) :print "!!Frame-3入力"
line input#1,R$(3) :print "!!Frame-4入力"
close
stop:end
declare sub TEST1_SETSTATE_NULLCHAR(FDSCRP$, byval SW%= 0)
sub TEST1_SETSTATE_NULLCHAR(FDSCRP$, byval SW%)
var RES as long, DCB as T_DCB
var HFILE as long
var F as long, M as long
var DEVNAME$
if SW%<0 then SW%=0
if SW%> 1 then SW%=1
select case ucase$(left$(FDSCRP$,5))
case "COM0:"
DEVNAME$="COM1"
case "COM1:"
DEVNAME$="COM2"
case "COM2:"
DEVNAME$="COM3"
case "COM3:"
DEVNAME$="COM4"
case "COM4:"
DEVNAME$="COM5"
case else
error 55 :exit sub
end select
HFILE=INVALID_HANDLE_VALUE
HFILE = CREATEFILE(DEVNAME$, (GENERIC_READ or GENERIC_WRITE), 0, NULL, OPEN_EXISTING, 0, NULL)
if HFILE= INVALID_HANDLE_VALUE then print "Error:open失敗":exit sub
RES=GetCommState(hfile, DCB)
if res=0 then
print "Error:GetCommState"
RES=CLOSEHANDLE(HFILE)
else
if DCB.DCBLENGTH<>len(T_DCB) then print "!!DCBlength(hex)=";DCB.DCBLENGTH
'＊＊ここで設定を変更する＊＊
F=DCB.FBITFIELDS '＊bit毎設定必要
'----fNull----
F=F and (not fnULL) 'ビット消去
M=fnULL
M=M * clng(SW%) '設定値
F=F or M 'ビット設定
if DCB.FBITFIELDS <> F then
print "fBitFields(16進数)変更前=";hex$(DCB.FBITFIELDS)
DCB.FBITFIELDS=F '設定
print "fBitFields(16進数)変更後=";hex$(DCB.FBITFIELDS)
'設定を更新する
RES=SetCommState(hfile, DCB)
if res=0 then
print "Error:SetCommState"
endif
endif
RES=CLOSEHANDLE(HFILE)
endif
end sub
原文はつぎのとおりです。
RTS_CONTROL_TOGGLE (0x03): トグルモード
Specifies that the RTS line will be high if bytes are available for transmission.
After all buffered bytes have been sent, the RTS line will be low.
declare sub TEST2_SETSTATE(byval FILENO%)
sub TEST2_SETSTATE(byval FILENO%)
var RES as long
var DCB as T_DCB, HFILE as long
var F as long, M as long
HFILE= FB63_GETFILEHANDLE(FILENO%)
if HFILE=0 or HFILE=-1 then HFILE=INVALID_HANDLE_VALUE
if HFILE= INVALID_HANDLE_VALUE then print "Error:open":exit sub
RES=GetCommState(hfile, DCB) 'ポートの設定取得
if res=0 then
print "Error:GetCommState"
else
if DCB.DCBLENGTH<>len(T_DCB) then print "!!DCBlength(hex)=";DCB.DCBLENGTH
print "fBitFields(16進数)変更前=";hex$(DCB.FBITFIELDS)
'＊＊ここで設定を変更する＊＊
F=DCB.FBITFIELDS '＊bit毎設定必要
'----fRtsControl----
F=F and (not FRTSCONTROL) 'ビット消去
M=FRTSCONTROL :M=M and (M \ 2) '※下位ビットを残す
M=M * RTS_CONTROL_TOGGLE '設定値
F=F or M 'ビット設定
print "fRtsControl書換";RTS_CONTROL_TOGGLE ;" (RTS フロー制御:0..3)"
'--------
DCB.FBITFIELDS=F '設定
'----fNull----
M=fnULL '設定値
F=F or M 'ビット設定
print "fNull書換";" (NULL BYTES 受信を破棄する)"
・「コマンド送信 〜 データ受信完了」の一連のサイクルを高速で繰り返してはならない。
資料( >611 )より、
Caution:
For exact measurement and good communication with PC, use “data request” signal
once per one second.
Data Conversion time:
Data Conversion time is based on conversion time of ADC included in DMM and is 2 or
3 times per one second.
[翻訳]
注意:正確な測定とPCとの良好な通信のためには、1秒に1度「データ要求」信号を使用する。
データ変換時間:データ変換時間は、DMM内蔵ADC(訳注:アナログ－デジタル変換)の変換時間を
基本として、1秒あたり2〜3回である。
[了]
declare function LTRIMCTRL bdecl (S as string) as string
function LTRIMCTRL$ (S$)
'機能：引数で指定された文字列の左側の制御コード等を取り除きます。
var I as long ,P as long ,N as long
LTRIMCTRL$=S$
N=len(S$)
if N=0 then exit function
P=0 :I=0
do
I=I+1
select case asc(mid$(S$,I,1))
case is < &H20
case &H7F,&HFF
case else
exit do
end select
P=P+1
loop while I < N
if P > 0 then LTRIMCTRL$=mid$(S$,P+1)
end function
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でフォント操作をする場合には適用できません。
