'-----------------------------------------------------------------------------
'  ActiveBasicサンプル
'    電源器の制御パネル
'-----------------------------------------------------------------------------
'
'  1.構造体の定義 
'     シリアルポートの設定関数の定義
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long,ByRef lpDCB As DCB) As Long
'     タイムアウトの設定関数の定義
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long,ByRef lpCommTimeouts As COMMTIMEOUTS) As Long
'     DCB構造体の定義
Type DCB
        DCBlength As Long            '構造体のサイズ
        BaudRate As Long             'ボーレイト（bps）の設定
        fBitFields As Long           'ビット単位のフィールド定義
        wReserved As Integer         '予約（0をセットする）
        XonLim As Integer            '受信バッファ中のデータが何バイトになったらXon文字を送るかを指定
        XoffLim As Integer           '受信バッファの空きが何バイトになったらXoff文字を送るかを指定
        ByteSize As Byte             '1データのビット数を指定
        Parity As Byte               'パリティの方式を指定
        StopBits As Byte             'ストップビット数を指定
        XonChar As Byte              'Xon文字を指定
        XoffChar As Byte             'Xoff文字を指定
        ErrorChar As Byte            'パリティエラーの場合に使う文字を指定
        EofChar As Byte              '非バイナリモードの場合のデータ終了文字の指定
        EvtChar As Byte              'イベントを生成する文字を指定
End Type
'     COMMTIMEOUTS構造体の定義
Type COMMTIMEOUTS
        ReadIntervalTimeout As Long          '文字の読み込みの待ち時間
        ReadTotalTimeoutMultiplier As Long   '読み込みの１文字あたりの時間
        ReadTotalTimeoutConstant As Long     '読み込みの定数時間
        WriteTotalTimeoutMultiplier As Long  '書き込みの１文字あたりの時間
        WriteTotalTimeoutConstant As Long    '書き込みの定数時間
End Type

'  2.変数設定 
Dim hComm As Long
Dim stDCB As DCB
Dim timeOut As COMMTIMEOUTS
Const ID_TIMER=100
Dim st As SYSTEMTIME
Dim WORKLINE[100] As Byte 
Dim CMDLINE[100] As Byte 
Dim RECData[100] As Byte 
Dim fldpos As Long
Dim fldval[10] As Byte 
'  3.イベント
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function

Sub MainWnd_Destroy()
	WORK0012_DestroyObjects()
	PostQuitMessage(0)
	fldpos = 1
End Sub

Sub SET_VAL()
	If fldpos < 1 or fldpos > 3  then
		fldpos = 1
	End If

	If fldpos = 3 Then  
		SetWindowText(GetDlgItem(hMainWnd,EditBox3),fldval)					
		fldpos = 1
	Else If fldpos = 2 Then  
		SetWindowText(GetDlgItem(hMainWnd,EditBox2),fldval)					
		fldpos = 3
	Else If fldpos = 1 Then  
		SetWindowText(GetDlgItem(hMainWnd,EditBox1),fldval)					
		fldpos = 2
	End If
End Sub

