Pengesetan Properties MaxLength Secara Otomatis

MaxLength pasti kita jumpai dalam pembuatan suatu aplikasi dengan bahasa pemrograman apapun, untuk kali ini admin akan share MaxLength secara otomatis menyesuaikan dengan MaxLength dengan tabel dari database yang kita buat. Dalam hal ini database yang digunakan menggunakan Ms. Access 2000 dan Visual Basic 6.0 (vb6).

Buatlah database dari Ms. Access simpan dengan format Ms. Access 2000 dengan nama database sampleDb kemudian buat juga tabel dengan nama SISWA untuk field-fieldnya seperti dibawah ini

Field	Property	MaxLength
NIS	Text	20
NAMA	Text	30
ALAMAT	Text	50
TELEPON	Text	20

Sekarang kita akan membuat beberapa komponen TextBox pada sebuah form Microsoft Visual Basic 6.0 (VB6) dengan Max Length mengikuti Max Length dari field tabel yang terdapat pada database Ms. Access 2000 yang telah kita buat diawal pembahasan ini. Langsung saja pada pokok pembahasan buka Ms. Visual Basic 6.0 (VB6) - StandartEXE dan buat Form kemudian tambahkan beberapa komponen yaitu TextBox dan Label seperti dibawah ini : 

Jangan lupa buat ClassModule dengan nama : clsAttribut kemudian pastekan syntac dibawah ini

Private mFormName   As Form
Private mCol        As Collection
Private mTableName  As String

Public Property Let tableName(ByVal vData As String)
    mTableName = vData
End Property
Public Property Get tableName() As String
    tableName = mTableName
End Property

Public Property Let formName(ByVal vData As Form)
    Set mFormName = vData
End Property
Public Property Get formName() As Form
    Set formName = mFormName
End Property

Private Property Get getColumns(ByVal indexKey As Long) As clsAttribut
    Set getColumns = mCol(indexKey)
End Property

Private Function isFieldExists(ByVal fieldName As String, ByRef textBoxName As String) As Boolean
    Dim objAttributs    As clsAttribut
    Dim i               As Integer
   
    Set objAttributs = New clsAttribut
    For i = 1 To mCol.Count
        Set objAttributs = getColumns(i)
        If LCase(objAttributs.fieldName) = LCase(fieldName) Then
            textBoxName = objAttributs.objTextBox.Name
            isFieldExists = True
           
            Exit For
        End If
    Next i
    Set objAttributs = Nothing
End Function

Private Function isTableExists() As Boolean
    Dim rs      As ADODB.Recordset
    Dim strSql  As String
   
    On Error GoTo errHandle
   
    strSql = "SELECT * FROM " & tableName & ""
    Set rs = New ADODB.Recordset
    rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly
    rs.Close
    Set rs = Nothing
   
    isTableExists = True
    Exit Function
errHandle:
    isTableExists = False
End Function

Public Sub addAttributs(ByVal fieldName As String, ByVal objTextBox As TextBox)
    Dim objNewMember As clsAttribut
   
    Set objNewMember = New clsAttribut
    objNewMember.fieldName = fieldName
    objNewMember.objTextBox = objTextBox
   
    mCol.Add objNewMember
    Set objNewMember = Nothing
End Sub

Public Sub autoMaxLength()
    Dim rs              As ADODB.Recordset
    Dim ctl             As Object
   
    Dim strSql          As String
    Dim textBoxName     As String
   
    Dim i               As Integer
   
    If isTableExists Then
        strSql = "SELECT * FROM " & tableName & ""
        Set rs = New ADODB.Recordset
        rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly
        For i = 0 To rs.Fields.Count - 1
            If isFieldExists(rs.Fields(i).Name, textBoxName) Then
                For Each ctl In formName.Controls
                    If TypeName(ctl) = "TextBox" And ctl.Name = textBoxName Then
                        ctl.MaxLength = rs.Fields(i).DefinedSize 'set MaxLength
                        Exit For
                    End If
                Next
            End If
        Next i
        rs.Close
        Set rs = Nothing
       
    Else
        MsgBox "Nama tabel salah", vbExclamation, "Peringatan"
    End If
