VB6 API - Menghilangkan Border TextBox, ListBox, etc.

Mengenai cara menghilangkan border object TextBox, ListBox, dan lain sebagainya.

Option Explicit 
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
 
Private Const WS_EX_CLIENTEDGE = &H200 
Private Const GWL_EXSTYLE = (-20) 
 
Private Sub RemoveBorder(ctl As Control) 
    Dim lStyle As Long 
    ctl.Appearance = 1 
    lStyle = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) 
    lStyle = lStyle And Not WS_EX_CLIENTEDGE 
    SetWindowLong ctl.hwnd, GWL_EXSTYLE, lStyle 
    ctl.Appearance = 0 
End Sub 

Contoh penggunaan:

Private Sub Command1_Click() 
    Call RemoveBorder(Text1) 
End Sub 

READ MORE - VB6 API - Menghilangkan Border TextBox, ListBox, etc.

VB6 Code - Membuat Cue Banner atau Placeholder Text

Apa yang dimaksud dengan cue banner atau placeholder text atau sebagian menyebutnya dengan watermark text itu? untuk memahaminya perhatikan gambar di bawah ini:

VB6 Cue Banner Placeholder Text Watermark Text

Terlihat pada gambar di atas beberapa objek (ComboBox dan beberapa TextBox) yang memiliki tulisan kurang jelas dengan warna keabu-abuan. Nah, tulisan yang kurang jelas itulah yang dinamakan dengan cue banner/placeholder text/watermark text. Tulisan itu hanya akan muncul apabila objek-objek tersebut memiliki property Text = "" serta dalam keadaan lost focus.

Berikut beberapa bagian kode darinya:

Option Explicit
 
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type COMBOBOXINFO
    cbSize As Long
    rcItem As RECT
    rcButton As RECT
    stateButton  As Long
    hwndCombo  As Long
    hwndEdit  As Long
    hwndList As Long
End Type
 
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1)
 
Public Sub SetCueBanner(obj As Object, str As String)
    Dim s As String
    Dim c As COMBOBOXINFO
    If TypeOf obj Is ComboBox Then
        c.cbSize = Len(c)
        Call GetComboBoxInfo(obj.hwnd, c)
        s = StrConv(str, vbUnicode)
        Call SendMessage(c.hwndEdit, EM_SETCUEBANNER, 0&, ByVal s)
    Else 'TextBox
        s = StrConv(str, vbUnicode)
        Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s)
    End If
End Sub

Catatan sangat penting:

1. Cue banner tidak bisa berjalan pada WinXP yang terinstall left to rigth language seperti arabic dsb. Hal tersebut merupakan bug dari Microsoft sendiri, dan telah diperbaiki pada OS selanjutnya.
2. Cue banner hanya akan berjalan setelah dicompile serta diberi manifest (XP Style)

Lebih lengkap mengenai pembuatan cue banner/placeholder text/watermark text bisa Anda download pada tautan di bawah ini:

Download: VB6_CueBanner

READ MORE - VB6 Code - Membuat Cue Banner atau Placeholder Text

Menghapus Seluruh Isi TextBox Menggunakan For Each - VB6

Terkadang kita membutuhkan cara yang praktis untuk menghapus seluruh TextBox yang terdapat pada Form secara sekaligus. Tanpa harus menghapusnya satu persatu seperti Text1 = "", Text2 = "". Bagaimana jika dalam sebuah Form terdapat banyak object TextBox, misalnya ada 35 TextBox?

Berikut adalah cara menghapus seluruh text yang terdapat pada TextBox menggunakan VB6 code:

Option Explicit 
 
Private Sub Command1_Click() 
    ClearAllTextbox 
End Sub 
 
Private Sub ClearAllTextbox() 
    Dim t As Control 
        For Each t In Me.Controls 
        If TypeOf t Is TextBox Then   
            t.Text = "" 
        End If 
    Next 
End Sub 

Demikianlah cara menghapus seluruh text yang terdapat pada object TextBox secara sekaligus menggunakan perulangan For .. Each.

READ MORE - Menghapus Seluruh Isi TextBox Menggunakan For Each - VB6

Bermain Dengan Horizontal Vertical Scroll TextBox

Option Explicit

Const EM_LINESCROLL = &HB6

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Sub Form_Load()
    Dim intLineIndex As Integer, intWordIndex As Integer

    Text1.Font = "Courier New"
    Text1.Text = ""
    For intLineIndex = 1 To 25
        Text1.Text = Text1.Text & "Line" & Str$(intLineIndex)
        For intWordIndex = 1 To 5
            Text1.Text = Text1.Text & " Word" & Str$(intWordIndex)
        Next intWordIndex
        Text1.Text = Text1.Text & vbCrLf
    Next intLineIndex

    Command1.Caption = "Vertical"
    Command2.Caption = "Horizontal"
