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

前回「その１」ではサービスの処理として何もしなかったのですが、今回は少しだけ処理を追加していきます。
タイマコントロールを追加し、タイマイベント処理の中で、Windowsのイベントログに時刻の出力を行います。

TestService.vb[デザイン] のフォームを開き、タイマコントロールを設置するのですが、 「ツールボックス」にはタイマコントロールが現れていないと思いますので、 「ツールボックス」のウインドウの上でマウス右クリックして「アイテムの選択」を実行します。 さらに「.NET Framework コンポーネント」の名前が Timer で、名前空間が System.Timers をチェックし「OK」を押下します。
System.Timers.Timer を TestService.vb[デザイン] へドラッグ＆ドロップし、タイマコントロールを設置します。 Timer1 のプロパティで以下の設定にします。

• Enabled：False
• Interval：10000　（10秒毎のタイマイベントの発生）

尚、ServiceBase の TestService のプロパティ「AutoLog」が「True」になっているのを確認して下さい。 デフォルトで「True」なのですが、Microsoftのサイトによりますと、以下の様に書かれています。

では今回のソースとしては以下の様になります。
OnStart ではイベントログに開始メッセージを登録し、タイマの開始を指示します。
OnStop ではイベントログに停止メッセージを登録し、タイマの停止を指示します。
タイマイベントの Timer1_Elapsed では現在時刻をイベントログに登録します。

Public Class TestService

    Protected Overrides Sub OnStart(ByVal args() As String)
        ' サービスを開始するコードをここに追加します。このメソッドによって、
        ' サービスが正しく実行されるようになります

        Me.EventLog.WriteEntry("サービスを開始します。")
        ' タイマの開始
        Me.Timer1.Enabled = True
        Me.EventLog.WriteEntry("サービスを開始しました。")
    End Sub

    Protected Overrides Sub OnStop()
        ' サービスを停止するのに必要な終了処理を実行するコードをここに追加します。
        Me.EventLog.WriteEntry("サービスを停止します。")
        ' タイマの停止
        Me.Timer1.Enabled = False
        Me.EventLog.WriteEntry("サービスを停止しました。")
    End Sub

    ' タイマイベント処理
    Private Sub Timer1_Elapsed(sender As Object, e As Timers.ElapsedEventArgs) Handles Timer1.Elapsed
        Try
            'この段階では特に行う処理が無いのでイベントログへの出力を行う
            Me.EventLog.WriteEntry("タイマイベント:" & Now.ToString("yyyy/MM/dd HH:mm:ss"))
        Catch ex As Exception
        End Try
    End Sub

End Class

特にどうといった処理ではないので簡単な処理です。
このサービスプログラムですが、何かイベントが起こるのをこのプログラムの裏？で待っているわけで、 今回はタイマコントロールによるイベントを受け付ける様になっています。

「コントロールパネル」⇒「管理ツール」⇒「イベント ビューアー」で起動し、 実際にイベントログが登録されているかを見てみます。

イベントログに「タイマイベント:YYYY/MM/DD HH:mm:ss」が正しく登録されている様です。

尚、「AutoLog」が「True」の場合には、 OnStart OnStop などではシステムがイベントログにそれぞれのメッセージを登録するため、 本当は上記の「サービスを開始しました。」「サービスを停止しました。」の登録は必要ありません。

ところで、OnStart OnStop の処理は長時間実行可能なわけでは無く、すぐに終わらせる必要があります。 その為、OnStart の中ではタイマコントロールをEnable にして、すぐに処理を終わっています。

実際のところタイマコントロールでは面白くないので、別スレッドを起動して、スレッド側でメイン処理として行う方がいいと思います。 次の記事ではメイン処理をスレッドにしたもので行います。

関連する記事

おすすめ書籍

• Windowsサービス開発テクニック―VB.NETで楽々プログラミング (NEサポートシリーズ)
• Visual Basic 2017パーフェクトマスター (Perfect Master)
• VB.NET基礎学習Bible―270例題で学ぶプログラミングの散歩道

