' IC-PCR1000を制御するためのソフトウェア
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{8793A1AD-BAD7-11D2-B724-0080450A4C5E}#1.0#0"; "HKCOMM6.OCX"
Begin VB.Form frmMain 
   Caption         =   "rcvcont"
   ClientHeight    =   3075
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   3735
   LinkTopic       =   "Form1"
   ScaleHeight     =   3075
   ScaleWidth      =   3735
   StartUpPosition =   3  'Windows の既定値
' 一時的にIC-PCR1000の受信を停止するコマンド
   Begin VB.CommandButton Command4 
      Caption         =   "Pause"
      Height          =   372
      Left            =   2760
      TabIndex        =   7
      Top             =   1320
      Width           =   732
   End
' シリアル通信用のモジュール
   Begin HKComm6Ctl.HKComm6 HKComm61 
      Left            =   720
      Top             =   2400
      _ExtentX        =   900
      _ExtentY        =   900
   End
' 割り込み処理用のタイマ
   Begin VB.Timer Timer2 
      Interval        =   10000
      Left            =   360
      Top             =   2400
   End
' 割り込み処理用のタイマ
   Begin VB.Timer Timer1 
      Interval        =   3000
      Left            =   0
      Top             =   2400
   End
' ソフトウェアの終了
   Begin VB.CommandButton Command3 
      Caption         =   "Exit"
      Height          =   372
      Left            =   2760
      TabIndex        =   3
      Top             =   1920
      Width           =   732
   End
' IC-PCR1000の受信を停止するコマンド
   Begin VB.CommandButton Command2 
      Caption         =   "Stop"
      Height          =   372
      Left            =   2760
      TabIndex        =   2
      Top             =   720
      Width           =   732
   End
' IC-PCR1000の受信を開始するコマンド
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Height          =   372
      Left            =   2760
      TabIndex        =   1
      Top             =   120
      Width           =   732
   End
   Begin MSComctlLib.StatusBar sbStatusBar 
      Align           =   2  '下揃え
      Height          =   270
      Left            =   0
      TabIndex        =   0
      Top             =   2805
      Width           =   3735
      _ExtentX        =   6588
      _ExtentY        =   476
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Text            =   "ｽﾃｰﾀｽ"
            TextSave        =   "ｽﾃｰﾀｽ"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   2
            TextSave        =   "00/11/10"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "23:46"
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   1680
      Top             =   2400
      _ExtentX        =   688
      _ExtentY        =   688
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList imlToolbarIcons 
      Left            =   1200
      Top             =   2400
      _ExtentX        =   794
      _ExtentY        =   794
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   13
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0000
            Key             =   "New"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0112
            Key             =   "Open"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0224
            Key             =   "Save"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0336
            Key             =   "Print"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0448
            Key             =   "Cut"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":055A
            Key             =   "Copy"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":066C
            Key             =   "Paste"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":077E
            Key             =   "Bold"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0890
            Key             =   "Italic"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":09A2
            Key             =   "Underline"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0AB4
            Key             =   "Align Left"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0BC6
            Key             =   "Center"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0CD8
            Key             =   "Align Right"
         EndProperty
      EndProperty
   End
   Begin VB.Label Label5 
      BorderStyle     =   1  '実線
      Height          =   732
      Left            =   120
      TabIndex        =   9
      Top             =   1560
      Width           =   2532
   End
   Begin VB.Label Label4 
      Caption         =   "Recv"
      Height          =   252
      Left            =   120
      TabIndex        =   8
      Top             =   1320
      Width           =   612
   End
   Begin VB.Label Label2 
      BorderStyle     =   1  '実線
      Height          =   252
      Left            =   120
      TabIndex        =   6
      Top             =   960
      Width           =   2532
   End
   Begin VB.Line Line1 
      X1              =   120
      X2              =   2640
      Y1              =   600
      Y2              =   600
   End
   Begin VB.Label Label3 
      Caption         =   "Status"
      Height          =   252
      Index           =   0
      Left            =   120
      TabIndex        =   5
      Top             =   720
      Width           =   732
   End
   Begin VB.Label Label1 
      Alignment       =   2  '中央揃え
      Appearance      =   0  'ﾌﾗｯﾄ
      BackColor       =   &H80000005&
      Caption         =   "R1000 Control Program"
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   2532
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File(&F)"
      Begin VB.Menu mnuFileOpen 
         Caption         =   "Open(&O)..."
      End
      Begin VB.Menu mnuFileProperties 
         Caption         =   "Pref(&I)"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "Exit(&X)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "Help(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "About(&A)"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal millls As Long)

