tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
テキストボックスデザインパターン化(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2007/07/16 11:07
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[テキストボックス][][]                                              *
* キーワード:TextBox,書式,スタイル,,,                                            *
***********************************************************************************

元質問:テキストボックスの入力チェック - TM  2003/07/03-10:38 No.4586

-------------------------------------------------------------------------
上記に於いて回答されていた物です、テキストボックスデザインパターン化って
珍しいので、掲載しておきます。

                 --- by 花ちゃん ---
-------------------------------------------------------------------------


-------------------------------------------------------------------------
Re: 制御系なので - Lantern  2003/07/03-23:59 No.4608
-------------------------------------------------------------------------

私の場合、こういった同様な処理が多い場合デザインパターンを
使用します。

少し長いですがサンプルです。
テキストボックスへの入力を範囲に入っている、入っていないで
文字色を変えたりしています。
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



 [スレッド一覧へ] [親スレッドへ]