サービスプログラムの作成を行うことがあったので、作成方法の最初の部分を記します。
サービスプログラムはフォームを持つプログラムとは全く性格が異なり、作成手順も異なりますので、 手順を追いながら作成していきます。 尚、今回の作業を行うには、Windowsの管理者権限でログインしておいてください。

先ず、VisualStudioを起動し、新しいプロジェクトの作成を行います。 「新しいプロジェクト」ウインドウが表示されたら、テンプレートの中のVisualBasicを選択し、更に Windowsサービス を選択すると以下の様な表示なります。

「名前」が「WindowsServices1」となっているのを、仮に「TestService」に変更し、「OK」ボタンを押下します。

尚、画面はプロジェクト名を「TestService」と変更し、更に「TestService.vb[デザイン]」のプロパティで、「ServiceName」も「TestService」に全て変更しました。
ここをクリックするとコードビューに切り替わります。のリンクをクリックします。 すると、Service1.vb の内容が以下の様に表示されます。

ソースとしては以下の様になります。

Public Class TestService

    Protected Overrides Sub OnStart(ByVal args() As String)
        ' サービスを開始するコードをここに追加します。このメソッドによって、
        ' サービスが正しく実行されるようになります
    End Sub

    Protected Overrides Sub OnStop()
        ' サービスを停止するのに必要な終了処理を実行するコードをここに追加します。
    End Sub

End Class

OnStart プロシージャと OnStop プロシージャのサービスへの機能追加を行い、再定義する他のすべてのメソッドを上書きします。
OnStart プロシージャは、「コントロールパネル」⇒「管理ツール」⇒「サービス」で起動される、画面の中で、各サービスでの「開始」操作に対応する処理を記述します。 また、OnStop プロシージャは、各サービスでの「停止」操作に対応する処理を記述します。

最初のテストなので、このままの状態でサービスを作成し、インストール行います。
「TestService.vb[デザイン]」を表示し、デザイン上で右クリックでメニューを表示させて、「インストーラーの追加」をクリックします.

インストーラーのコントロールがプロジェクトに追加されて、以下の様な表示なります.

[ProjectInstaller] の [デザイン] ビューで、[ServiceInstaller1] を選択します。

[プロパティ] ウィンドウで、ServiceName プロパティが TestService に設定されていることを確認します。
「ソリューション エクスプローラー」の「ソリューション'TestService'」を選択し、VisualSutudioのメニューの「ビルド」⇒「ソリューションのビルド」を選択し、ビルドを行います.

尚、ここでひとつ忘れていたのですが、「TestService」プロパティ設定で、スタートアップオブジェクトを「TestService」に設定しておきます.

では、作成されたサービスを実際に登録してみます。 登録方法は、Windows の [スタート] メニューまたは [スタート] 画面で、[Visual Studio]⇒[Visual Studio ツール]⇒[開発者コマンド プロンプト] の順に選択します。

Visual Studio コマンド プロンプトが表示されますので、インストールする場合は以下のコマンドを入力します。

• installutil C:\TestService\TestService\bin\Debug\TestService.exe

アンインストールする場合は以下のコマンドを入力します。

• installutil /u C:\TestService\TestService\bin\Debug\TestService.exe

インストールコマンドを実行すると以下の様に、ログイン時のユーザー名とパスワードを聞いてきますので、 それぞれを入力して作業を進めます。
尚、ユーザー名の注意ですが、ログインしている私のマシンのAdmin属性のユーザを設定したのですが、ユーザ名の先頭に「.\」（ドット￥）が必要でした。

インストールが完了すれば以下の表示になります。

これでサービスに登録が終わりましたので、「コントロールパネル」⇒「管理ツール」⇒「サービス」を起動します。 サービスの一覧の中に「TestService」があると思いますので、サービスの「開始」を行います。