Private Sub Command1_Click()
    ' シリアル通信の設定
    With HKComm61
        .PortNumber = Port3         ' ポート番号
        .BaudRate = Baud_9600bps    ' 伝送速度
        .HandShaking = None         ' ハンドシェイク無し
        .DataLen = Data8bit         ' データ長
        .ParityBit = NO_parity      ' パリティ無し無し
        .StopBitLen = Onebit        ' ストップビット長
        .ReceiveReqSize = 1         ' 1バイト受信する毎にOnCommイベントが発生して処理
        .CommError = 0              ' 受信エラーフラグのリセット
        .TxTimeOut = 5000           ' 送信タイムアウト時間
    End With
    
    ' シリアルポートオープン
    If HKComm61.PortOpen Then
        Label2.Caption = "Port open OK."
    Else
        ' 戻り値が 0 の場合はエラー
        Label2.Caption = "Port open error."
    End If

    ' 送信開始処理
    Dim SData(32) As Byte   ' 送信データ
    Dim i, j As Integer       ' ループカウンタ
    Dim text0(10)
    text0(1) = " " & Chr(13) & Chr(10)
    text0(2) = "H101" & Chr(13) & Chr(10)
    text0(3) = "G105" & Chr(13) & Chr(10)
    text0(4) = "G300" & Chr(13) & Chr(10) & "H1?" & Chr(13) & Chr(10)
    ' 送信データのセット
For j = 1 To 4
    For i = 0 To Len(text0(j)) - 1
        ' 送るデータをバイナリに変換
        SData(i) = AscB(Mid(text0(j), 1 + i, 1))
    Next i
    
    ' バッファにデータを転送
    If HKComm61.SendPutByte(SData(), Len(text0(j))) Then
        Label2.Caption = "Send data put OK."
    Else
        ' 戻り値が 0 の場合はエラー
        Label2.Caption = "Send data put error."
    End If
    
    ' データを送信
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK." & Chr(j + Asc("0"))
    Else
        ' 戻り値が 0 の場合はエラー
        Label2.Caption = "Send start error."
    End If
    
Sleep (10)
Next j
    
    ' シリアルポートクローズ
    If HKComm61.PortClose Then
        Label2 = "Port close OK."
    Else
        ' 戻り値が 0 の場合はエラー
        Label2 = "Port close error."
    End If
    
' 受信機が伝送速度を変えるための待ち
Sleep (500)
    
    With HKComm61
        .PortNumber = Port3
        ' IC-PCR1000は起動時は9.6kだが後は38.4kに速度が変わる
        .BaudRate = Baud_38400bps
        .HandShaking = None
        .DataLen = Data8bit
        .ParityBit = NO_parity
        .StopBitLen = Onebit
        .ReceiveReqSize = 1
        .CommError = 0
        .TxTimeOut = 5000
    End With
    
    If HKComm61.PortOpen Then
        Label2.Caption = "Port open OK."
    Else
        Label2.Caption = "Port open error."
    End If

