VB.NET-TIPS などプログラミングについて

標準コントロールのボタンは特によく使われると思いますが、 今回は、ボタンに画像を張付けの使い方について順を追って説明したいと思います。

• ボタン上の Image に画像を張り付ける方法
• 別の場所からボタンクリックを起動する方法
• ボタン全面に画像を張り付ける方法

■ボタン上の Image に画像を張り付ける方法

フォーム上にボタンを張り付けて、そのボタンの Image プロパティに画像を設定します。
（以下の図は、ボタンを張り付けたところまで）

次にボタンの Image プロパティの「…」ボタンをクリックします。リソースの選択ダイアログが開きます。

上のダイアログの「プロジェクト リソースファイル」の下の方の「インポート(M)」ボタンをクリックします。
以下のファイル選択ダイアログが開きますので、そこでペイント等の画像ソフトで作成しておいた画像ファイルを指定します。 （今回は簡単な矢印の画像のファイルを作成しました）

このダイアログの「開く」をクリックすると以下の様に画像がリストに反映されます。 矢印の画像ファイルが選択されている状態で、「OK」をクリックします。

そのボタンの Image プロパティに画像が設定されたことが分かります。 ここで TextImageRelation プロパティを適当な値（今回は ImageBeforeText）に設定します。 そうしますと左側のデザイン画面にも画像が表示されます。

以下のソースを見て下さい。 通常通りボタンのクリックイベントの処理を記述して、ボタンが働くことを確認します。

Public Class frmButton

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        MsgBox("Bitmapイメージを貼付したボタン")
    End Sub

End Class

これを実行すると以下の様な表示になります。

■別の場所からボタンクリックを起動する方法

別の処理からボタンのクリック処理を呼び出したい場合がありますが、 この時にはボタンの PerformClick メソッドをコールします。

次は、上記で張り付けたボタンのコピーをフォーム上で行います。 第2のボタンから最初のボタンクリックを呼出します。

Public Class frmButton

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        MsgBox("Bitmapイメージを貼付したボタン")
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        '別のボタンからクリックイベントを起動
        Me.Button1.PerformClick()
    End Sub
End Class

これを実行すると以下の様な表示になります。（下図は Button2 をクリックしたところです）

■ボタン全面に画像を張り付ける方法

新しいフォームにボタンを追加して、サイズを縦横 200 ピクセルぐらいとします。 さらにボタンの BackgroundImage に画像ファイルを指定します。
（以下の図は、ボタンを張り付けたところまで）

次にボタンの BackgroundImage プロパティの「…」ボタンをクリックします。リソースの選択ダイアログが開きます。 「ローカル リソース」をクリックします。

上のダイアログの「ローカル リソース」の「インポート(M)」ボタンをクリックします。
以下のファイル選択ダイアログが開きますので、そこでペイント等の画像ソフトで作成しておいた画像ファイルを指定します。 （今回は簡単な四角い画像のファイルを作成しました）

このダイアログの「開く」をクリックすると以下の様に画像がリストに反映されます。 さらに、「OK」をクリックします。

そのボタンの BackgroundImage プロパティに画像が設定されたことが分かります。 ここで FlatStyle プロパティを Flat に設定します。 そうしますと左側のデザイン画面にも画像が表示されます。

このままプログラムを実行してもボタンの画像は全体が表示されませんので、ボタンの画像描画などは自分で行うことになります。

フォームロード時にボタンのペイントイベントの処理ハンドラを登録します。
ペイントイベントでは、ボタンの背景画像をボタンのサイズに合わせて再描画します。 その後で、ボタンの Text プロパティに設定された文字列を、ボタンの中央に表示します。

背景画像の描画には Graphics.DrawImage メソッドを使用し、 文字列の描画には Graphics.DrawString メソッドを使用します。
文字列描画の Graphics.DrawString では StringFormat クラスを用いてボタンのTextを描画の位置指定します。

Public Class frmButton2

    Private Sub frmButton2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        'Button1のPaintイベントハンドラを追加
        AddHandler Button1.Paint, AddressOf Button1_Paint
    End Sub

    Private Sub Button1_Paint(sender As Object, e As PaintEventArgs)
        'ボタンの背景画像をボタンの大きさに合わせて描画
        e.Graphics.DrawImage(Me.Button1.BackgroundImage, Me.Button1.ClientRectangle)

        'StringFormatクラスを用いてボタンのTextを描画の位置指定
        Dim Sfrm As New StringFormat()
        '文字列の水平位置
        Sfrm.Alignment = StringAlignment.Center
        '文字列の垂直位置
        Sfrm.LineAlignment = StringAlignment.Center
        'ブラシの作成
        Dim Brs As Brush = New SolidBrush(Me.Button1.ForeColor)
        e.Graphics.DrawString(Me.Button1.Text, Me.Button1.Font, Brs, Me.Button1.ClientRectangle, Sfrm)
        'ブラシの解放
        Brs.Dispose()
        'StringFormatの解放
        Sfrm.Dispose()
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        MsgBox("イメージボタンをクリック")
    End Sub
End Class

これを実行すると以下の様な表示になります。

関連する記事