以下の様に、サービスの状態が「開始」になります。

サービスを止めるには「停止」を指定します。

アンインストールを実際に行った様子を以下に示します。

結果、サービス一覧から「TestService」が削除されました。

今回はサービスプログラムの生成と登録までを行っただけで、実際に何かの処理を行うわけではありません。
今後は、何かの処理を行う部分を組み込んで、サービスプログラムについて考察していきたいと思います。

関連する記事

おすすめ書籍

• Windowsサービス開発テクニック―VB.NETで楽々プログラミング (NEサポートシリーズ)
• Visual Basic 2017パーフェクトマスター (Perfect Master)
• VB.NET基礎学習Bible―270例題で学ぶプログラミングの散歩道

前回投稿した以下の記事ですが、プロセス間通信の方法としてRemoting の IPCを使用していました。
⇒Remoting の IPC を使ったプロセス間通信について

今回は、HTTPチャネルを介してのプロセス間通信に変更してみます。 前回同様、1個のソリューショの中に以下の3個のプロジェクトを設置します。

• クライアントとサーバーで共有するクラスDLL
• サーバープロセスの実行PG（EXE）
• クライアントプロセスの実行PG（EXE）

先ず、プロセス間通信の準備として、クライアントとサーバーで共有するクラスの宣言ですがこれは前回と全く同じものです。

クライアントとサーバーで共有するクラス

Public Class ServiceClass
    Inherits MarshalByRefObject

    'クライアントから呼び出しを受け、イベントを発生させる
    Public Sub RaiseServerEvent(ByVal message As String)
        'イベントを発生させる
        RaiseEvent RaiseClientEvent(message)
    End Sub

    Public Event RaiseClientEvent(ByVal messsage As String)

End Class

プロジェクトの定義は以下の様になります。

次に、サーバープロセスPGのプロジェクトを生成します。
1個のフォーム frmIpcServer をプロジェクトに追加し、そのフォーム上に1個のボタンとリッチエディットBOXを設置します。
フォームの静的変数として上記で説明した共有クラス（ServiceClass）の生成を行います。 また、ServiceClass から raise されるイベントの処理として、リッチエディットBOXに受信したメッセージを表示する為に、 デリゲート処理を宣言しています。
ボタンの押下によりHTTPの受信開始を行うのですが、以下の様な手順で行います。

• HttpChannelによりHTTPチャネルを用意し、ChannelServices.RegisterChannel でチャネルを登録
• RemotingServices.Marshal により共有クラスの参照許可
• httpChannel.StartListening によりHTTPの受信を開始

サーバープロセスPG

Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Http
Imports IpcService

Public Class frmIpcServer

    'IPC用クラスの生成
    Private WithEvents IpcServiceClass As New IpcService.ServiceClass

    '受信回数
    Private mintRcv As Integer = 0

    '別プロセスからのメッセージを処理するためデリゲートを利用
    Delegate Sub SetRichTextBox1Delegate(ByVal Value As String)

    Private RichTextBox1Delegate As New SetRichTextBox1Delegate(AddressOf AppendTextRichTextBox1)

    'リッチテキストボックスにメッセージを表示する
    Private Sub AppendTextRichTextBox1(ByVal message As String)
        RichTextBox1.AppendText(message)
    End Sub

    '受信準備
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'HTTPチャネルを用意(ポートは8080を利用)
        Dim httpChannel = New HttpChannel(8080)
        ChannelServices.RegisterChannel(httpChannel, False)

        '「IpcServiceClass」を「ipcsample」で参照できるように設定
        Dim ref As ObjRef = RemotingServices.Marshal(IpcServiceClass, "ipcsample")

        'HTTP受信準備
        httpChannel.StartListening(Nothing)
        RichTextBox1.AppendText("HTTP channel is ready to receive." & vbNewLine)
    End Sub

    'IPC用クラスのイベント処理
    Private Sub IpcServiceClass_RaiseClientEvent(ByVal message As String) Handles IpcServiceClass.RaiseClientEvent
        'このイベント処理は、別プロセスのServiceClassからRaiseされるので、
        'このフォームのコントロールにアクセスするにはデリゲート処理を行う
        '(クライアントから受信したメッセージを処理)
        mintRcv += 1
        Me.Invoke(RichTextBox1Delegate, New Object() {mintRcv.ToString & ":" & message & vbNewLine})
    End Sub