End Sub

Private Sub Command1_Click()
    Dim lngRet As Long
    lngRet = SendMessage(Text1.hWnd, EM_LINESCROLL, 0, 5&)
End Sub

Private Sub Command2_Click()
    Dim lngRet As Long
    lngRet = SendMessage(Text1.hWnd, EM_LINESCROLL, 5, 0&)
End Sub

READ MORE - Bermain Dengan Horizontal Vertical Scroll TextBox

Class TextBox - Untuk Mempermudah Pembuatan Aplikasi

<span style="color: #0000FF; text-decoration: underline; cursor: pointer;" onClick="toggleOverflowText('hiddenText2', this, 'Collapse Code...', 'Expand Code...', '300px');">Expand Code...</span> 
<pre class=codewhite id="hiddenText2" style="height: 300px";>Option Explicit 
 
'------------------------------------------------------------------------------- 
' ucTextBox (User Control TextBox for Database) 
' http://khoiriyyah.blogspot.com 
' -- Asep Hibban -- 
'------------------------------------------------------------------------------- 
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long 
 
Private Const EM_SETMARGINS = &HD3 
Private Const EC_LEFTMARGIN = &H1 
Private Const EC_RIGHTMARGIN = &H2
 
Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
Private Type COMBOBOXINFO 
    cbSize As Long 
    rcItem As RECT 
    rcButton As RECT 
    stateButton  As Long 
    hwndCombo  As Long 
    hwndEdit  As Long 
    hwndList As Long 
End Type 
 
Private Const ECM_FIRST As Long = &H1500 
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1) 
 
Public Enum eTextConvertion 
    [GeneralConvertion] = 0 
    [UpperCase] = 1 
    [LowerCase] = 2 
    [ProperCase] = 3 
End Enum 
 
Public Enum eTextValidation 
    [GeneralValidation] = 0 
    [Alphabet] = 1 
    [AlphaNumeric] = 2 
    [Numeric] = 3 
End Enum 
 
Public Enum eAppearance 
    [Flat] = 0 
    [3D] = 1 
End Enum 
 
Public Enum eStyle 
    [Classic] = 0 
    [XP] = 1 
End Enum 
 
Public Enum eAlignment 
    [Left Justify] = 0 
    [Right Justify] = 1 
    [Center] = 2 
End Enum 
 
Public Enum eBorderStyle 
    [None] = 0 
    [Fixed Single] = 1 
End Enum 
 
Public Enum eDragMode 
    [Manual] = 0 
    [Automatic] = 1 
End Enum 
 
Public Enum eLinkMode 
    [None] = 0 
    [Automatic] = 1 
    [Manual] = 2 
    [Notify] = 3 
End Enum 
 
Public Enum eOLEDropMode 
    [None] = 0 
    [Manual] = 1 
    [Automatic] = 2 
End Enum 
 
Public Enum eOLEDragMode 
    [Manual] = 0 
    [Automatic] = 1 
End Enum 
 
Public Enum eScrollBars 
    [None] = 0 
    [Horizontal] = 1 
    [Vertical] = 2 
    [Both] = 3 
End Enum 
 
Public Enum eScaleMode 
    [User] = 0 
    [Twip] = 1 
    [Point] = 2 
    [Pixel] = 3 
    [Character] = 4 
    [Inch] = 5 
    [Millimeter] = 6 
    [Centimeter] = 7 
End Enum 
 
Public Enum eMousePointer 
    [Default] = 0 
    [arrow] = 1 
    [Cross] = 2 
    [i -Beam] = 3 
    [Icon] = 4 
    [Size] = 5 
    [Size NE SW] = 6 
    [Size N S] = 7 
    [Size NW SE] = 8 
    [Size W E] = 9 
    [Up arrow] = 10 
    [Hourglass] = 11 '(wait) 
    [No Drop] = 12 
    [Arrow and Hourglass] = 13 
    [Arrow and Question] = 14 
    [Size All] = 15 
    [Custom] = 99 
End Enum 
 
Public AutoSelection As Boolean 
Public AutoTab As Boolean 
Public TextConvertion As eTextConvertion 
Public TextValidation As eTextValidation 
Public AllowDecimal As Boolean 
Public Required As Boolean 
Public Information As Variant 
Private m_marginLeft As Integer 
Private m_marginRight As Integer 
Private m_CueBanner As String 
 
Event Click() 
Event DblClick() 
Event KeyDown(KeyCode As Integer, Shift As Integer) 
Event KeyPress(KeyAscii As Integer) 
Event KeyUp(KeyCode As Integer, Shift As Integer) 
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
 