' 受信機を起動する際のデフォルトデータ
' コマンドについては別ファイルを参照
Dim text1(31)
    text1(1) = "H101" & Chr(13) & Chr(10)
    text1(2) = "G4?" & Chr(13) & Chr(10)
    text1(3) = "G105" & Chr(13) & Chr(10)
    text1(4) = "G300" & Chr(13) & Chr(10)
    text1(5) = "H1?" & Chr(13) & Chr(10)
    text1(6) = "G301" & Chr(13) & Chr(10)
    text1(7) = "H1?" & Chr(13) & Chr(10)
    text1(8) = "GE?" & Chr(13) & Chr(10)
    text1(9) = "GD?" & Chr(13) & Chr(10)
    text1(10) = "K00080000000060400"
'    text1(11) = "J4100"    'SQL?
'    text1(12) = "J5100J5000"    '? / VSC?
'    text1(13) = "J4380J4500"   'IFSHIFT? / AGC?
'    text1(14) = "J4600J4700"   'NB? / ATT?
'    text1(15) = "J4A80LD82000"
'    text1(16) = "ME00001C8640100005000"    'BAND MON?
'    text1(17) = "J8001J8100J8200J8300"
    text1(18) = "J408E"     'VOL?
    text1(19) = "LE20050LE20040"
    text1(20) = "H1?" & Chr(13) & Chr(10)
    
For j = 1 To 20
    For i = 0 To Len(text1(j)) - 1
        SData(i) = AscB(Mid(text1(j), 1 + i, 1))
    Next i
Call Sleep(10)
    If HKComm61.SendPutByte(SData(), Len(text1(j))) Then
        Label2.Caption = "Send data put OK."
    Else
        Label2.Caption = "Send data put error."
    End If
    
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK." & Chr(j + Asc("0"))
    Else
        Label2.Caption = "Send start error."
    End If
Next j


' 割り込みタイマをイネーブル
Call HKComm61.ReceiveSpoolClear
        Timer1.Enabled = True
        Timer2.Enabled = True
End Sub

' 受信を一時停止する処理
Private Sub Command2_Click()
    
' 割り込みタイマをディセーブル
    Timer1.Enabled = False
    Timer2.Enabled = False
    
    Dim SData(32) As Byte
    Dim i As Integer
    text1 = "H100" & Chr(13) & Chr(10)
    
    For i = 0 To Len(text1) - 1
        SData(i) = AscB(Mid(text1, 1 + i, 1))
    Next i
    
    If HKComm61.SendPutByte(SData(), Len(text1)) Then
        Label2.Caption = "Send data put OK."
    Else
        Label2.Caption = "Send data put error."
    End If
    
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK."
    Else
        Label2.Caption = "Send start error."
    End If
    
    ' シリアルポートクローズ
    If HKComm61.PortClose Then
        Label2 = "Port close OK."
    Else
        Label2 = "Port close error."
    End If
End Sub

' プログラムを抜ける処理
Private Sub Command3_Click()
    Unload Me
End Sub

' プログラムを停止する処理
Private Sub Command4_Click()

' 割り込みタイマをディセーブル
    Timer1.Enabled = False
    Timer2.Enabled = False

    ' シリアルポートクローズ
    If HKComm61.PortClose Then
        Label2 = "Port close OK."
    Else
        ' 戻り値が 0 の場合はエラー
        Label2 = "Port close error."
    End If

End Sub

' ソフトがロードされた時の処理
Private Sub Form_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)

    ' 割り込みタイマをディセーブル
    Timer1.Enabled = False
    Timer2.Enabled = False
End Sub