End Class

尚、このプロジェクトの参照設定で以下のものを追加します。

• System.Runtime.Remoting
• IpcService

最後に、クライアントプロセスPGのプロジェクトを生成します。
1個のフォーム frmIpcClient をプロジェクトに追加し、そのフォーム上に1個のボタンとディットBOXを設置します。
フォームロード時に ChannelServices.RegisterChannel でHTTPチャネルの用意を行い、 RemotingConfiguration.RegisterWellKnownClientType でリモートサーバへの接続準備を行います。
ボタン押下時に IPC用クラスの生成を行い、そのクラスのイベント発生メソッドを実行し、メッセージ送信処理を行います。
尚、このプロジェクトの参照設定もサーバープロセスPGと同様です。

クライアントプロセスPG

Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Http
Imports IpcService

Public Class frmIpcClient

    'IPC準備
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'HTTPチャネルを用意する
        Dim channel As New HttpChannel(0)
        ChannelServices.RegisterChannel(channel, False)

        'リモートサーバへの接続準備
        RemotingConfiguration.RegisterWellKnownClientType(GetType(ServiceClass), "http://localhost:8080/ipcsample")
    End Sub

    'メッセージを送信する
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
            'IPC用クラスの生成
            Dim IpcServiceClass As ServiceClass = New ServiceClass()
            'サーバへの通知(引数には、送信したいメッセージを指定)
            IpcServiceClass.RaiseServerEvent("Message From Client=>" & Me.TextBox1.Text)

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

End Class

このソリューションをデバッグ実行するために、ソリューションのプロパティを以下の図の様に設定します。

このソリューションをデバッグ実行すると以下の様になります。
サーバーPGの起動後、「Start HTTP Channel」ボタンを押下して HTTP 受信の準備を行います。 その後、クライアントPGのボタンを押下するごとに、サーバーPGにメッセージが表示されていきます。

関連する記事

同一PC上でプロセス（EXE）間で通信を行いたいことはよくあります。 例えば、1個のPGを何か受信専用として動作させておいて、別のPGではメインの処理を行いながら、たまに受信データの処理を行うなどの要求が出てきたりします。 別EXE同士でやり取りを行う場合には以下の様な方法があると思います。

• WindowsAPIのメッセージ通信
• WindowsAPIのPIPEでの通信
• WindowsAPIのファイルマッピングでの通信
• 通常のファイルを使った通信
• 遅くてOKならば、データベースを介した通信

尚、今回は勉強もかねて Remoting の IPC を使って、クライアントプロセス（EXE）からサーバープロセス（EXE）にメッセージを送信することをやってみます。
今回の例では、1個のソリューションの中に以下の3個のプロジェクトを生成します。

• クライアントとサーバーで共有するクラスDLL
• サーバープロセスの実行PG（EXE）
• クライアントプロセスの実行PG（EXE）

先ず、プロセス間通信の準備として、クライアントとサーバーで共有するクラスの生成を行います。
以下のソースを見て下さい。MarshalByRefObject をクラスを継承したクラス ServiceClass を宣言しています。
内容的には多くのことをするわけでは無く、クライアントから呼出されるであろうメソッドで、 文字列データを引数としてイベントを raise しています。
このプロジェクトは IpcService と命名し、クラスライブラリ（DLL）としてビルドしておきます。
（後からこのDLLを、サーバープロセス及びクライアントプロセスのプロジェクトで参照設定します。）

