'-----------------------------------------------------------------------------
'  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
Dim WORKLINE[100] 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()
	WORK0006_DestroyObjects()
	PostQuitMessage(0)
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(WORKLINE,Chr$(00))
    TRANLEN = lstrlen (TRANDATA)              				
    dummy = WriteFile(hComm, TRANDATA, TRANLEN, VarPtr(WORKLEN), ByVal 0)    
    dummy = CloseHandle(hComm)     
End Sub


Sub MainWnd_CommandButton1_Click()
	lstrcpy(WORKLINE,"H") 
	FUNC_TRAN()
	lstrcpy(WORKLINE,"0") 
	FUNC_TRAN()
End Sub

Sub MainWnd_CommandButton2_Click()
	lstrcpy(WORKLINE,"L") 
	FUNC_TRAN()
	lstrcpy(WORKLINE,"0") 
	FUNC_TRAN()
End Sub

Sub MainWnd_CommandButton3_Click()
	lstrcpy(WORKLINE,"H") 
	FUNC_TRAN()
	lstrcpy(WORKLINE,"1") 
	FUNC_TRAN()
End Sub

Sub MainWnd_CommandButton4_Click()
	lstrcpy(WORKLINE,"L") 
	FUNC_TRAN()
	lstrcpy(WORKLINE,"1") 
	FUNC_TRAN()
End Sub