Public Property Get BackColor() As OLE_COLOR 
    BackColor = Text1.BackColor 
End Property 
 
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) 
    Text1.BackColor() = New_BackColor 
    PropertyChanged "BackColor" 
End Property 
 
Public Property Get ForeColor() As OLE_COLOR 
    ForeColor = Text1.ForeColor 
End Property 
 
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR) 
    Text1.ForeColor() = New_ForeColor 
    PropertyChanged "ForeColor" 
End Property 
 
Public Property Get Enabled() As Boolean 
    Enabled = Text1.Enabled 
End Property 
 
Public Property Let Enabled(ByVal New_Enabled As Boolean) 
    Text1.Enabled() = New_Enabled 
    PropertyChanged "Enabled" 
End Property 
 
Public Property Get Font() As Font 
    Set Font = Text1.Font 
End Property 
 
Public Property Set Font(ByVal New_Font As Font) 
    Set Text1.Font = New_Font 
    PropertyChanged "Font" 
End Property 
 
Public Property Get BorderStyle() As eBorderStyle 
    BorderStyle = Text1.BorderStyle 
End Property 
 
Public Property Let BorderStyle(ByVal New_BorderStyle As eBorderStyle) 
    Text1.BorderStyle() = New_BorderStyle 
    PropertyChanged "BorderStyle" 
End Property 
 
Public Sub Refresh() 
    Text1.Refresh 
End Sub 
 
Private Sub Text1_Click() 
    RaiseEvent Click 
End Sub 
 
Private Sub Text1_DblClick() 
    RaiseEvent DblClick 
End Sub 
 
Private Sub Text1_GotFocus() 
    On Error Resume Next 
    If AutoSelection Then 
        Text1.SelStart = 0 
        Text1.SelLength = Len(Text1.Text) 
    End If 
End Sub 
 
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) 
    RaiseEvent KeyDown(KeyCode, Shift) 
End Sub 
 
Private Sub Text1_KeyPress(KeyAscii As Integer) 
    Dim intSelStart As Integer 
    Dim strText As String 
 
    RaiseEvent KeyPress(KeyAscii) 
    If AutoTab Then 
        If KeyAscii = 13 Then SendKeys "{Tab}" 
    End If 
    If KeyAscii = 8 Then 
        Exit Sub 
    End If 
    Select Case TextConvertion 
        Case GeneralConvertion 
        Case UpperCase 
            KeyAscii = Asc(StrConv(Chr(KeyAscii), vbUpperCase)) 
        Case LowerCase 
            KeyAscii = Asc(StrConv(Chr(KeyAscii), vbLowerCase)) 
        Case ProperCase 
            intSelStart = Text1.SelStart 
            strText = Text1.Text 
            strText = StrConv(strText, vbProperCase) 
            Text1.Text = strText 
            If Text1.SelLength = Len(Text1.Text) Then 
                Text1.SelStart = Len(Text1.Text) 
            Else 
                Text1.SelStart = intSelStart 
            End If 
    End Select 
 
    If TextValidation = Numeric Then 
        Dim intDummyDecimalSymbol As Integer 
        strText = Text1.Text 'hanya untuk mempercepat & mencegah dari terjadinya flick 
        intDummyDecimalSymbol = IIf(InStr(1, strText, Chr(GetDecimalSymbol)) = 0, GetDecimalSymbol, 0) 
        If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or _ 
        KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii = intDummyDecimalSymbol) Then 
        KeyAscii = 0 
    End If 
    On Error Resume Next 
    Text1.Text = strText 
    Exit Sub 
End If 
 
Select Case TextValidation 
    Case Alphabet 
        If Not Chr(KeyAscii) Like "*[a-zA-Z]*" Then 
            KeyAscii = 0 
        End If 
    Case AlphaNumeric 
        If Not Chr(KeyAscii) Like "*[a-zA-Z0-9]*" Then 
            KeyAscii = 0 
        End If 
End Select 
 
End Sub 
 
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) 
    RaiseEvent KeyUp(KeyCode, Shift) 
End Sub 
 
Private Sub Text1_LostFocus() 
    PropertyChanged "Text" 
End Sub 
 
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseDown(Button, Shift, X, Y) 
End Sub 
 
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseMove(Button, Shift, X, Y) 
End Sub 
 
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseUp(Button, Shift, X, Y) 
End Sub 
 
Public Property Get Alignment() As eAlignment 
    Alignment = Text1.Alignment 
End Property 
 
Public Property Let Alignment(ByVal New_Alignment As eAlignment) 
    Text1.Alignment() = New_Alignment 
    PropertyChanged "Alignment" 
End Property 
 
