<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