クライアントとサーバーで共有するクラス

Public Class ServiceClass
    Inherits MarshalByRefObject

    'クライアントから呼び出しを受け、イベントを発生させる
    Public Sub RaiseServerEvent(ByVal message As String)
        'イベントを発生させる
        RaiseEvent RaiseClientEvent(message)
    End Sub

    Public Event RaiseClientEvent(ByVal messsage As String)

End Class

プロジェクトの定義は以下の様になります。

次に、サーバープロセスPGのプロジェクトを生成します。
1個のフォーム frmIpcServer をプロジェクトに追加し、そのフォーム上に1個のボタンとリッチエディットBOXを設置します。
フォームの静的変数として上記で説明した共有クラス（ServiceClass）の生成を行います。 また、ServiceClass から raise されるイベントの処理として、リッチエディットBOXに受信したメッセージを表示する為に、 デリゲート処理を宣言しています。
ボタンの押下によりIPCの受信開始を行うのですが、以下の様な手順で行います。

• IpcServerChannel によりIPCチャネルを用意し、ChannelServices.RegisterChannel でチャネルを登録
• RemotingConfiguration.RegisterWellKnownServiceType でサービスのタイプを宣言
• RemotingServices.Marshal により共有クラスの参照許可
• IpcChannel.StartListening によりIPCの受信を開始

サーバープロセスPG

Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Ipc
Imports IpcService

Public Class frmIpcServer

    'IPC用クラスの生成
    Private WithEvents IpcServiceClass As New IpcService.ServiceClass

    '受信回数
    Private mintRcv As Integer = 0

    '別プロセスからのメッセージを処理するためデリゲートを利用
    Delegate Sub SetRichTextBox1Delegate(ByVal Value As String)

    Private RichTextBox1Delegate As New SetRichTextBox1Delegate(AddressOf AppendTextRichTextBox1)

    'リッチテキストボックスにメッセージを表示する
    Private Sub AppendTextRichTextBox1(ByVal message As String)
        RichTextBox1.AppendText(message)
    End Sub

    'IPC受信開始
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'IPCチャネルを用意
        Dim IpcChannel As New IpcServerChannel("ipcPort")
        ChannelServices.RegisterChannel(IpcChannel, False)
        Dim strSClassName As String = GetType(ServiceClass).Name
        RemotingConfiguration.RegisterWellKnownServiceType(GetType(ServiceClass), strSClassName, WellKnownObjectMode.SingleCall)
        '「ServiceClass」を参照できるように設定
        Dim ref As ObjRef = RemotingServices.Marshal(IpcServiceClass, strSClassName)

        'IPC受信準備
        IpcChannel.StartListening(Nothing)
        RichTextBox1.AppendText("IPC channel is ready to receive." & vbNewLine)
    End Sub

    'IPC用クラスのイベント処理
    Private Sub IpcServiceClass_RaiseClientEvent(ByVal message As String) Handles IpcServiceClass.RaiseClientEvent
        'このイベント処理は、別プロセスのServiceClassからRaiseされるので、
        'このフォームのコントロールにアクセスするにはデリゲート処理を行う
        '(クライアントから受信したメッセージを処理)
        mintRcv += 1
        Me.Invoke(RichTextBox1Delegate, New Object() {mintRcv.ToString & ":" & message & vbNewLine})
    End Sub
   
End Class

尚、このプロジェクトの参照設定で以下のものを追加します。

• System.Runtime.Remoting
• IpcService

最後に、クライアントプロセスPGのプロジェクトを生成します。
1個のフォーム frmIpcClient をプロジェクトに追加し、そのフォーム上に1個のボタンとディットBOXを設置します。
フォームロード時に ChannelServices.RegisterChannel でIPCチャネルの用意を行います。
ボタン押下時にメッセージ送信処理を行うのですが以下の様な手順で行います。