Public Property Get Appearance() As eAppearance 
    Appearance = Text1.Appearance 
End Property 
 
Public Property Let Appearance(ByVal New_Appearance As eAppearance) 
    Text1.Appearance() = New_Appearance 
    PropertyChanged "Appearance" 
End Property 
 
Public Property Get CausesValidation() As Boolean 
    CausesValidation = Text1.CausesValidation 
End Property 
 
Public Property Let CausesValidation(ByVal New_CausesValidation As Boolean) 
    Text1.CausesValidation() = New_CausesValidation 
    PropertyChanged "CausesValidation" 
End Property 
 
Public Property Get HideSelection() As Boolean 
    HideSelection = Text1.HideSelection 
End Property 
 
Public Property Get LinkItem() As String 
    LinkItem = Text1.LinkItem 
End Property 
 
Public Property Let LinkItem(ByVal New_LinkItem As String) 
    Text1.LinkItem() = New_LinkItem 
    PropertyChanged "LinkItem" 
End Property 
 
Public Property Get LinkMode() As eLinkMode 
    LinkMode = Text1.LinkMode 
End Property 
 
Public Property Let LinkMode(ByVal New_LinkMode As eLinkMode) 
    Text1.LinkMode() = New_LinkMode 
    PropertyChanged "LinkMode" 
End Property 
 
Public Property Get LinkTimeout() As Integer 
    LinkTimeout = Text1.LinkTimeout 
End Property 
 
Public Property Let LinkTimeout(ByVal New_LinkTimeout As Integer) 
    Text1.LinkTimeout() = New_LinkTimeout 
    PropertyChanged "LinkTimeout" 
End Property 
 
Public Property Get LinkTopic() As String 
    LinkTopic = Text1.LinkTopic 
End Property 
 
Public Property Let LinkTopic(ByVal New_LinkTopic As String) 
    Text1.LinkTopic() = New_LinkTopic 
    PropertyChanged "LinkTopic" 
End Property 
 
Public Property Get Locked() As Boolean 
    Locked = Text1.Locked 
End Property 
 
Public Property Let Locked(ByVal New_Locked As Boolean) 
    Text1.Locked() = New_Locked 
    PropertyChanged "Locked" 
End Property 
 
Public Property Get MaxLength() As Long 
    MaxLength = Text1.MaxLength 
End Property 
 
Public Property Let MaxLength(ByVal New_MaxLength As Long) 
    Text1.MaxLength() = New_MaxLength 
    PropertyChanged "MaxLength" 
End Property 
 
Public Property Get MouseIcon() As Picture 
    Set MouseIcon = Text1.MouseIcon 
End Property 
 
Public Property Set MouseIcon(ByVal New_MouseIcon As Picture) 
    Set Text1.MouseIcon = New_MouseIcon 
    PropertyChanged "MouseIcon" 
End Property 
 
Public Property Get MousePointer() As eMousePointer 
    MousePointer = Text1.MousePointer 
End Property 
 
Public Property Let MousePointer(ByVal New_MousePointer As eMousePointer) 
    Text1.MousePointer() = New_MousePointer 
    PropertyChanged "MousePointer" 
End Property 
 
Public Property Get MultiLine() As Boolean 
    MultiLine = Text1.MultiLine 
End Property 
 
Public Property Get OLEDragMode() As eOLEDragMode 
    OLEDragMode = Text1.OLEDragMode 
End Property 
 
Public Property Let OLEDragMode(ByVal New_OLEDragMode As eOLEDragMode) 
    Text1.OLEDragMode() = New_OLEDragMode 
    PropertyChanged "OLEDragMode" 
End Property 
 
Public Property Get OLEDropMode() As eOLEDropMode 
    OLEDropMode = Text1.OLEDropMode 
End Property 
 
Public Property Let OLEDropMode(ByVal New_OLEDropMode As eOLEDropMode) 
    Text1.OLEDropMode() = New_OLEDropMode 
    PropertyChanged "OLEDropMode" 
End Property 
 
Public Property Get PasswordChar() As String 
    PasswordChar = Text1.PasswordChar 
End Property 
 
Public Property Let PasswordChar(ByVal New_PasswordChar As String) 
    Text1.PasswordChar() = New_PasswordChar 
    PropertyChanged "PasswordChar" 
End Property 
 
Public Property Get RightToLeft() As Boolean 
    RightToLeft = Text1.RightToLeft 
End Property 
 
Public Property Let RightToLeft(ByVal New_RightToLeft As Boolean) 
    Text1.RightToLeft() = New_RightToLeft 
    PropertyChanged "RightToLeft" 
End Property 
 
Public Property Get ScrollBars() As eScrollBars 
    ScrollBars = Text1.ScrollBars 