Sub FUNC_REC()

	Dim dummy As Long
	Dim portname[6] As Byte	
	Dim fp_port As BytePtr

	Dim RECLen As Long

    portname[0] = 0
    lstrcpy(portname,"COM1") 
    hComm = CreateFile(portname, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hComm = -1 Then  
        fp_port = lstrcat(portname , "のオープンに失敗しました !") 
        MsgBox 0, fp_port         								
    End If
    
    '通信の設定
    stDCB.BaudRate = 9600                                   '転送速度の指定
    stDCB.ByteSize = 8                                      'ビット長の指定
    stDCB.fBitFields = &H3001                               'バイナリモードのフラグを有効にし
                                                            'RTSの制御を設定する（それ以外はFalseにする）
    stDCB.Parity = 0                                        'パリティの設定（パリティなし）
    stDCB.StopBits = 0                                      'ストップビット数を指定(1ビット)
    dummy = SetCommState(hComm, stDCB)                      '必要な部分だけ書き換える
     
    'タイムアウトの設定
    timeOut.ReadIntervalTimeout = 900                       '文字の読み込み待ち時間（ms）
    timeOut.ReadTotalTimeoutMultiplier = 0                  '読み込みの１文字あたりの時間
    timeOut.ReadTotalTimeoutConstant = 500                  '読み込みの定数時間（ms）
    timeOut.WriteTotalTimeoutMultiplier = 0                 '書き込みの１文字あたりの時間
    timeOut.WriteTotalTimeoutConstant = 500                 '書き込みの定数時間（ms）
    dummy = SetCommTimeouts(hComm, timeOut)                 'タイムアウトの設定
    

    'データの受信
    RECData[0] = 0
    dummy = ReadFile(hComm, RECData, 100, VarPtr(RECLen), ByVal 0)  
    dummy = CloseHandle(hComm) 
End Sub



Sub FUNC_TRAN()

	Dim dummy As Long
	Dim portname[6] As Byte	
	Dim fp_port As BytePtr
	Dim WORKLEN As Long  
	Dim TRANLEN As Long          
	Dim TRANDATA As BytePtr
	Dim cCrLf As BytePtr

    portname[0] = 0
    lstrcpy(portname,"COM1") 
    hComm = CreateFile(portname, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hComm = -1 Then  
        fp_port = lstrcat(portname , "のオープンに失敗しました !") 
        MsgBox 0, fp_port         								
    End If
    
    '通信の設定
    stDCB.BaudRate = 9600                                   '転送速度の指定
    stDCB.ByteSize = 8                                      'ビット長の指定
    stDCB.fBitFields = &H3001                               'バイナリモードのフラグを有効にし
                                                            'RTSの制御を設定する（それ以外はFalseにする）
    stDCB.Parity = 0                                        'パリティの設定（パリティなし）
    stDCB.StopBits = 0                                      'ストップビット数を指定(1ビット)
    dummy = SetCommState(hComm, stDCB)                      '必要な部分だけ書き換える
     
    'タイムアウトの設定
    timeOut.ReadIntervalTimeout = 500                       '文字の読み込み待ち時間（ms）
    timeOut.ReadTotalTimeoutMultiplier = 0                  '読み込みの１文字あたりの時間
    timeOut.ReadTotalTimeoutConstant = 500                  '読み込みの定数時間（ms）
    timeOut.WriteTotalTimeoutMultiplier = 0                 '書き込みの１文字あたりの時間
    timeOut.WriteTotalTimeoutConstant = 500                 '書き込みの定数時間（ms）
    dummy = SetCommTimeouts(hComm, timeOut)                 'タイムアウトの設定
    

    'データの送信
 '   WORKLINE[0]=0
 '   GetWindowText(GetDlgItem(hMainWnd,EditBox1),WORKLINE,100)
	TRANDATA=lstrcat(CMDLINE,Chr$(0))
    TRANLEN = lstrlen (TRANDATA)              				
    dummy = WriteFile(hComm, TRANDATA, TRANLEN, VarPtr(WORKLEN), ByVal 0)    
    dummy = CloseHandle(hComm)     
    WORKLINE[0]=0
End Sub


Sub MainWnd_CommandButton1_Click()
	Dim chkint As Long
	Dim MSGTMP[100] As Byte 
	Dim MSGLINE[100] As Byte 
	Dim status As Long
	status = 0
'  1.数値のエラーチェック
	GetWindowText(GetDlgItem(hMainWnd,EditBox1),WORKLINE,100)
	chkint = Val(WORKLINE) * 100
	If Asc(WORKLINE) < Asc("0") OR Asc(WORKLINE) > Asc("9") Then
		status = 3
	End If
	GetWindowText(GetDlgItem(hMainWnd,EditBox2),WORKLINE,100)
	chkint = chkint + Val(WORKLINE) * 10
	If Asc(WORKLINE) < Asc("0") OR Asc(WORKLINE) > Asc("9") Then
		status = 2
	End If
	GetWindowText(GetDlgItem(hMainWnd,EditBox3),WORKLINE,100)
	chkint = chkint + Val(WORKLINE) 
	If Asc(WORKLINE) < Asc("0") OR Asc(WORKLINE) > Asc("9") Then
		status = 1
	End If
	lstrcpy(MSGTMP,Str$(chkint))

'  2.ポートに出力する
	If status = 3 then
		lstrcpy(MSGLINE,"３桁目の数値を入力してください")
			SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)
	Else If status = 2 then
		lstrcpy(MSGLINE,"２桁目の数値を入力してください")
			SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)
	Else If status = 1 then
		lstrcpy(MSGLINE,"１桁目の数値を入力してください")
			SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)
	Else If chkint < 0 Then
		lstrcpy(MSGLINE,"設定された値（")
		lstrcat(MSGLINE,MSGTMP)
		lstrcat(MSGLINE,")が異常です")
		SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)

   	Else If chkint > 255 Then
		SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),"設定値を出力しました")
		lstrcpy(MSGLINE,"設定された値（")
		lstrcat(MSGLINE,MSGTMP)
		lstrcat(MSGLINE,")は、000〜255を超えています")
		SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)

	Else  
		lstrcpy(CMDLINE,"D")
		FUNC_TRAN()
		FUNC_REC()
		GetWindowText(GetDlgItem(hMainWnd,EditBox1),WORKLINE,100)
		lstrcpy(CMDLINE,WORKLINE)
		FUNC_TRAN()
		FUNC_REC()
		GetWindowText(GetDlgItem(hMainWnd,EditBox2),WORKLINE,100)
		lstrcpy(CMDLINE,WORKLINE)
		FUNC_TRAN()
		FUNC_REC()
		GetWindowText(GetDlgItem(hMainWnd,EditBox3),WORKLINE,100)
		lstrcpy(CMDLINE,WORKLINE)
		FUNC_TRAN()
		FUNC_REC()
		lstrcpy(CMDLINE,"E")
		FUNC_TRAN()
		FUNC_REC()
		lstrcpy(MSGLINE,"設定された値（")
		lstrcat(MSGLINE,MSGTMP)
		lstrcat(MSGLINE,")を出力しました")
		SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),MSGLINE)
		fldpos = 1
	End If