• リモートIPCオブジェクトの URL を定義して Activator.GetObject 参照を取得
• その参照を共有クラスのオブジェクト変数に代入
• 共有参照クラスのイベント生成メソッド呼び出し

このプロジェクトの参照設定もサーバープロセスPGと同様です。

クライアントプロセスPG

Imports System.Runtime.Remoting
Imports System.Runtime.Remoting.Channels
Imports System.Runtime.Remoting.Channels.Ipc
Imports IpcService

Public Class frmIpcClient

    'IPC準備
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'IPCチャネルを用意する
        Dim ipcChannel As New IpcClientChannel
        ChannelServices.RegisterChannel(ipcChannel, False)
    End Sub

    'メッセージを送信する
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
            '既存のリモートIPCオブジェクトへの参照を取得する
            Dim strURL As String = "ipc://ipcPort/" + GetType(ServiceClass).Name
            Dim objRemote As Object = Activator.GetObject(GetType(ServiceClass), strURL)

            'サーバとの共通クラスの参照(ServiceClass)
            Dim objServiceClass As ServiceClass = CType(objRemote, ServiceClass)
            '共有参照クラスのイベント生成メソッド呼び出し
            objServiceClass.RaiseServerEvent("Message From Client=>" & Me.TextBox1.Text)

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

End Class

このソリューションをデバッグ実行するために、ソリューションのプロパティを以下の図の様に設定します。

このソリューションをデバッグ実行すると以下の様になります。
サーバーPGの起動後、「Start IPC Channel」ボタンを押下して IPC 受信の準備を行います。 その後、クライアントPGのボタンを押下するごとに、サーバーPGにメッセージが表示されていきます。

今回のPGはまだまだ不備な点が多いので実用には供しないですが、ご参考になればと思います。

関連する記事

以前、テキストボックスコントロールを基底クラスとして、入力される文字を数字のみとするクラスを紹介しました。
⇒テキストボックスの入力を数字のみにする方法

今回は、入力が便利になる様なプロパティを追加してみたいと思います。
追加する機能は、以下の3個の機能です。

• 自分自身にフォーカス移動が在った場合に、背景色を変更する。
• 自分自身にフォーカス移動が在った場合に、テキスト全体を選択状態にする。
• Enter キーによる次のタブストップが指定されているコントロールへのフォーカス移動。

最初の背景色の設定の為に、自分自身がアクティブである時の背景色と、 アクティブではない時の背景色を設定するプロパティを設定します。
クラスの静的変数にアクティブ時（_ActiveBackColor）と非アクティブ時（_InactiveBackColor）の背景色を持ちます。 さらに、この変数をアクセスするためのプロパティ宣言をそれぞれ、ActiveBackColor InactiveBackColor とします。
背景色を変える処理を、Enterイベントの処理の OnEnter 及び、Leaveイベントの処理の OnLeave で処理を行います。

また、フォーカスが移動してきた時の、テキスト全体を選択状態にする指示プロパティを ActiveSelectAll として宣言します。
実際の処理は、 OnEnter 内でこのフラグを見て、 True の場合に、テキストの全選択を行います。

以下にソースを示します。

テキストボックス拡張クラスにプロパティを追加する方法