End Property 
 
Public Property Get SelLength() As Long 
    SelLength = Text1.SelLength 
End Property 
 
Public Property Let SelLength(ByVal New_SelLength As Long) 
    Text1.SelLength() = New_SelLength 
    PropertyChanged "SelLength" 
End Property 
 
Public Property Get SelStart() As Long 
    SelStart = Text1.SelStart 
End Property 
 
Public Property Let SelStart(ByVal New_SelStart As Long) 
    Text1.SelStart() = New_SelStart 
    PropertyChanged "SelStart" 
End Property 
 
Public Property Get SelText() As String 
    SelText = Text1.SelText 
End Property 
 
Public Property Let SelText(ByVal New_SelText As String) 
    Text1.SelText() = New_SelText 
    PropertyChanged "SelText" 
End Property 
 
Public Property Get Text() As String 
    Text = Text1.Text 
End Property 
 
Public Property Let Text(ByVal New_Text As String) 
    Text1.Text() = New_Text 
    PropertyChanged "Text" 
End Property 
 
Public Property Get WhatsThisHelpID() As Long 
    WhatsThisHelpID = Text1.WhatsThisHelpID 
End Property 
 
Public Property Let WhatsThisHelpID(ByVal New_WhatsThisHelpID As Long) 
    Text1.WhatsThisHelpID() = New_WhatsThisHelpID 
    PropertyChanged "WhatsThisHelpID" 
End Property 
 
Private Sub UserControl_Initialize() 
    AutoSelection = True 
    AutoTab = True 
    AllowDecimal = False 
End Sub 
 
Private Sub MoveTextBox() 
    Text1.Move 0, 0, ScaleWidth, ScaleHeight 
End Sub 
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) 
    MoveTextBox 
    Text1.Text = PropBag.ReadProperty("Text", "Text1") 
    Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005) 
    Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008) 
    Text1.Enabled = PropBag.ReadProperty("Enabled", True) 
    Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font) 
    Text1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1) 
    Text1.Alignment = PropBag.ReadProperty("Alignment", 0) 
    Text1.Appearance = PropBag.ReadProperty("Appearance", 1) 
    Text1.CausesValidation = PropBag.ReadProperty("CausesValidation", True) 
    Text1.LinkItem = PropBag.ReadProperty("LinkItem", "") 
    Text1.LinkMode = PropBag.ReadProperty("LinkMode", 0) 
    Text1.LinkTimeout = PropBag.ReadProperty("LinkTimeout", 50) 
    Text1.LinkTopic = PropBag.ReadProperty("LinkTopic", "") 
    Text1.Locked = PropBag.ReadProperty("Locked", False) 
    Text1.MaxLength = PropBag.ReadProperty("MaxLength", 0) 
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing) 
    Text1.MousePointer = PropBag.ReadProperty("MousePointer", 0) 
    Text1.OLEDragMode = PropBag.ReadProperty("OLEDragMode", 0) 
    Text1.OLEDropMode = PropBag.ReadProperty("OLEDropMode", 0) 
    Text1.PasswordChar = PropBag.ReadProperty("PasswordChar", "") 
    Text1.RightToLeft = PropBag.ReadProperty("RightToLeft", False) 
    Text1.SelLength = PropBag.ReadProperty("SelLength", 0) 
    Text1.SelStart = PropBag.ReadProperty("SelStart", 0) 
    Text1.SelText = PropBag.ReadProperty("SelText", "") 
    Text1.WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", 0) 
    AutoSelection = PropBag.ReadProperty("AutoSelection", True) 
    AutoTab = PropBag.ReadProperty("AutoTab", True) 
    TextConvertion = PropBag.ReadProperty("TextConvertion", 0) 
    TextValidation = PropBag.ReadProperty("TextValidation", 0) 
    AllowDecimal = PropBag.ReadProperty("AllowDecimal", False) 
    Required = PropBag.ReadProperty("Required", True) 
    Information = PropBag.ReadProperty("Information", "") 
    m_marginLeft = PropBag.ReadProperty("MarginLeft", 0) 
    m_marginRight = PropBag.ReadProperty("MarginRight", 0) 
    m_CueBanner = PropBag.ReadProperty("CueBanner", "") 
    SetCueBanner Text1, m_CueBanner 
    SetMargin 
End Sub 
 
Private Sub UserControl_Resize() 
    MoveTextBox 
End Sub 
 
Private Sub UserControl_Show() 
    UserControl.Refresh 
    Text1.Refresh 