End Sub

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub

Simpan dan dilanjutkan buat kembali ClassModule dengan nama : clsAutoMaxLength pastekan lagi syntac dibawah ini : 

Private mFormName   As Form
Private mCol        As Collection
Private mTableName  As String

Public Property Let tableName(ByVal vData As String)
    mTableName = vData
End Property
Public Property Get tableName() As String
    tableName = mTableName
End Property

Public Property Let formName(ByVal vData As Form)
    Set mFormName = vData
End Property
Public Property Get formName() As Form
    Set formName = mFormName
End Property

Private Property Get getColumns(ByVal indexKey As Long) As clsAttribut
    Set getColumns = mCol(indexKey)
End Property

Private Function isFieldExists(ByVal fieldName As String, ByRef textBoxName As String) As Boolean
    Dim objAttributs    As clsAttribut
    Dim i               As Integer
   
    Set objAttributs = New clsAttribut
    For i = 1 To mCol.Count
        Set objAttributs = getColumns(i)
        If LCase(objAttributs.fieldName) = LCase(fieldName) Then
            textBoxName = objAttributs.objTextBox.Name
            isFieldExists = True
           
            Exit For
        End If
    Next i
    Set objAttributs = Nothing
End Function

Private Function isTableExists() As Boolean
    Dim rs      As ADODB.Recordset
    Dim strSql  As String
   
    On Error GoTo errHandle
   
    strSql = "SELECT * FROM " & tableName & ""
    Set rs = New ADODB.Recordset
    rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly
    rs.Close
    Set rs = Nothing
   
    isTableExists = True
    Exit Function
errHandle:
    isTableExists = False
End Function

Public Sub addAttributs(ByVal fieldName As String, ByVal objTextBox As TextBox)
    Dim objNewMember As clsAttribut
   
    Set objNewMember = New clsAttribut
    objNewMember.fieldName = fieldName
    objNewMember.objTextBox = objTextBox
   
    mCol.Add objNewMember
    Set objNewMember = Nothing
End Sub

Public Sub autoMaxLength()
    Dim rs              As ADODB.Recordset
    Dim ctl             As Object
   
    Dim strSql          As String
    Dim textBoxName     As String
   
    Dim i               As Integer
   
    If isTableExists Then
        strSql = "SELECT * FROM " & tableName & ""
        Set rs = New ADODB.Recordset
        rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly
        For i = 0 To rs.Fields.Count - 1
            If isFieldExists(rs.Fields(i).Name, textBoxName) Then
                For Each ctl In formName.Controls
                    If TypeName(ctl) = "TextBox" And ctl.Name = textBoxName Then
                        ctl.MaxLength = rs.Fields(i).DefinedSize 'set MaxLength
                        Exit For
                    End If
                Next
            End If
        Next i
        rs.Close
        Set rs = Nothing
    Else
        MsgBox "Nama tabel salah", vbExclamation, "Peringatan"
    End If
End Sub

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub

Simpan kemudian double klik pada form pilih prosedur Form_Load dan pastekan lagi syntaknya : 

    Dim obj As clsAutoMaxLength
    Set obj = New clsAutoMaxLength
    With obj
        .formName = Me
        .tableName = "siswa"
       
        .addAttributs "nis", txtNIS
        .addAttributs "nama", txtNama
        .addAttributs "alamat", txtAlamat
        .addAttributs "telepon", txtTelepon
       
        Call .autoMaxLength
    End With
    Set obj = Nothing

Sangat mudah bukan, jadi kita tidak perlu merasa khawatir dan repot-repot men set MaxLength pada TexBox dan semuanya telah otomatis menyesuaikan MaxLength Field tabel dari database yang kita buat. Simpan kemudian Run/F5. Coba ketik karakter pada textBox maka MaxLength dari textBox akan menyesuaikan dengan MaxLength yang ada pada tabel didalam database. Untuk sourcodenya bisa didownload di LINK INI