' プログラムがアンロードされた時の処理
Private Sub Form_Unload(Cancel As Integer)

    ' 割り込みタイマをディセーブル
    Timer1.Enabled = False
    Timer2.Enabled = False

    ' シリアルポートクローズ
    If HKComm61.PortClose Then
        Label2 = "Port close OK."
    Else
        Label2 = "Port close error."
    End If

    With HKComm61
        .PortNumber = Port3
        .BaudRate = Baud_38400bps
        .HandShaking = None
        .DataLen = Data8bit
        .ParityBit = NO_parity
        .StopBitLen = Onebit
        .ReceiveReqSize = 1
        .CommError = 0
        .TxTimeOut = 5000
    End With
    
    If HKComm61.PortOpen Then
        Label2.Caption = "Port open OK."
    Else
        Label2.Caption = "Port open error."
    End If

    Dim SData(32) As Byte
    Dim i As Integer
    text1 = "H100" & Chr(13) & Chr(10)
    
    For i = 0 To Len(text1) - 1
        SData(i) = AscB(Mid(text1, 1 + i, 1))
    Next i
    
    If HKComm61.SendPutByte(SData(), Len(text1)) Then
        Label2.Caption = "Send data put OK."
    Else
        Label2.Caption = "Send data put error."
    End If
    
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK."
    Else
        Label2.Caption = "Send start error."
    End If
    
    If HKComm61.PortClose Then
        Label2 = "Port close OK."
    Else
        Label2 = "Port close error."
    End If
    
    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新規作成"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '新規作成' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '新規作成' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "開く"
            mnuFileOpen_Click
        Case "上書き保存"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '上書き保存' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '上書き保存' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "印刷"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '印刷' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '印刷' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "切り取り"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '切り取り' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '切り取り' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "ｺﾋﾟｰ"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: 'ｺﾋﾟｰ' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " 'ｺﾋﾟｰ' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "貼り付け"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '貼り付け' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '貼り付け' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "太字"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '太字' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '太字' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "斜体"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '斜体' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '斜体' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "下線"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '下線' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '下線' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "左揃え"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '左揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '左揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "中央揃え"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '中央揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '中央揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
        Case "右揃え"
            'ﾕｰｻﾞｰ ｺｰﾄﾞ: '右揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。
            MsgBox " '右揃え' ﾎﾞﾀﾝのｺｰﾄﾞを追加します。"
    End Select
End Sub

Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub HKComm61_OnComm()
    ' 受信割り込み発生時の処理
    
    Dim RData(4096) As Byte  ' 受信データのバッファ
    Dim i As Integer        ' ループカウンタ
    Dim Rlen As Long        ' 受信データのスプールサイズ
    
    
    ' 正常な受信割り込みか確認
    If HKComm61.CommError = 0 Then
        ' スプールサイズされているデータ量を得る
        Rlen = HKComm61.ReceiveSpoolSize
        ' 受信バッファより大きいスプールサイズは不可
        If Rlen > 4095 Then Rlen = 4095
        ' 受信バッファからスプールサイズ分のデータを取り出す
        If HKComm61.ReceiveGetByte(RData(), Rlen) Then
            Label2.Caption = "Receive data OK."
        Else
            '戻り値が 0 の場合はエラー
            Label2.Caption = "Receive data error."
        End If
        
        ' 受信データの表示
        For i = 0 To Rlen - 1
            Label5.Caption = Str(RData(i))
        Next i
    ' 受信異常処理
    Else
        ' エラーフラグのリセット
        HKComm61.CommError = 0
        ' 受信バッファのリセット
        If HKComm61.ReceiveSpoolClear Then
            Label2.Caption = "Receive spool clear OK."
        Else
            ' 戻り値が 0 の場合はエラー
            Label2.Caption = "Receive spool clear error."
        End If
    End If
End Sub

' HELPメニューを選択
Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

' EXITメニューを選択
Private Sub mnuFileExit_Click()
    ' フォームのアンロード
    Unload Me
End Sub

' プロパティメニューを選択（未使用）
Private Sub mnuFileProperties_Click()
    'ﾕｰｻﾞｰ ｺｰﾄﾞ: 'mnuFileProperties_Click' のｺｰﾄﾞを追加します。
    MsgBox " 'mnuFileProperties_Click' のｺｰﾄﾞを追加します。"
End Sub