End Sub 
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) 
    Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005) 
    Call PropBag.WriteProperty("ForeColor", Text1.ForeColor, &H80000008) 
    Call PropBag.WriteProperty("Enabled", Text1.Enabled, True) 
    Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font) 
    Call PropBag.WriteProperty("BorderStyle", Text1.BorderStyle, 1) 
    Call PropBag.WriteProperty("Alignment", Text1.Alignment, 0) 
    Call PropBag.WriteProperty("Appearance", Text1.Appearance, 1) 
    Call PropBag.WriteProperty("CausesValidation", Text1.CausesValidation, True) 
    Call PropBag.WriteProperty("LinkItem", Text1.LinkItem, "") 
    Call PropBag.WriteProperty("LinkMode", Text1.LinkMode, 0) 
    Call PropBag.WriteProperty("LinkTimeout", Text1.LinkTimeout, 50) 
    Call PropBag.WriteProperty("LinkTopic", Text1.LinkTopic, "") 
    Call PropBag.WriteProperty("Locked", Text1.Locked, False) 
    Call PropBag.WriteProperty("MaxLength", Text1.MaxLength, 0) 
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing) 
    Call PropBag.WriteProperty("MousePointer", Text1.MousePointer, 0) 
    Call PropBag.WriteProperty("OLEDragMode", Text1.OLEDragMode, 0) 
    Call PropBag.WriteProperty("OLEDropMode", Text1.OLEDropMode, 0) 
    Call PropBag.WriteProperty("PasswordChar", Text1.PasswordChar, "") 
    Call PropBag.WriteProperty("RightToLeft", Text1.RightToLeft, False) 
    Call PropBag.WriteProperty("SelLength", Text1.SelLength, 0) 
    Call PropBag.WriteProperty("SelStart", Text1.SelStart, 0) 
    Call PropBag.WriteProperty("SelText", Text1.SelText, "") 
    Call PropBag.WriteProperty("Text", Text1.Text, "") 
    Call PropBag.WriteProperty("WhatsThisHelpID", Text1.WhatsThisHelpID, 0) 
    Call PropBag.WriteProperty("AutoSelection", AutoSelection, True) 
    Call PropBag.WriteProperty("AutoTab", AutoTab, True) 
    Call PropBag.WriteProperty("TextConvertion", TextConvertion, 0) 
    Call PropBag.WriteProperty("TextValidation", TextValidation, 0) 
    Call PropBag.WriteProperty("Text", Text1.Text, "Text1") 
    Call PropBag.WriteProperty("AllowDecimal", AllowDecimal, False) 
    Call PropBag.WriteProperty("Required", Required, True) 
    Call PropBag.WriteProperty("Information", Information, "") 
    Call PropBag.WriteProperty("MarginLeft", m_marginLeft, 0) 
    Call PropBag.WriteProperty("MarginRight", m_marginRight, 0) 
    Call PropBag.WriteProperty("CueBanner", m_CueBanner, "") 
End Sub 
 
Private Sub Text1_Change() 
    PropertyChanged "Text" 
End Sub 
 
Public Function GetDecimalSymbol() As Integer 
    If AllowDecimal Then GetDecimalSymbol = Asc(Mid$(1 / 2, 2, 1)) 
End Function 
 
Public Property Get MarginLeft() As Integer 
    MarginLeft = m_marginLeft 
End Property 
 
Public Property Let MarginLeft(ByVal New_MarginLeft As Integer) 
    m_marginLeft = New_MarginLeft 
    PropertyChanged "MarginLeft" 
    SetMargin 
End Property 
 
Public Property Get MarginRight() As Integer 
    MarginRight = m_marginRight 
End Property 
 
Public Property Let MarginRight(ByVal New_MarginRight As Integer) 
    m_marginRight = New_MarginRight 
    PropertyChanged "MarginRight" 
    SetMargin 
End Property 
 
Private Sub SetMargin() 
    Dim long_value As Long 
    Dim s As String 
    long_value = m_marginRight * &H10000 + m_marginLeft 
    SendMessage Text1.hwnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, long_value 
    s = Text1.Text 
    Text1.Text = "" 
    Text1.Text = s 
End Sub 
 
Public Property Get CueBanner() As String 
    CueBanner = m_CueBanner 
End Property 
 
Public Property Let CueBanner(ByVal New_CueBanner As String) 
    m_CueBanner = New_CueBanner 
    PropertyChanged "CueBanner" 
    SetCueBanner Text1, m_CueBanner 
End Property 
 
Private Sub SetCueBanner(obj As Object, str As String) 
    Dim s As String 
    s = StrConv(str, vbUnicode) 
    Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s) 
End Sub  
 
 

READ MORE - Class TextBox - Untuk Mempermudah Pembuatan Aplikasi

VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

Mengenai cara mengisi ListBox atau ComboBox dengan seluruh isi file menggunakan VB6 Code. Adapun cara mengisi ListBox atau ComboBox dengan isi seluruh file adalah sebagai berikut: 