フォーム上に各種のコントロールを配置する場合に、パネルを使ってグループ分けを行うことはよくあります。
そこで今回は、の使い方について順を追って説明したいと思います。

• パネル上のコントロールを一括 Enabled/Disabled 設定
• パネル上の個別のコントロールの Enabled/Disabled 設定との関係
• パネル上のテキストボックス一括クリア

■パネル上のコントロールを一括 Enabled/Disabled 設定

フォーム上にパネルを張り付けて、そのパネルの上に5個のテキストボックスを張り付けています。 更にパネルへの処理を行う為に1個のボタンを配置します。

以下のソースを見て下さい。 ボタンのクリックイベントでパネルの Enabled の値を反転しています。
パネルへの Enabled 値を設定することで、パネルの上のコントロールを全て不可設定にできます。 これは結構便利だと思います。

Public Class frmPanel1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'パネルの「Enabled」を反転設定
        Me.Panel1.Enabled = Not (Me.Panel1.Enabled)
    End Sub
End Class

これを実行すると以下の様な表示になります。右側はボタンをクリックしてパネルを Disabled にした状態です。

■パネル上の個別のコントロールの Enabled/Disabled 設定との関係

次は、パネルのテキストボックスの直前にチェックボックスを配置して、デフォルトとして Checked の状態にします。 それぞれのチェックボックスの変化でテキストボックスの許可を設定してやります。

Public Class frmPanel2

    'パネルの「Enabled」を反転
    Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
        Me.Panel1.Enabled = Not (Me.Panel1.Enabled)
    End Sub

    'チェックボックスの「Checked」をパネルの「Enabled」に設定
    Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
        Me.TextBox1.Enabled = Me.CheckBox1.Checked
    End Sub

    Private Sub CheckBox2_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox2.CheckedChanged
        Me.TextBox2.Enabled = Me.CheckBox2.Checked
    End Sub

    Private Sub CheckBox3_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox3.CheckedChanged
        Me.TextBox3.Enabled = Me.CheckBox3.Checked
    End Sub

    Private Sub CheckBox4_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox4.CheckedChanged
        Me.TextBox4.Enabled = Me.CheckBox4.Checked
    End Sub

    Private Sub CheckBox5_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox5.CheckedChanged
        Me.TextBox5.Enabled = Me.CheckBox5.Checked
    End Sub
End Class

これを実行すると以下の様な表示になります。 右側は1個目と、4個目のチェックボックスをOFFにしてテキストボックスを Disabled にした後で、 ボタンをクリックしてパネルを Disabled にした状態です。

パネルの Enabled を Disable にした場合にはパネル上のコントロールの状態のまま不可状態（パネル全体に灰色）になります。 再度ボタンをクリックすれば、元の状態になることが分かります。

■パネル上のテキストボックス一括クリア

上記のフォームにボタンを追加して、そのボタンクリック時の処理として、パネル上のテキストボックスを全てクリアする方法を示します。
パネルにはその上に存在するコントロールを Controls プロパティに持っているので、 それを For Each 文で順次取得し、取得されたテキストボックスに対して処理を行います。

Public Class frmPanel3

    'パネルの「Enabled」を反転
    Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
        Me.Panel1.Enabled = Not (Me.Panel1.Enabled)
    End Sub

    'チェックボックスの「Checked」をパネルの「Enabled」に設定
    Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
        Me.TextBox1.Enabled = Me.CheckBox1.Checked
    End Sub

    Private Sub CheckBox2_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox2.CheckedChanged
        Me.TextBox2.Enabled = Me.CheckBox2.Checked
    End Sub

    Private Sub CheckBox3_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox3.CheckedChanged
        Me.TextBox3.Enabled = Me.CheckBox3.Checked
    End Sub

    Private Sub CheckBox4_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox4.CheckedChanged
        Me.TextBox4.Enabled = Me.CheckBox4.Checked
    End Sub

    Private Sub CheckBox5_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox5.CheckedChanged
        Me.TextBox5.Enabled = Me.CheckBox5.Checked
    End Sub

    'パネル上のテキストボックスをクリア
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        'パネルに貼ってある全てのコントロールを取得
        For Each obj In Me.Panel1.Controls
            If TypeOf obj Is TextBox Then
                'コントロールが TextBox の場合、Textクリア
                DirectCast(obj, TextBox).Text = ""
            End If
        Next
    End Sub

End Class

これを実行すると以下の様な表示になります。 左側は1個目と2個目、4個目のテキストボックスに値を入力した後で、ボタンをクリックしてパネルを Disabled にした状態です。
その後、「Panel 上の TextBox クリア」のボタンをクリックした様子が右側の図となります。

関連する記事

フォーム上のコントロールへのイベント処理を宣言する場合には AddHandler メソッドを使うことを以下の記事で紹介しました。

⇒コントロールの同じイベント処理に複数の関連付けをテスト：[AddHandler,DirectCast]

この記事の中で、各イベントの処理を1個の関数で処理できることを示しましたが、そのなかでは同じ処理を行っていました。 今回はこの関数の中でそれぞれのコントロールに対して内部で処理を分けることで、 同じコントロールのイベント関数としては入口は１個ですが、別々の処理を記述できます。 これはコントロールを配列で処理する方法の逆のアプローチになると思います。