' ファイルオープンメニューを選択（未使用）
Private Sub mnuFileOpen_Click()
    Dim sFile As String
    Dim text1 As String

    With dlgCommonDialog
        .DialogTitle = "開く"
        .CancelError = False
        'ﾕｰｻﾞｰ ｺｰﾄﾞ : ここで、ｺﾓﾝ ﾀﾞｲｱﾛｸﾞ ｺﾝﾄﾛｰﾙの属性とﾌﾗｸﾞを設定します。
        .Filter = "ﾃﾞｰﾀﾌｧｲﾙ (*.dat)|*.dat"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ﾕｰｻﾞｰ ｺｰﾄﾞ : ここに、開いたﾌｧｲﾙの処理を記述します。
Open sFile For Input As #1
Input #1, text1
Close #1

End Sub


' 受信機との接続を維持するためのタイマ処理
' 常にH1?+CR+LFを送る必要がある
Private Sub Timer1_Timer()

    Dim SData(32) As Byte
    Dim i As Integer
    text1 = "H1?" & Chr(13) & Chr(10)
    
    For i = 0 To Len(text1) - 1
        SData(i) = AscB(Mid(text1, 1 + i, 1))
    Next i
    
    If HKComm61.SendPutByte(SData(), Len(text1)) Then
        Label2.Caption = "Send data put OK."
    Else
        Label2.Caption = "Send data put error."
    End If
    
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK."
    Else
        Label2.Caption = "Send start error."
    End If
End Sub

' 受信機の周波数等を変更するためのタイマ処理
Private Sub Timer2_Timer()
    Dim SData(32) As Byte   ' 送信ﾃﾞｰﾀ配列(ﾊﾞｲﾄ型配列)
    Dim i As Integer        ' ﾙｰﾌﾟｶｳﾝﾀ
' デフォルトはNHK-FM
    text1 = "K00082500000060400LE20050LE20040"  '82.5MHz-WFM-230k
' 下記に幾つかデフォルトを示しておく
'    text1 = "K00082500000060300LE20050LE20040"  '82.5MHz-WFM-50k
'    text1 = "K00010000000020200LE20010LE20040"  '10MHz-AM-15k
'    text1 = "K00010000000020100LE20010LE20040"  '10MHz-AM-6k
'    text1 = "K00010000000020000LE20010LE20040"  '10MHz-AM-3k
'    text1 = "K00051000000050200LE20010LE20040"  '51MHz-FM-15k
'    text1 = "K00051000000050100LE20010LE20040"  '51MHz-FM-6k

' f0.datというファイルを開く
' この中にWebブラウザからCGIで送られたデータが保存されている
Open "f0.dat" For Input As #1

' 中身をdatに入れる
Input #1, dat

' ファイルを閉じる
Close #1

' 必要なデータの入っている先頭を見つける
' 中身はフォームにより送られたデータそのもの
snt1 = InStr(dat, "FRQ=")
snt2 = InStr(dat, "MOD=")
snt3 = InStr(dat, "FIL=")
snt4 = InStr(dat, "CNT=")

len0 = snt4 - 18

' 周波数データを作る
freq = Right$("00000000" & Mid$(dat, snt1 + 4, len0), 8)
' モードデータを作る
mode = Mid$(dat, snt2 + 4, 1)
' フィルタデータを作る
filt = Mid$(dat, snt3 + 4, 1)

' ワイドFMの場合はフィルタを1つ広くする
If mode = "6" Then
    filt = filt + 1
End If

' 設定を行うデータにする
text1 = "K" & freq & "0000" & mode & "0" & filt & "00LE20050LE20040"

    For i = 0 To Len(text1) - 1
        SData(i) = AscB(Mid(text1, 1 + i, 1))
    Next i
    
    If HKComm61.SendPutByte(SData(), Len(text1)) Then
        Label2.Caption = "Send data put OK."
    Else
        Label2.Caption = "Send data put error."
    End If
    
    If HKComm61.SendStart Then
        Label2.Caption = "Send start OK."
    Else
        Label2.Caption = "Send start error."
    End If
End Sub