Public Class ClsNumTextBox2
    Inherits TextBox

    'アクティブ時の背景色
    Private _ActiveBackColor As Color = Color.White
    '非アクティブ時の背景色
    Private _InactiveBackColor As Color = Color.White
    'アクティブ時の全選択フラグ
    Private _ActiveSelectAll As Boolean = False

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

    ''' 

    ''' WndProc メソッド (override)
    ''' 
    ''' <param name="m">メッセージ</param>
    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_PASTE
                Dim iDataObj As IDataObject = Clipboard.GetDataObject()
                'クリップボードの中身があるか、かつ文字列に変換できるか??
                If (iDataObj IsNot Nothing) And (iDataObj.GetDataPresent(DataFormats.Text) = True) Then
                    '文字列に変換
                    Dim strClip As String = DirectCast(iDataObj.GetData(DataFormats.Text), String)
                    '文字列が数字のみか調べる
                    If Me.ChkClipString(strClip) = False Then
                        Return
                    End If
                End If
        End Select

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

    ''' 

    ''' コンストラクタ
    ''' 
    Public Sub New()
        MyBase.New()
        'IMEを無効にする
        MyBase.ImeMode = ImeMode.Disable
    End Sub

    ''' 

    ''' アクティブ時の背景色
    ''' 
    Public Property ActiveBackColor As Color
        Set(value As Color)
            _ActiveBackColor = value   '退避値に設定
        End Set
        Get
            Return _ActiveBackColor    '退避値を返す
        End Get
    End Property

    ''' 

    ''' 非アクティブ時の背景色
    ''' 
    Public Property InactiveBackColor As Color
        Set(value As Color)
            _InactiveBackColor = value   '退避値に設定
        End Set
        Get
            Return _InactiveBackColor    '退避値を返す
        End Get
    End Property

    ''' 

    ''' アクティブ時の全選択フラグ
    ''' 
    Public Property ActiveSelectAll As Boolean
        Set(value As Boolean)
            _ActiveSelectAll = value   '退避値に設定
        End Set
        Get
            Return _ActiveSelectAll    '退避値を返す
        End Get
    End Property

    ''' 

    ''' Enterイベントの処理
    ''' 
    Protected Overrides Sub OnEnter(e As EventArgs)
        MyBase.OnEnter(e)
        '背景色の設定
        Me.BackColor = Me._ActiveBackColor
        'アクティブ時の全選択フラグ
        If Me._ActiveSelectAll = True Then
            Me.SelectAll()
        End If
    End Sub

    ''' 

    ''' Leaveイベントの処理
    ''' 
    Protected Overrides Sub OnLeave(e As EventArgs)
        MyBase.OnLeave(e)
        '背景色の設定
        Me.BackColor = Me._InactiveBackColor
    End Sub

    ''' 

    ''' KeyPressイベントの処理
    ''' 
    Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
        MyBase.OnKeyPress(e)
        'キーが [0]～[9] または [BackSpace] 以外の場合イベントをキャンセル
        If Not (("0"c <= e.KeyChar And e.KeyChar <= "9"c) Or e.KeyChar = ControlChars.Back) Then
            e.Handled = True
        End If
    End Sub

    ''' 

    ''' 文字列のチェック関数
    ''' 
    ''' <param name="strClip">指定文字列</param>
    ''' True:OK, False:NG
    Private Function ChkClipString(ByVal strClip As String) As Boolean
        ChkClipString = False
        If System.Text.RegularExpressions.Regex.IsMatch(strClip, "^[0-9]+$") Then
            Return True
        End If
    End Function

    ''' 

    ''' KeyDownイベントの処理
    ''' 
    Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
        MyBase.OnKeyDown(e)
        '[Enter]キーの場合
        If e.KeyCode = Keys.Enter Then
            If e.Control = False Then
                '[Ctrl]キーが押下されていない場合、自分の親のコントロールの次のフォーカスへ移動
                Me.Parent.SelectNextControl(Me, Not e.Shift, True, True, True)
            End If
        End If
    End Sub

End Class

このソースを別のファイルで作成し、一度コンパイルします。 そうすると、ツールボックスの中に ClsNumTextBox2 が現れますので、以下の様にこれをフォーム上に貼り付けます。
ActiveBackColor にはYellow InactiveBackColor にはWhite を設定し、 ActiveSelectAll にはTrue と設定します。

このフォームにはコードを何も記述していませんが、そのまま実行した結果は以下の様な感じです。
Enterキーを押下することで、フォーカスが順次移動し、背景が黄色になります。 テキストボックス内に文字列が入力されていれば、フォーカス移動時には選択状態になります。

関連する記事