⇒コントロールを配列で処理する方法　　　　　：[AddHandler,DirectCast]

今回のソースでは KeyPress イベント用関数を追加し、テキストボックスコントロールのそのイベントに関連付けます。 KeyPress イベント用関数のなかでは、どのテキストボックスから呼ばれたのかを判別する為、 呼び出し元オブジェクトの sender の名前 name を使って場合分けします。
今後、テキストボックスが増えた場合にはこの判定と、その処理を追加することになります。

フォーム上のコントロールのイベント処理の一括関連付けその２

Public Class frmAddHandler2

    ' フォームロードイベント
    Private Sub frmAddHandler_Load(sender As Object, e As EventArgs) Handles Me.Load
        'コントロールへのイベントハンドラ関連付け
        Call Me.SetEvent(Me.Controls)
        'フォームがすべてのキー イベントを受け取る
        Me.KeyPreview = True
    End Sub

    ' コントロールへのイベントハンドラ関連付け
    ' param CtrlColl    :コントロールコレクション
    Private Sub SetEvent(ByVal CtrlColl As Control.ControlCollection)
        'コントロール変数
        Dim objControl As Control
        'テキストボックスコントロール変数
        Dim objTextBox As TextBox

        'コントロールがある分だけループ
        For Each objControl In CtrlColl
            If TypeOf objControl Is TextBox Then
                'テキストボックスコントロールに変換
                objTextBox = DirectCast(objControl, TextBox)
                'Enterイベントの関連付け
                AddHandler objTextBox.Enter, AddressOf CtrlEnterEvent
                'Changedイベントの関連付け
                AddHandler objTextBox.TextChanged, AddressOf CtrlTextChangedEvent
                'KeyPressイベントの関連付け
                AddHandler objTextBox.KeyPress, AddressOf CtrlTextKeyPressEvent
            Else
            End If
        Next
    End Sub

    ' コントロールのEnterイベント処理
    Private Sub CtrlEnterEvent(ByVal sender As Object, ByVal e As System.EventArgs)
        If TypeOf sender Is TextBox Then
            'TextBoxのとき
            DirectCast(sender, TextBox).SelectAll()
        End If
    End Sub

    ' コントロールのTextChangedイベント処理
    Private Sub CtrlTextChangedEvent(ByVal sender As Object, ByVal e As System.EventArgs)
        If TypeOf sender Is TextBox Then
            'TextBoxのとき
            Dim objTextBox As TextBox = DirectCast(sender, TextBox)
            '仮の処理として表示内容をTagに退避
            objTextBox.Tag = objTextBox.Text
        End If
    End Sub

    ' コントロールのKeyPressイベント処理(1カ所で集中管理する)
    Private Sub CtrlTextKeyPressEvent(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs)
        'コントロールの名前により処理を分ける
        Select Case sender.name
            Case "TextBox1"
                '[TextBox1]は数字のみ入力とする
                If Not ("0" <= e.KeyChar And e.KeyChar <= "9") Then
                    e.Handled = True
                End If

            Case "TextBox2"
                '[TextBox2]は英字大文字の A ～ Z のみ入力とする
                If Not ("A" <= e.KeyChar And e.KeyChar <= "Z") Then
                    e.Handled = True
                End If

            Case "TextBox3"
                '[TextBox3]は英字子文字の a ～ z のみ入力とする
                If Not ("a" <= e.KeyChar And e.KeyChar <= "z") Then
                    e.Handled = True
                End If
        End Select
    End Sub

    ' フォームKeyDownイベント
    Private Sub frmEnterNext_KeyDown(ByVal sender As Object, _
                                  ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
        If e.KeyCode = Keys.Enter Then
            If e.Control = False Then
                '[Enter]キーで次の TabIndex があるコントロールへフォーカスを移す
                Me.SelectNextControl(Me.ActiveControl, Not e.Shift, True, True, True)
            End If
        End If
    End Sub

    ' フォームKeyPressイベント
    Private Sub frmEnterNext_KeyPress(ByVal sender As Object, _
                                    ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
        If e.KeyChar = ControlChars.Cr Then
            '[Enter]キーで音が出るので、キーイベントが処理されたことにして音を消す
            e.Handled = True
        End If
    End Sub

End Class

これを実行すると以下の様に TextBox1 には数字のみ TextBox2 には英大文字（"A"～"Z"）のみ TextBox3 には英子文字（"a"～"z"）のみ、の入力ができます。

今回の方法は、とにかく同じコントロールの同じイベント処理を１個の関数で集中的に処理したい場合には有効だと思います。 テキストボックスのそれぞれのイベントで記述すれば同じじゃないかという突っ込みはあると思いますが．．．

関連する記事

以前、以下の記事でテキストボックスの入力される文字を数字のみに限定するコントロールについて記述しましたが、 このコントロールは数値入力には適さないので、今回は少し使える様に入力の見た目は電卓の感じにしてみました。 （数字が１の位から左側へシフトしていきます。）

今回のコントロールの動きは以下の様になります。

• 数値の表示は３桁毎にカンマ編集での表示とする。
• カーソル（キャレット）は常にコントロールの右端に存在し動かない。 （矢印キーは動作しない）
• マイナス値は「-」(マイナスキー)を押下することで数値をプラスとマイナスを反転する。
• 「BackSpace」キーで最終文字を削除する。
• クリップボードからのペーストは出来ない様にする。

前回のコントロールでは KeyPress イベントで入力されたキーの制御をしていましたが、 今回はほとんどの処理を KeyDown イベントで行い、 KeyPress イベントでの処理は全て行わない様にします。
今回の処理ではテキストボックスの Text プロパティへの再表示を自分で強制的に行っているため、 KeyPress イベントでの処理をスキップしないと表示がおかしくなるためです。 （文字がダブって表示されたりします）

今回の処理で肝となる KeyDown イベントでは以下のキー処理を行います。

• [Enter]：[Ctrl]キーが押下されていない場合、自分の親のコントロールの次のフォーカスへ移動
• [↑][↓][←][→]：矢印キーは処理無し（キーを捨てる）
• [0]～[9]：入力文字列が数値桁数を超えない場合にカンマ編集表示
• [-]：数値のプラス、マイナスの反転処理
• [BackSpace]：最終文字を削除
• その他のキー：処理無し（キーを捨てる）

尚、クリップボードからのペースト処理をしない様に WndProc をオーバーライドしペーストのメッセージを処理しない様にしています。

テキストボックスの電卓の様な入力コントロールクラス

Public Class ClsNumTextBox3
    Inherits TextBox

    '数値桁数("-",","を含まない数値の桁数)
    Private _NumericUnits As Integer = 9
    '数値マイナスフラグ
    Private _fMinus As Boolean = False

    'クリップボード貼付メッセージ
    Const WM_PASTE As Integer = &H302

    ''' 

    ''' コンストラクタ
    ''' 
    Public Sub New()
        MyBase.New()
        'IMEを無効にする
        MyBase.ImeMode = ImeMode.Disable
        'MaxLengthは取り敢えず16を設定
        Me.MaxLength = 16
        'テキストは右寄せ
        Me.TextAlign = HorizontalAlignment.Right
    End Sub

    ''' 

    ''' WndProc メソッド(クリップボード処理の為)
    ''' 
    ''' <param name="m">メッセージ</param>
    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_PASTE
                'クリップボードからのコピーは処理しない
                Return
        End Select

        'メッセージのデフォルト処理を呼出す
        MyBase.WndProc(m)
    End Sub

    ''' 

    ''' 数値桁数プロパティ
    ''' 
    Public WriteOnly Property NumericUnits As Integer
        Set(value As Integer)
            Me._NumericUnits = value   '退避値に設定
        End Set
    End Property

    ''' 

    ''' 数値での取得設定プロパティ
    ''' 
    ''' 設定値
    ''' 取得値
    Public Property Value As Decimal
        Set(value As Decimal)
            Dim strNum As String = Math.Abs(value).ToString
            If strNum.Length > Me._NumericUnits Then
                MsgBox("ERR:数値桁数 " & Me._NumericUnits & " より大きい値が設定された")
            Else
                Me._fMinus = (value < 0)    'マイナスフラグ設定
                Me.Text = strNum            '取敢えず数値文字列設定
                Call Me.RepairNumString("", Me._fMinus)
            End If
        End Set
        Get
            '文字列からカンマ除去
            Dim strNum As String = Me.Text.Replace(",", "")
            'Decimal変換値を返す
            Return ToDec(strNum)
        End Get
    End Property

    ''' 

    ''' KeyDownイベントの処理
    ''' 
    Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
        MyBase.OnKeyDown(e)

        Dim strAdd As String = ""
        Dim fEdit As Boolean = False

        'キーコードによる処理
        Select Case e.KeyCode
            Case Keys.Enter
                If e.Control = False Then
                    '[Ctrl]キーが押下されていない場合、自分の親のコントロールの次のフォーカスへ移動
                    Me.Parent.SelectNextControl(Me, Not e.Shift, True, True, True)
                End If

            Case Keys.Up, Keys.Down, Keys.Left, Keys.Right
                e.Handled = True

            Case Keys.D0 To Keys.D9, Keys.NumPad0 To Keys.NumPad9
                'キーが [0]～[9]
                '入力文字列が数値桁数を超えないかチェック
                Dim strNum As String = Me.Text.Replace("-", "").Replace(",", "")
                If strNum.Length >= Me._NumericUnits Then
                    e.Handled = True
                Else
                    Select Case e.KeyCode
                        Case Keys.D0 To Keys.D9
                            strAdd = "0123456789".Substring(e.KeyCode - Keys.D0, 1)
                        Case Keys.NumPad0 To Keys.NumPad9
                            strAdd = "0123456789".Substring(e.KeyCode - Keys.NumPad0, 1)
                    End Select
                    fEdit = True            '編集表示フラグON
                    e.Handled = True
                End If

            Case Keys.Subtract
                'キーが [-]
                Me._fMinus = Not Me._fMinus 'マイナスフラグ反転
                fEdit = True                '編集表示フラグON

            Case Keys.Back
                '最後尾1文字削除
                RepairNumString("", Me._fMinus, True)
                Me.SelectionStart = Me.Text.Length
                If Me.Text.Length = 0 Then
                    '文字列が空になった場合はマイナスフラグOFF
                    Me._fMinus = False
                End If
                e.Handled = True

            Case Else
                e.Handled = True

        End Select

        If fEdit = True Then
            '編集表示フラグONの場合、編集表示
            Call Me.RepairNumString(strAdd, Me._fMinus)
            Me.SelectionStart = Me.Text.Length
        End If
    End Sub

    ''' 

    ''' KeyPressイベントの処理
    ''' 
    Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
        MyBase.OnKeyPress(e)

        '全ての文字をイベントをキャンセル
        e.Handled = True
    End Sub

    ''' 

    ''' MouseDownイベント処理
    ''' 
    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        MyBase.OnMouseDown(e)
        If Not (Me.SelectionStart = Me.Text.Length) Then
            'カーソル位置を最後尾に強制移動
            Me.SelectionStart = Me.Text.Length
        End If
    End Sub

    ''' 

    ''' 文字列の編集表示
    ''' 
    ''' <param name="strAdd">最後尾付加文字</param>
    ''' <param name="fMinus">数値マイナスフラグ</param>
    ''' <param name="fBackSpace">BACKSPACEフラグ</param>
    ''' 文字列を3桁ごとにカンマ編集する
    Private Sub RepairNumString(ByVal strAdd As String,
                                ByVal fMinus As Boolean,
                                Optional fBackSpace As Boolean = False)
        '文字を最後に追加する
        Dim strNum As String = Me.Text.Replace("-", "").Replace(",", "") & strAdd
        If fBackSpace = True Then
            'BackSpaceの指定の場合、最後の文字を削除
            If strNum <> "" Then
                strNum = strNum.Substring(0, strNum.Length - 1)
            End If
        End If
        '3桁ごとのカンマ表示
        Dim str As String = Me.ToDec(strNum).ToString("#,###")
        'マイナスの場合は"-"付加
        If fMinus = True Then
            If str <> "" Then
                str = "-" & str
            End If
        End If
        Me.Text = str
        'マイナスの場合は赤色設定
        If fMinus = True Then
            If Not Me.ForeColor = Color.Red Then
                Me.ForeColor = Color.Red
            End If
        Else
            If Not Me.ForeColor = Color.Black Then
                Me.ForeColor = Color.Black
            End If
        End If
    End Sub

    ''' 

    ''' 文字列をDecimal数値変換
    ''' 
    ''' <param name="str">文字列</param>
    ''' 変換後の数値
    Private Function ToDec(ByVal str As String) As Decimal
        Dim dec As Decimal = 0
        Try
            If str <> "" Then
                dec = CDec(str)
            End If
        Catch ex As Exception
        End Try
        Return dec
    End Function

End Class

今回のコントロールを２個とボタンをフォームに張り付け、 そのボタンで１個目の数値を２個目の数値コントロールにコピーを行う例を以下に示します。

電卓風数値入力コントロールの例

Public Class frmTextBox3

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Try
            Dim dec As Decimal = Me.NumTextBox1.Value
            Me.NumTextBox2.Value = dec
        Catch ex As Exception
        End Try
    End Sub

End Class

ボタンを押下することで、上のコントロールの Value プロパティから値を取得し、 その値を下のコントロールの Value プロパティに設定します。 その結果、値がコピーされたことが分かります。 （上の画像は先にマイナス値をコピーした後で、上のコントロールで「-」キーを押下した様子です）

関連する記事

シリアル通信を利用して外部装置とデータの送受信を行う場合、パソコン側が主で、外部装置が従となる関係が多いと思います。 外部装置は、パソコン側から送信されてくるコマンドに対応して処理等を行い、処理結果を返してくるやり方です。

私の経験上、この外部装置との通信で多いのはシーケンサ（PLC）等とのデータの送受信がありました。 シーケンサはメーカ毎にデータの送受信を行うコマンドが全く異なります。 その為、各メーカ毎のコマンドの規約に合わせて処理を行う様にプログラムするわけです。

今回の例は、下図の様なPLCからのデータ読み出しと書込みの簡単なコマンドを想定しています。

読み出しコマンドも書き込みコマンドも、最初にPLC側にコマンドを送信し、結果を受信することを想定しています。
さて、このコマンドを処理するクラスを作成するのですが、今までのクラスを大部分生かすわけですが、 以下のメソッドを作成します。

• Open シリアルポートのオープン処理を行う。(今までと同様)
• Close シリアルポートのクローズ処理を行う。(今までと同様)
• ReadData PLCのアドレスを与えて、PLCデータの読込処理を行う。
• WriteData PLCのアドレス・データを与えて、PLCデータへの書込処理を行う。

今回のクラスにおいてデータ受信ハンドラの処理内では、専ら応答データを受信することとしています。 受信データの最終文字としての CR(0DH) を検知した時点で応答受信が在ったものとしています。

ReadData WriteData 共に最初にPLC側にコマンドを送信しますので、 この部分を別関数 SendData として宣言しています。 また、応答受信用には別関数 ReceiveData として宣言しています。

ReceiveData では応答受信を待つために、100msecの待ちをシステムの Sleep 関数で50回ループしています。 そのループの中に応答受信フラグがONするのをみて、受信が在ったことを検知しています。 （この待ち時間を短くすればプログラムの応答速度はよくなります。）

SerialPortコントロールの使い方その６(シリアル通信クラス・ハンドシェィク受信クラス)

Imports System.IO.Ports

''' -----------------------------------------------------------------------
''' 

''' シリアル通信クラス・ハンドシェィク受信
''' 
''' -----------------------------------------------------------------------
Public Class ClsSerialRcvHandshake
    ''' 

    ''' シリアルポートクラス
    ''' 
    ''' 
    Private SerialPort As SerialPort

    ''' 

    ''' コマンド応答受信フラグ
    ''' 
    ''' 
    ''' コマンドを送信した後での応答を受信したフラグ。送受信文字列のターミネータ[ETX]（0x03）を発見した時にオンする
    ''' 
    Private fRxResponse As Boolean = False

    ''' 

    ''' 読込データ格納先
    ''' 
    ''' データ受信イベントで蓄えられる
    Private RxBuf() As Byte

    ''' 

    ''' エラーメッセージ
    ''' 
    Private strLastError As String = ""

    ''' 

    ''' 応答メッセージ
    ''' 
    Private strLastResponse As String = ""

    ''' 

    ''' 送受信文字列のターミネータ（0x0d）
    ''' 
    Private Const CMD_TERM As Byte = &HD

    ''' -----------------------------------------------------------------------
    ''' 

    ''' コンストラクタ
    ''' 
    ''' <param name="SerialPort">シリアルポートコントロール</param>
    ''' -----------------------------------------------------------------------
    Sub New(ByVal SerialPort As SerialPort)
        'シリアルポートの退避
        Me.SerialPort = SerialPort
        '受信イベントのハンドラ設定
        AddHandler Me.SerialPort.DataReceived, AddressOf DataReceivedHandler
    End Sub

    ''' -----------------------------------------------------------------------
    ''' 

    ''' エラーメッセージプロパティ
    ''' 
    ''' -----------------------------------------------------------------------
    ReadOnly Property LastError As String
        Get
            Return Me.strLastError
        End Get
    End Property

    ''' -----------------------------------------------------------------------
    ''' 

    ''' 応答メッセージプロパティ
    ''' 
    ''' -----------------------------------------------------------------------
    ReadOnly Property LastResponse As String
        Get
            Return Me.strLastResponse
        End Get
    End Property

    ''' -----------------------------------------------------------------------
    ''' 

    ''' ポートオープン
    ''' 
    ''' True:正常終了, False:エラー
    ''' -----------------------------------------------------------------------
    Function Open() As Boolean
        '戻り値初期化
        Open = False
        Try
            'ポートチェック
            If Me.SerialPort.IsOpen = False Then
                '未オープンならば、オープンする

                'ポート設定(ここは通信相手に合わせる)
                Me.SerialPort.PortName = "COM7"
                Me.SerialPort.BaudRate = 9600
                Me.SerialPort.DataBits = 8
                Me.SerialPort.Parity = Parity.None
                Me.SerialPort.StopBits = StopBits.One
                'オープン
                Me.SerialPort.Open()
            End If
            '結果を返す
            Open = Me.SerialPort.IsOpen

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 

    ''' ポートクローズ
    ''' 
    ''' True:正常終了, False:エラー
    ''' -----------------------------------------------------------------------
    Function Close() As Boolean
        '戻り値初期化
        Close = False
        Try
            'ポートチェック
            If Me.SerialPort.IsOpen = True Then
                'オープン済みならば、クローズする
                Me.SerialPort.Close()
            End If
            '結果を返す
            Close = Not (Me.SerialPort.IsOpen)

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 

    ''' データ受信ハンドラ
    ''' 
    ''' 
    ''' [STX]から始まるデータをコマンドバッファに格納し[ETX]受信時に文字列に変換
    ''' 
    ''' -----------------------------------------------------------------------
    Private Sub DataReceivedHandler(sender As Object, e As SerialDataReceivedEventArgs)
        Try
            Dim SP As SerialPort = CType(sender, SerialPort)

            'バッファのバイト数チェック
            Dim DataLen As Integer = SP.BytesToRead
            If DataLen = 0 Then
                Exit Sub
            End If

            'データ長チェック
            If DataLen > 4096 Then
                DataLen = 4096
            End If

            '読込バッファの確保
            Dim Buf(DataLen) As Byte
            '読込
            SP.Read(Buf, 0, DataLen)
            '
            If RxBuf Is Nothing Then
                '格納バッファの領域確保
                RxBuf = Array.CreateInstance(GetType(Byte), DataLen)
                'コピー
                Array.Copy(Buf, RxBuf, DataLen)
            Else
                '後ろに追加する
                Dim Length As Integer = RxBuf.Length
                ReDim Preserve RxBuf(Length + DataLen - 1)
                Buf.CopyTo(RxBuf, Length)
            End If

            '格納先の最後の文字が「CR」(0x0d)か確認する
            If RxBuf(UBound(RxBuf)) = CMD_TERM Then
                'コマンド応答受信フラグON
                Me.fRxResponse = True
            End If

        Catch ex As Exception
            'エラー処理
        End Try
    End Sub

    ''' -----------------------------------------------------------------------
    ''' 

    ''' 接点エリアリード
    ''' 
    ''' <param name="Addr">接点アドレス(4文字:[10^3][10^2][10^1][16^0]</param>
    ''' <param name="Data">接点データ</param>
    ''' 応答受信結果(True:OK, False:NG)
    ''' 
    ''' 送信コマンド:"RD" + NNNN + CR
    ''' 受信コマンド:"OK" + MMMM + CR ⇒ データが正常の場合(MMMM:データ値)
    ''' 　　　　　　:"NG" + 0000 + CR ⇒ データがエラーの場合(エラーでは0000:ゼロ)
    ''' 
    ''' -----------------------------------------------------------------------
    Public Function ReadData(ByVal Addr As String, ByRef Data As Integer) As Boolean
        '戻り値初期化
        ReadData = False
        Try
            '最終応答,エラーをクリア
            Me.strLastResponse = ""
            Me.strLastError = ""

            '接点NOの4文字チェック
            If Addr.Length <> 4 Then
                Exit Function
            End If
            '送信コマンド生成
            Dim strCMD As String = "RD" & Addr

            'コマンド送信
            If Me.SendData(strCMD) = False Then
                Return False
            End If

            'コマンド受信
            Dim strRX As String = ""
            If Me.ReceiveData(strRX) = False Then
                Return False
            End If
            '最終応答を退避
            Me.strLastResponse = strRX

            '接点結果を返す
            If strRX.Substring(0, 2) = "OK" Then
                'データ値をInteger変換
                Data = CInt(strRX.Substring(2, 4))
                '正常を返す
                ReadData = True
            Else
                'エラー受信
                Me.strLastError = "NG応答"
            End If

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 

    ''' 接点への書込み
    ''' 
    ''' <param name="Addr">接点アドレス(4文字:[10^3][10^2][10^1][16^0]</param>
    ''' <param name="Data">接点データ</param>
    ''' 応答受信結果(True:OK, False:NG)
    ''' 
    ''' 送信コマンド:"WR" + NNNN + ":" + MMMM + CR
    ''' 受信コマンド:"OK" + CR ⇒ 書込み正常の場合
    ''' 　　　　　　:"NG" + CR ⇒ 書込みエラーの場合
    ''' 
    ''' -----------------------------------------------------------------------
    Public Function WriteData(ByVal Addr As String, ByVal Data As Integer) As Boolean
        '戻り値初期化
        WriteData = False
        Try
            '最終応答,エラーをクリア
            Me.strLastResponse = ""
            Me.strLastError = ""

            'アドレス4文字チェック
            If Addr.Length <> 4 Then
                Exit Function
            End If
            '送信コマンド生成
            Dim strCMD As String = "WR" & Addr & ":" + Data.ToString("0000")

            'コマンド送信
            If Me.SendData(strCMD) = False Then
                Return False
            End If

            'コマンド受信
            Dim strRX As String = ""
            If Me.ReceiveData(strRX) = False Then
                Return False
            End If
            '最終応答を退避
            Me.strLastResponse = strRX

            '接点結果を返す
            If strRX.Substring(0, 2) = "NG" Then
                'エラー受信
                Me.strLastError = "NG応答"
                'エラーを返す
                Return False
            End If

            '正常を返す
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 

    ''' コマンド送信
    ''' 
    ''' <param name="strSend">送信文字列</param>
    ''' 送信結果(True:OK, False:NG)
    ''' 
    ''' -----------------------------------------------------------------------
    Private Function SendData(ByVal strSend As String) As Boolean
        '戻り値初期化
        SendData = False
        Try
            'ポートオープンチェック
            If Me.SerialPort.IsOpen = False Then
                Return False
            End If

            'Shift JISとしてバイト型配列に変換
            Dim bytesData As Byte()
            bytesData = System.Text.Encoding.GetEncoding(932).GetBytes(strSend)

            'CRの1バイト分領域拡張
            Dim nIdx As Integer = UBound(bytesData)
            ReDim Preserve bytesData(nIdx + 1)
            bytesData(nIdx + 1) = CMD_TERM

            'コマンド応答受信フラグOFF
            Me.fRxResponse = False

            'コマンド送信
            Me.RxBuf = Nothing  '受信バッファのクリア
            Me.SerialPort.Write(bytesData, 0, bytesData.Length)
            '正常
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 

    ''' レスポンス受信処理
    ''' 
    ''' <param name="RcvRes">受信レスポンス</param>
    ''' 受信結果(True:OK, False:NG)
    ''' 
    ''' -----------------------------------------------------------------------
    Private Function ReceiveData(ByRef RcvRes As String) As Boolean
        '戻り値初期化
        ReceiveData = False
        Try
            '-----
            '受信フラグがONするまで待つ
            '-----
            'リトライ件数
            Dim nRetry As Integer = 50  '50×100msec＝5sec

            While nRetry > 0
                System.Threading.Thread.Sleep(100)
                Application.DoEvents()
                If Me.fRxResponse = True Then
                    '受信フラグONの場合、ループを抜ける
                    Exit While
                End If
                nRetry -= 1
            End While

            '-----
            'タイムアウトチェック
            '-----
            If nRetry = 0 Then
                'タイムアウト表示
                Me.strLastError = "Receive Time Out Error!"
                Return False
            End If

            '受信バイトを文字列変換
            Dim strRx As String = System.Text.Encoding.GetEncoding(932).GetString(Me.RxBuf)
            strRx = strRx.Substring(0, strRx.Length - 1)    '最後の「CR」は省く

            '-----
            '受信データ処理
            '-----
            ''BCCの計算

            '受信レスポンスを返す
            RcvRes = strRx

            '結果正常
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

End Class

このクラスを使用した例を以下のソースに示します。

SerialPortコントロールの使い方その６(シリアル通信クラス・ハンドシェィク受信クラス)使用例

Public Class frmSerialRcvHandshake

    'シリアル通信クラス
    Private mclsSerial As ClsSerialRcvHandshake

    ''' 

    ''' フォームクローズイベント
    ''' 
    Private Sub frmSerialRcv_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        'シリアル通信のクローズ
        mclsSerial.Close()
    End Sub

    ''' 

    ''' フォームロードイベント
    ''' 
    Private Sub frmSerialRcv_Load(sender As Object, e As EventArgs) Handles Me.Load
        'シリアル通信クラスの生成
        mclsSerial = New ClsSerialRcvHandshake(Me.SerialPort1)
        'シリアル通信のオープン
        If mclsSerial.Open() = False Then
            'オープンエラー(必要があれば処理する)
        End If
    End Sub

    ''' 

    ''' 受信処理
    ''' 
    Private Sub btnRX_Click(sender As Object, e As EventArgs) Handles btnRX.Click
        Try
            Dim nData As Integer
            Dim strAddr As String = CInt(txtRxAddr.Text).ToString("0000")
            Me.txtRxData.Text = ""
            Me.txtRxRes.Text = ""
            Me.txtRxErr.Text = ""
            '受信
            If Me.mclsSerial.ReadData(strAddr, nData) = True Then
                Me.txtRxData.Text = nData.ToString("0000")
                Me.txtRxRes.Text = Me.mclsSerial.LastResponse
                Me.txtRxErr.Text = ""
            Else
                Me.txtRxData.Text = ""
                Me.txtRxRes.Text = Me.mclsSerial.LastResponse
                Me.txtRxErr.Text = Me.mclsSerial.LastError
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    ''' 

    ''' 送信処理
    ''' 
    Private Sub btnTX_Click(sender As Object, e As EventArgs) Handles btnTX.Click
        Try
            Dim nData As Integer = CInt(Me.txtTxData.Text)
            Dim strAddr As String = CInt(txtTxAddr.Text).ToString("0000")
            Me.txtTxRes.Text = ""
            Me.txtTxErr.Text = ""
            '送信 
            If Me.mclsSerial.WriteData(strAddr, nData) = True Then
                Me.txtTxRes.Text = Me.mclsSerial.LastResponse
                Me.txtTxErr.Text = ""
            Else
                Me.txtTxRes.Text = Me.mclsSerial.LastResponse
                Me.txtTxErr.Text = Me.mclsSerial.LastError
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

End Class

このフォームは、以下の図の様に、シリアルコントロール及び、 受信処理用のアドレス、受信結果表示データ、応答結果文字列表示用、エラー表示用の各テキストボックスと、 送信処理用にアドレス、送信データ、応答結果文字列表示用、エラー表示用の各テキストボックスを 画面に張り付けてあります。

シリアル通信クラスをフォームの静的変数として宣言します。 受信ボタンをクリックした時には、アドレス値を取得し、シリアル通信クラスの ReadData メソッドにそのアドレスを渡して、 受信を行います。メソッドが正常に終了した時には、データ値と受信文字列を表示し、エラーが在った場合にはエラー内容を表示しています。
また、送信ボタンをクリックした時には、アドレス値及びデータ値を取得し、シリアル通信クラスの WriteData メソッドにアドレス、データ値を渡して、 送信を行います。メソッドが正常に終了した時には、受信文字列を表示し、エラーが在った場合にはエラー内容を表示しています。

以下の図は、受信処理での正常時・エラー発生時・タイムアウトエラー時の表示を示します。
（尚、外部装置の外部装置の替わりとして、前回まで使用してきたRS232Cのテストツールを同様に使用しています。）

また、以下の図は、送信処理での正常時・エラー発生時・タイムアウトエラー時の表示を示します。

最後に、このシリアル通信クラスの問題となるかもしれない点として、 受信処理及び送信処理で装置側から応答が返るまでその処理からは抜け出してこないことがあります。 応答が返るまで待つことが特に問題無い場合はこのままでも利用できると思います。

もし速度的に問題があり、受信・送信コマンドを送ってすぐにそのメソッドから戻りたい場合には、 応答を受信したタイミングでイベントを発生させればできるとは思います。
ただ、パソコン側が主導的に外部装置を制御する場合でしたら、そこまでは必要ないとも思います。

USB ⇒ RS232C 変換ケーブル

関連する記事