投稿日 | : 2003/07/03(Thu) 23:59 |
投稿者 | : Lantern |
Eメール | : |
URL | : |
タイトル | : Re: 制御系なので |
私の場合、こういった同様な処理が多い場合デザインパターンを
使用します。
少し長いですがサンプルです。
テキストボックスへの入力を範囲に入っている、入っていないで
文字色を変えたりしています。
Form_Loadで初期化しておくだけでよいのでコードの煩雑さはなくなります。
尚、これを作成したときには
サイト:”プログラムのメモ帳”の”デザインパターンを応用したコントロールの拡張”
等を参考にさせていただきました。
http://hp.vector.co.jp/authors/VA010223/
'-------------------------------------------------------------------------
'- clsSubText.cls
'-------------------------------------------------------------------------
'================================================
'=
'= テキストボックスデザインパターン化
'= 機能:初期値
'= :最大最小範囲
'= :入力変更 文字色緑
'= :リターン 文字色黒
'= :値違反 文字色赤
'=
'================================================
Option Explicit
Private WithEvents oTxt As TextBox
Private dMax As Double
Private dMin As Double
'================================================
'=
'= 関数:InitText
'= 機能:テキストボックスのデザインパターン追加
'= 引数:objTxt テキストボックス
'= :vMax 最大値
'= :vMin 最小値
'= 戻り:デザインパターン追加テキストボックス
'=
'================================================
Public Function InitText(ByRef objTxt As TextBox, _
ByVal vMax As Double, _
ByVal vMin As Double, _
Optional ByVal vInit As Variant) As clsSubText
Set oTxt = objTxt
dMax# = vMax#
dMin# = vMin#
If Not IsMissing(vInit) Then
oTxt.Text = CStr(vInit)
Call oTxt_LostFocus
End If
Set InitText = Me
End Function
'================================================
'=
'= テキストボックスの変更
'=
'================================================
Private Sub oTxt_Change()
If oTxt.Text = vbNullString Then
Exit Sub
End If
If Not IsNumeric(oTxt.Text) Then
oTxt.ForeColor = vbRed
Exit Sub
End If
If ((CDbl(oTxt.Text) > dMax#) Or _
(CDbl(oTxt.Text) < dMin#)) Then
oTxt.ForeColor = vbRed
Exit Sub
End If
oTxt.ForeColor = vbGreen
End Sub
'================================================
'=
'= テキストボックスの確定
'=
'================================================
Private Sub oTxt_KeyPress(KeyAscii As Integer)
If KeyAscii% = vbKeyReturn Then
If ((CDbl(oTxt.Text) > dMax#) Or _
(CDbl(oTxt.Text) < dMin#)) Then
oTxt.ForeColor = vbRed
Exit Sub
End If
oTxt.ForeColor = vbBlack
KeyAscii% = 0
End If
End Sub
'================================================
'=
'= テキストボックスフォーカス移動による確定
'=
'================================================
Private Sub oTxt_LostFocus()
If ((CDbl(oTxt.Text) > dMax#) Or _
(CDbl(oTxt.Text) < dMin#)) Then
oTxt.ForeColor = vbRed
Exit Sub
End If
oTxt.ForeColor = vbBlack
End Sub
'-------------------------------------------------------------------------
'- テキストボックスを配置されたフォームのロードイベント
'-------------------------------------------------------------------------
Private colTextBox As Collection
Private Sub Form_Load()
'========================================
'= テキストボックスの初期化
'========================================
Set colTextBox = New Collection
colTextBox.Add NewText.InitText(Me.txtText1, 30, -30, -30)
colTextBox.Add NewText.InitText(Me.txtText2, 100, -50, 15)
End Sub
'-------------------------------------------------------------------------
'- 標準モジュール
'-------------------------------------------------------------------------
'=================================================
'=
'= 関数 :NewText
'= 機能 :デザインパターン追加用関数
'= 引数 :
'= 戻り :clsSubText 追加されたclsSubText
'=
'=================================================
Public Function NewText() As clsSubText
Set NewText = New clsSubText
End Function