Public Sub LoadFileToComboOrList(FileName As String, obj As Object) 
    Dim s As String 
    Dim InFile As Integer   ' Descriptor for file. 
    InFile = FreeFile 
    Open FileName For Input As InFile 
        While Not EOF(InFile) 
            Line Input #InFile, s 
            obj.AddItem s 
        Wend 
    Close InFile 
End Sub 

READ MORE - VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

Menyembunyikan TextBox dan ComboBox Caret Menggunakan VB6

Terkadang dalam sebuah aplikasi, kita membutuhkan kode untuk menyembunyikan caret yang terdapat dalam TextBox maupun ComboBox. Nah, bagaimana cara menyembunyikan caret yang terdapat dalam TextBox maupun ComboBox menggunakan Visual Basic 6.0 (VB6)? kode di bawah mungkin jawabannya:

'simpan kode di bawah pada modul 
Option Explicit 
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 
'Public Declare Function HideCaret Lib "user32" ByVal hwnd As Long) As Long 
 
'prosedur memperoleh handle edit yang terdapat   dalam ComboBox 
Public Function EditComboHWND(cmb As ComboBox) As Long 
    Dim r As Long 
    r = FindWindowEx(cmb.hwnd, ByVal 0&, "Edit", vbNullString) 
    EditComboHWND = r 
End Function 

Contoh penggunaan:

'simpan kode ini pada Form 
Option Explicit 
 
Private Sub Combo1_GotFocus() 
    'sembunyikan caret yang terdapat dalam ComboBox 
    HideCaret EditComboHWND(Combo1) 
End Sub 
 
Private Sub Text1_GotFocus() 
    'sembunyikan caret yang terdapat pada TextBox 
      HideCaret Text1.hwnd 
End Sub 

READ MORE - Menyembunyikan TextBox dan ComboBox Caret Menggunakan VB6

TextBox Auto Complete Dan Pencarian Cepat Pada ListBox

Apabila Anda pernah menggunakan Tools API-Guide salah satu produk AllApi.net, maka kita akan melihat salah satu TextBox (untuk pencarian fungsi API) yang dilengkapi dengan fasilitas Auto Complete. Auto Complete ini sangat tepat bagi Anda yang sedang mengembangkan aplikasi kamus, database (unbound-control), maupun aplikasi-aplikasi yang menuntut pencarian cepat. Agar lebih jelas, apa yang dimaksud dengan AutoComplete itu perhatikan gambar di bawah ini:

'simpan kode di bawah ini pada modul 
Option Explicit 
 
Public Function TextBoxAutoComplete(Key As Integer, txt As TextBox, lst As ListBox) 
    'fitur auto complete 
    If Key = vbKeyBack Then Exit Function 
    If Key =   vbKeyDelete Then Exit Function 
    
    Dim start As Integer 
     
    If InStr(1, lst.Text, txt.Text) > 0 Then 
        start = txt.SelStart 
        txt.Text = lst.Text 
        If Key = 13 Then 'enter 
            txt.SelStart = Len(txt.Text) 
            Exit Function 
        End If 
        txt.SelStart = start 
        txt.SelLength = Len(lst.Text) 
    End If 
End Function 

Contoh penggunaan fungsi di atas:

'simpan kode di bawah ini pada form 
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) 
    Call TextBoxAutoComplete(KeyCode, Text1, List1) 
End Sub 

READ MORE - TextBox Auto Complete Dan Pencarian Cepat Pada ListBox

Kode Ini Efektif Untuk Validasi Empty Text - Database VB6

Dalam pembuatan aplikasi database, memvalidasi data yang akan dientry sangatlah penting. Apakah tujuan utama dari validasi entry tersebut? diantaranya sebagai berikut:

• Pertama: Mengarahkan user untuk mengisi form secara benar.
• Kedua: Meminimalisir error yang terjadi
• Ketiga dan seterusnya : Silakan Anda tambahkan.

Dari sekian banyak validasi entry yang umum digunakan, diantaranya adalah validasi empty text, yang digunakan untuk memeriksa apakah text telah terisi atau belum.

Di bawah merupakan kode yang efektif untuk tujuan di atas (kode ini dilengkapi dengan pesan yang spesifik yang diambil dari caption label):

'Fungsi untuk memvalidasi empty text secara massal disertai dengan 
'warning message yang spesifik, simpan kode ini dalam modul 
Public Function IsFilledAll(l As Variant, t As Variant) As Boolean 
    Dim o As Object 
     For Each o In t 
       If Trim(o.Text) = "" Then 
            MsgBox "Maaf, informasi " & Replace(l(o.Index).Caption, "&", "") & " tidak boleh dikosongkan", vbInformation + vbOKOnly, "Perhatian" 
            o.SetFocus 
            Exit For 
       Else 
        IsFilledAll = True 
      End If 
    Next 
