温度を測定するためのプログラム

プログラムの詳しい説明は

↓　左下から続く

Sub clock_HL()
　　　 dummy = EscapeCommFunction(hComm, CLRRTS)
'CLOCKをH
　　　 dummy = EscapeCommFunction(hComm, SETRTS)
'CLOCKをL
End Sub
Sub datain_H()
　　　 dummy = EscapeCommFunction(hComm, CLRDTR)
'DATA INをH
End Sub
Sub datain_L()
　　　 dummy = EscapeCommFunction(hComm, SETDTR)
'DATA INをL
End Sub
Function cs_check() As Integer
　　Dim inComm As Long　　 'ポートの状態を読込む変数
　　dummy = GetCommModemStatus(hComm, inComm)
'RS-232Cの状態を読みとる
　　If (inComm And MS_CTS_ON) = 0 Then cs_check = 1
Else cs_check = 0　'CHIP SELECTの状態を知らせる
End Function
Function rsio_close()
　　dummy = CloseHandle(hComm)
End Function

コマンドボタンに記述する

Private Sub CommandButton3_Click()
　　Dim comname As String
　　comname = "COM1"
　　check = rsio_open(comname)
　　dummy = rsio_INI
　　For i = 3 To 22
　　'差動入力１の変換結果（電圧値に換算）
　　adresult = AD_con(0) * 5 / 255 * 10
　　　 Cells(i, 3).Value = adresult
　　　　　 For j = 1 To 10000000: Next j
　　Next i
End Sub
Private Sub CommandButton5_Click()
　　'シルアルポートを閉じる
　　rsio_close

　　For i = 3 To 22
　　　 Cells(i, 3).Value = ""
　　Next i
End Sub

右上に続く　↑

'シリアルポートオープン
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String,
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As
Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal
hTemplateFile As Long) As Long
'シリアルポートクローズ
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'制御信号の直接操作
Declare Function EscapeCommFunction Lib "kernel32" (ByVal nCid As Long, ByVal nFunc As
Long) As Long
'入力制御信号の監視
Declare Function GetCommModemStatus Lib "kernel32" (ByVal hFile As Long, lpModemStat
As Long) As Long
Public Const CLRDTR = 6　　　　　　 'DTRをオフ（DATA IN端子をH）
Public Const SETDTR = 5　　　　　　 'DTRをオン（DATA IN端子をL）
Public Const CLRRTS = 4　　　　　　 'RTSをオフ（CLOCK端子をH）
Public Const SETRTS = 3　　　　　　 'RTSをオン（CLOCK端子をL）
Public Const MS_CTS_ON = &H10&　　　 'CTSのマスク（74LS390の出力チェック）
Public Const MS_DSR_ON = &H20&　　　 'DSRのマスク（入力データの読みとり）
Public hComm As Long　　　　　　　　'シリアルポートのハンドル番号
Function rsio_open(comname As String) As Boolean　　'シリアルポートをオープンする
　　Const GENERIC_READ = &H80000000
　　Const GENERIC_WRITE = &H40000000
　　Const OPEN_EXISTING = 3
　　dummy = CloseHandle(40)　　　 '開発が終わったら削除
　　hComm = CreateFile(comname, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING,
0, 0)
　　If hComm <> -1 Then rsio_open = True Else rsio_open = False
End Function
Function rsio_INI() As Boolean
　　For i = 0 To 20
　　　 clock_HL　　　　　　　　　　　'CLOCKを与える
　　　 If cs_check = 0 Then Exit For　　'74LS390の出力がLならぬける
　　Next i
　　For i = 0 To 20
　　　 clock_HL　　　　　　　　　　　'CLOCKを与える
　　　 If cs_check = 1 Then Exit For　　'74LS390の出力がHならぬける
　　Next i
End Function
Function AD_con(ch As Integer) As Integer
　　Dim inComm As Long
　　Dim j As Integer
　　Dim i As Integer
　　Dim ad As Integer
　　For j = 0 To 1　　　　　　　　 '差動の場合はODD/DIGNの値を変えて2回測定する
　　　 For i = 0 To 20
　　　　　clock_HL
　　　　　If cs_check = 0 Then Exit For　　'74LS390の出力をLにする
　　　 Next i
　　　 datain_H　　　　　　　　　 'STARBITをセットする
　　　 clock_HL
　　　 datain_L　　　　　　　　　 'SGL/DIFをセットする
　　　 clock_HL
　　　 If j = 0 Then　　　　　　　'ODD/SIGNをセットする
　　　　　datain_L　　　　　　　　　'１回目は0
　　　 Else
　　　　　datain_H　　　　　　　　　'２回目は1
　　　 End If
　　　 clock_HL
　　　 If ch = 0 Then　　　　　　　'SELECTをセットする
　　　　　datain_L　　　　　　　　　'チャネル0,1を使う
　　　 Else
　　　　　datain_H　　　　　　　　　'チャネル2,3を使う
　　　 End If
　　　 clock_HL
　　　 ad = 0
　　　 For i = 7 To 0 Step -1　　　　　　　　　　　'8回シフトして変換値を取得する
　　　　　clock_HL
　　　　　dummy = GetCommModemStatus(hComm, inComm)　'RS-232Cの状態を読みとる
　　　　　If (inComm And MS_DSR_ON) = 0 Then　　　　'変換結果を読みとる
　　　　　　　ad = ad + 2 ^ i　　　　　　　　　　　'重みを乗じてデータを蓄積する
　　　　　End If
　　　 Next i
　　　 For i = 0 To 2　　　　　　　　　　'CSをHにしてリセットする
　　　　　clock_HL
　　　 Next i
　　　 If ad <> 0 And j = 0 Then Exit For　'1回目の符号どおりであれば１回でやめる
　　　 ad = ad * -1　　　　　　　　　　　'２回目であればマイナスをつける
　　Next j
　　AD_con = ad
End Function