kalau mau, bisa pake class berikut ini (liat attachment), ntar kalau ada yg kurang jelas, email via japri aja.
best regards
[wwn]
On 2/1/06, dany_nurul <[EMAIL PROTECTED]> wrote:
ada yg tau g? syntax auto complete di textbox yang datanya diambil
dari adodc. terima kasih
salam kenal...
Wahana Programmer Groups Links
<*> Untuk mengunjungi sponsor milis ini, klik link berikut:
http://wahanaprogrammer.net
<*> Untuk menghubungi owner milis ini, kirim email ke:
[EMAIL PROTECTED]
<*> Konsultasi pemrogramman bisa chat disini:
Yahoo! Messenger: wahanaprogrammer
SPONSORED LINKS
| Programmer | Indonesia | Basic programming language |
| Computer programming languages | Programming languages | Java programming language |
YAHOO! GROUPS LINKS
- Visit your group "Programmer-VB" on the web.
- To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
- Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "clsListOfValue" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" Attribute VB_Ext_KEY = "Top_Level" ,"Yes" Option Explicit
'------------------------------------------------------------------------------------------
'name: clsListOfValue
'purpose: displaying list of value as a result of database query
'property:
' CtlBuddy: parent Textbox that own the list
' CtlList: Listbox handled the result of database query
' CtlListShadow: Frame for shadowing the listbox, for ui only
' Optional:
' CtlFrame: frame that own the parent textbox, if exist
'how to use:
' 1. on form load:
' set the CtlList and CtlListShadow property to valid listbox and
frame
' 2. on parent textbox gotfocus:
' set the CtlBuddy property to that textbox, set the CtlFrame if exist
' call showlistofvalue method
'author: purwedi kurniawan
'revision history:
' march 22, 2004 created
' may 5, 2004 compiled to dll
' oct 8, 2004 add this class into common function lib
' oct 12, 2004 add filterfields properties, the conditional query is base
on the contents of ctlbuddy
'------------------------------------------------------------------------------------------
'local variable(s) to hold property value(s)
Private WithEvents m_txtBuddy As TextBox 'local copy
Attribute m_txtBuddy.VB_VarHelpID = -1
Private WithEvents m_lstList As ListBox 'local copy
Attribute m_lstList.VB_VarHelpID = -1
Private m_fraShadow As Frame 'local copy
Private m_fraBuddy As Control 'local copy
Private m_bListOfValue As Boolean
Private m_sRecordSource As String
Private m_sConnectionString As String 'local copy
Private m_isError As Boolean 'local copy
Private m_sErrorMessage As String 'local copy
Private m_sFilterFields As String
Private m_cn As ADODB.Connection
Private m_rs As ADODB.Recordset
'local variable(s) to hold property value(s)
Private m_bMDIChild As Boolean 'local copy
'local variable(s) to hold property value(s)
Private m_lMinLeftPos As Long 'local copy
Private m_lMinTopPos As Long 'local copy
Public Property Let MinTopPos(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MinTopPos = 5
m_lMinTopPos = vData
End Property
Public Property Let MinLeftPos(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MinLeftPos = 5
m_lMinLeftPos = vData
End Property
Public Property Let MDIChild(ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MDIChild = 5
m_bMDIChild = vData
End Property
Public Property Let ConnectionString(ByVal sConnectionString As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.ConnectionString = 5
m_sConnectionString = sConnectionString
With m_cn
.CursorLocation = adUseClient
.ConnectionString = m_sConnectionString
.Open
End With
With m_rs
.ActiveConnection = m_cn
.CursorType = adOpenForwardOnly
.CursorLocation = adUseClient
End With
End Property
'------------------------------------------------------------------------------------------
' REGION OF CLASS PROPERTY
'------------------------------------------------------------------------------------------
Public Property Let FilterFields(ByVal sFields As String)
m_sFilterFields = " where " & sFields & " like '#%'"
End Property
Public Property Let RecordSource(ByVal sQuery As String)
m_sRecordSource = sQuery
End Property
Public Property Set CtlFrameBuddy(ByVal vData As Object)
'used when assigning an Object to the property, on the left side of a Set
statement.
'Syntax: Set x.CtlFrameBuddy = Form1
Set m_fraBuddy = vData
End Property
Public Property Set CtlListShadow(ByVal vData As Object)
'used when assigning an Object to the property, on the left side of a Set
statement.
'Syntax: Set x.CtlListShadow = Form1
Set m_fraShadow = vData
With m_fraShadow
.BackColor = &H80000010 '&H8000000B '&H80000018 '&H808080
.BorderStyle = 0
.Caption = ""
End With
End Property
Public Property Set CtlList(ByVal vData As Object)
'used when assigning an Object to the property, on the left side of a Set
statement.
'Syntax: Set x.CtlList = Form1
Set m_lstList = vData
End Property
Public Property Set CtlBuddy(ByVal vData As Object)
'used when assigning an Object to the property, on the left side of a Set
statement.
'Syntax: Set x.CtlBuddy = Form1
Set m_txtBuddy = vData
End Property
'------------------------------------------------------------------------------------------
' REGION OF CLASS EVENTS HANDLER
'------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
Set m_cn = New ADODB.Connection
Set m_rs = New ADODB.Recordset
End Sub
Private Sub Class_Terminate()
If m_rs.State = adStateOpen Then m_rs.Close
If m_cn.State = adStateOpen Then m_cn.Close
Set m_rs = Nothing
Set m_cn = Nothing
End Sub
'------------------------------------------------------------------------------------------
' REGION OF PUBLIC METHODS
'------------------------------------------------------------------------------------------
Public Sub HideListOfValue()
On Error Resume Next
With m_lstList
.Visible = False
.Clear
End With
m_fraShadow.Visible = False
m_bListOfValue = False
End Sub
Public Sub ShowListOfValue()
Dim nTop As Integer, nLeft As Integer, nScaleX As Integer, nScaleY As
Integer
On Error GoTo ShowListOfValue_Error
If m_txtBuddy.Parent.ScaleMode = 3 Then
nScaleX = Screen.TwipsPerPixelX
nScaleY = Screen.TwipsPerPixelY
ElseIf m_txtBuddy.Parent.ScaleMode = 1 Then
nScaleX = 1
nScaleY = 1
End If
nTop = 0: nLeft = 0
If Not m_fraBuddy Is Nothing Then nTop = m_fraBuddy.Top * nScaleY: nLeft =
m_fraBuddy.Left * nScaleX '+ 100
With m_lstList
.Clear
.Width = m_txtBuddy.Width * nScaleX
.Height = 3 * nScaleY * m_txtBuddy.Height * nScaleY
.Left = m_txtBuddy.Left * nScaleX + 160 * nScaleX + nLeft +
m_lMinLeftPos
If m_bMDIChild Then
.Top = m_txtBuddy.Top * nScaleY + (m_txtBuddy.Height * nScaleY) *
1.8 + nTop + m_lMinTopPos
Else
.Top = m_txtBuddy.Top * nScaleY + m_txtBuddy.Height * nScaleY +
nTop + m_lMinTopPos
End If
End With
With m_fraShadow
.Width = m_lstList.Width * nScaleX
.Height = m_lstList.Height * nScaleY
.Left = m_lstList.Left * nScaleX + 40 * nScaleX
.Top = m_lstList.Top * nScaleY + 40 * nScaleY
.ZOrder 0
m_lstList.ZOrder 0
End With
Dim sQuery As String
sQuery = m_sRecordSource & m_sFilterFields
sQuery = Replace(sQuery, "#", Trim(m_txtBuddy.Text))
With m_rs
If .State = adStateOpen Then .Close
.Source = sQuery
.Open
End With
'Set rs = Cn.Execute(sQuery) 'm_sRecordSource)
'Set rs = cAdo.OpenRecordset(, m_sRecordSource, adOpenForwardOnly,
adLockReadOnly)
If Not (m_rs.BOF And m_rs.EOF) Then
'rs.MoveFirst
Do While Not m_rs.EOF
m_lstList.AddItem m_rs.Fields(0)
m_rs.MoveNext
Loop
m_lstList.Refresh
End If
m_rs.Close
m_lstList.Visible = True
m_fraShadow.Visible = True
On Error GoTo 0
Exit Sub
ShowListOfValue_Error: pPrintError "ShowListOfValue", , , m_sRecordSource
End Sub
Private Sub m_lstList_Click()
'm_lstList_KeyDown vbKeyReturn, -1
End Sub
'------------------------------------------------------------------------------------------
' REGION OF OBJECT CONTROL EVENTS HANDLER
'------------------------------------------------------------------------------------------
Private Sub m_lstList_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = vbKeyReturn Then
With m_txtBuddy
.Text = m_lstList.List(m_lstList.ListIndex)
.SetFocus
End With
HideListOfValue
End If
End Sub
Private Sub m_lstList_LostFocus()
m_bListOfValue = False
End Sub
Private Sub m_lstList_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
If Button = vbKeyLButton Then m_lstList_KeyDown vbKeyReturn, Shift
End Sub
Private Sub m_txtBuddy_Change()
ShowListOfValue
End Sub
Private Sub m_txtBuddy_GotFocus()
Call ShowListOfValue
End Sub
Private Sub m_txtBuddy_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = vbKeyReturn Then
HideListOfValue
ElseIf KeyCode = vbKeyDown Then
With m_lstList
.SetFocus
.ListIndex = 0
End With
m_bListOfValue = True
End If
End Sub
Private Sub m_txtBuddy_LostFocus()
If Not m_bListOfValue Then HideListOfValue
End Sub
Private Sub pPrintError(ErrMethod As String, Optional ErrNo As String = "",
Optional ErrDesc As String = "", Optional ErrQuery As String = "-")
Dim sErrMessage As String
If ErrNo = "" Then ErrNo = Err.Number
If ErrDesc = "" Then ErrDesc = Err.Description
sErrMessage = ".:: BOL ::." & vbCrLf _
& "Error raise at class ADOSQL:" & ErrMethod & vbCrLf _
& "Error details: " & vbCrLf _
& "+ Number: " & ErrNo & vbCrLf _
& "+ Description: " & ErrDesc & vbCrLf _
& "+ Query: """ & ErrQuery & """" & vbCrLf _
& ".:: EOL ::."
m_isError = True
m_sErrorMessage = sErrMessage
Debug.Print sErrMessage
End Sub
Public Property Get ErrorMessage() As String
If Not m_isError Then m_sErrorMessage = ""
ErrorMessage = m_sErrorMessage
End Property
Public Property Get IsError() As Boolean
IsError = m_isError
End Property