End Sub

Sub MainWnd_CommandButton2_Click()
	lstrcpy(CMDLINE,"D")
	FUNC_TRAN()
	FUNC_REC()
	lstrcpy(CMDLINE,"0")
	FUNC_TRAN()
	FUNC_REC()
	lstrcpy(CMDLINE,"0")
	FUNC_TRAN()
	FUNC_REC()
	lstrcpy(CMDLINE,"0")
	FUNC_TRAN()
	FUNC_REC()
	lstrcpy(CMDLINE,"E")
	FUNC_TRAN()
	FUNC_REC()
	SetWindowText(GetDlgItem(hMainWnd,EditBoxMSG),"出力をゼロにしました")

End Sub


Sub MainWnd_CommandButtonAC_Click()
	SetWindowText(GetDlgItem(hMainWnd,EditBox1),"0")
	SetWindowText(GetDlgItem(hMainWnd,EditBox2),"0")
	SetWindowText(GetDlgItem(hMainWnd,EditBox3),"0")
	fldpos = 1
End Sub

Sub MainWnd_CommandButtonA0_Click()
	lstrcpy(fldval,"0")
	SET_VAL()
End Sub

Sub MainWnd_CommandButtonA1_Click()
	lstrcpy(fldval,"1")
	SET_VAL()
End Sub


Sub MainWnd_CommandButtonA2_Click()
	lstrcpy(fldval,"2")
	SET_VAL()
End Sub

Sub MainWnd_CommandButtonA3_Click()
	lstrcpy(fldval,"3")
	SET_VAL()
End Sub


Sub MainWnd_CommandButtonA4_Click()
	lstrcpy(fldval,"4")
	SET_VAL()
End Sub

Sub MainWnd_CommandButtonA5_Click()
	lstrcpy(fldval,"5")
	SET_VAL()
End Sub


Sub MainWnd_CommandButtonA6_Click()
	lstrcpy(fldval,"6")
	SET_VAL()
End Sub

Sub MainWnd_CommandButtonA7_Click()
	lstrcpy(fldval,"7")
	SET_VAL()
End Sub


Sub MainWnd_CommandButtonA8_Click()
	lstrcpy(fldval,"8")
	SET_VAL()
End Sub

Sub MainWnd_CommandButtonA9_Click()
	lstrcpy(fldval,"9")
	SET_VAL()
End Sub