End Function 

Contoh penggunaan fungsi di atas:

Option Explicit 
'Simpan kode ini pada form untuk mengecek empty text 
Private Sub cmdCheck_click() 
    If Not IsFilledAll(Label1, Text1) Then Exit Sub 'Check apakah terdapat textbox kosong 
    'Jika textbox telah diisi maka lanjutkan pada kode berikutnya 
    MsgBox "Seluruh data telah terisi!", vbInformation, "Terima Kasih" 
End Sub 
 

READ MORE - Kode Ini Efektif Untuk Validasi Empty Text - Database VB6

Memperoleh Jumlah Baris TextBox Menggunakan Fungsi API

<pre class=code>Option Explicit 
 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Private Const EM_GETLINECOUNT = &HBA 
 
Public Function GetLineCount(Txt As TextBox) 
    Dim lngLineCount As Long 
    On Error Resume Next 
    lngLineCount = SendMessageLong(Txt.hwnd, EM_GETLINECOUNT, 0&, 0&) 
    GetLineCount =   Format$(lngLineCount, "##,###") 
End Function</pre> 

Private Sub Command1_Click() 
    MsgBox GetLineCount(Text1) 
End Sub 

READ MORE - Memperoleh Jumlah Baris TextBox Menggunakan Fungsi API

Menjadikan Input TextBox Kapital

Option Explicit 
 
'This one line code makes the contents of text box in capital. As you keep in typing it. Just copy this code keypress  
Private Sub Text1_KeyPress(KeyAscii As Integer) 
    KeyAscii = Asc(UCase(Chr(KeyAscii))) 
End Sub 

READ MORE - Menjadikan Input TextBox Kapital

Menghapus Isi TextBox Dengan Cepat Menggunakan For...Each

Option Explicit 
 
Public Sub ClearAllTextBoxes(frmClearMe As Form) 
    Dim txt As Control 
    For Each txt In frmClearMe 
        If TypeOf txt Is TextBox Then txt.Text = "" 
    Next 
End Sub 

Private Sub Command1_Click() 
    ClearAllTextBoxes Me 
End Sub 

READ MORE - Menghapus Isi TextBox Dengan Cepat Menggunakan For...Each

Menampilkan Vertical ScrollBar Pada TextBox Pada Saat Runtime

Di bawah ini merupakan fungsi untuk menampilkan Vertical ScrollBar pada TextBox.

Option Explicit 
 
Private Declare Function ShowScrollBar Lib "user32" ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long 
 
Public Function ShowScroll(obj As Control, bShow As Boolean) 
    ShowScrollBar obj.hwnd, 1, bShow 
    obj.Refresh 
End Function 

Contoh penggunaan kode di atas:

Public Sub Command1_Click()   
     ShowScroll Text1, True 
End Sub 

READ MORE - Menampilkan Vertical ScrollBar Pada TextBox Pada Saat Runtime

TextBox Hanya Untuk Numeric | Visual Basic 6.0

Artikel ini diberi judul textbox hanya untuk numeric, maksudnya ialah sebuah TextBox hanya dapat diisi dengan angka saja. Kodenya kami buat menjadi sebuah fungsi agar lebih mudah dalam penggunaan. Adapun kode yang dimaksud:

Option Explicit 
 
Private Sub OnlyNumeric(KeyAscii As Integer) 
 
    Select Case KeyAscii 
        Case 48 To 57         ' numeric 
        Case 8                ' backspace 
        Case Else: KeyAscii = 0 
    End Select 
 
End Sub 

Cara penggunaan Fungsi TextBox hanya untuk numerik

Private Sub Text1_KeyPress(KeyAscii As Integer) 
    OnlyNumeric KeyAscii 
End Sub 

READ MORE - TextBox Hanya Untuk Numeric | Visual Basic 6.0

Hanya 1 Baris Untuk Validasi Angka - Visual Basic 6

Di bawah ini merupakan kode untuk memvalidasi angka pada sebuah TextBox, maksudnya pada objek TextBox tersebut hanya memperbolehkan angka saja. Kodenya sangat sederhana, hanya satu baris saja yaitu: KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)

Contoh penggunaan:

Private Sub Text1_KeyPress(KeyAscii As Integer) 
    KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0) 
End Sub 

Kode di atas tentu saja bisa dikembangkan lebih baik, misalnya untuk angka di belakang koma, dsb.

READ MORE - Hanya 1 Baris Untuk Validasi Angka - Visual Basic 6