تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] الاكمال التلقائي في Combo
#1
Question 
SmileSmile السلام عليكم و رحمة الله SmileSmile:

WinkWinkWink امل المساعده WinkWinkWink

في الاكمال التلقائي في Combo

ShyShyShy امل المساعده و الملف مرفق


الملفات المرفقة
.rar   الاكمال التلقائي.rar (الحجم : 8.68 ك ب / التحميلات : 60)
الرد }}}}
تم الشكر بواسطة:
#2
-
كود الإكمال التلقائي منقول + تحويل لوحة المفاتيح للغة العربية

كود :
Option Explicit
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

Private Sub Form_Load()
    Call language(True) ' تحويل لوحة المفاتيح للغة العربية
    On Error Resume Next
    
    Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb;Persist Security Info=False"
    Adodc1.RecordSource = "Select Distinct * From allayl"
    Adodc1.Refresh
    Combo1.Clear
    Do While Not Adodc1.Recordset.EOF
        Combo1.AddItem Adodc1.Recordset.Fields("name").Value
        Adodc1.Recordset.MoveNext
    Loop
    
    Me.Left = (Screen.Width / 2) - (Me.Width / 2)
    Me.Top = (Screen.Height / 2) - (Me.Height / 2)
End Sub

' الربط مع دالة الإكمال التلقائي
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
    AutoSel Combo1, KeyCode
End Sub

' دالة الإكمال التلقائي
Function AutoSel(cmb As ComboBox, KeyCode As Integer)
    
    On Error Resume Next
    Select Case KeyCode
        '  8 = Backspace, 37=LeftArraw,   38=UpArraw, 39=RightArraw, 40=DownArraw
        ' 46 = Delete,    33=PageUp,     34=PageDown, 35=End,        36=Home
        Case vbEnter, 8, 37, 38, 39, 40, 46, 33, 34, 35, 36
        Exit Function
    End Select
    
    Dim Text As String
    Text = cmb.Text
    
    Dim i As Long
    Dim Temp As String
    
    For i = 0 To cmb.ListCount
        Temp = Left(cmb.List(i), Len(Text))
        If LCase(Temp) = LCase(Text) Then
            cmb.Text = cmb.List(i)
            cmb.ListIndex = i
            cmb.SelStart = Len(Text)
            cmb.SelLength = Len(cmb.List(i))
        End If
    Next

End Function


Public Sub language(arabic As Boolean)
    If arabic Then
        Call LoadKeyboardLayout("00000401", 1)
    Else
        Call LoadKeyboardLayout("00000409", 1)
    End If
End Sub
الرد }}}}
تم الشكر بواسطة: allayl
#3
الكود ممتاز وشغال 100% اخي الكريم

المطلوب : عند كاتبة اول حرف يظهر النتائج المشابه فقط

يعني كتب حرف م يظهر لي محمد و ماجد فقط

امل المساعدة
الرد }}}}
تم الشكر بواسطة:
#4
كود التكملة التلقائية بالكومبو بوكس :
أول حاجة وضع هذا الكود في الموديول


كود :
Option Explicit
                ' هذا الكود يستخدم حتي يتم البحث داخل اداة الكمبو بوكس

'In KeyPress Enevt Method: KeyAscii = AutoMatchCBBox(ComBoBox, KeyAscii)
'

'VB ComboBox doesn't have SelectString(), so SendMessage to the Window Handle
'#define CB_SELECTSTRING     0x014D
'#define CB_SHOWDROPDOWN     0x014F
'#define CBN_SELENDOK        9
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 Const CB_ERR = -1, CB_SELECTSTRING = &H14D, CB_SHOWDROPDOWN = &H14F, CBN_SELENDOK = 9

'call this function in KeyPress event method
Public Function AutoMatchCBBox(ByRef cbBox As ComboBox, ByVal KeyAscii As Integer) As Integer
    
        
    Dim strFindThis As String, bContinueSearch As Boolean
    Dim lResult As Long, lStart As Long, lLength As Long
    AutoMatchCBBox = 0 ' block cbBox since we handle everything
    bContinueSearch = True
    lStart = cbBox.SelStart
    lLength = cbBox.SelLength

    On Error GoTo ErrHandle
        
    If KeyAscii < 32 Then 'control char
        bContinueSearch = False
        cbBox.SelLength = 0 'select nothing since we will delete/enter
        If KeyAscii = Asc(vbBack) Then 'take care BackSpace and Delete first
            If lLength = 0 Then 'delete last char
                If Len(cbBox) > 0 Then ' in case user delete empty cbBox
                    cbBox.Text = Left(cbBox.Text, Len(cbBox) - 1)
                End If
            Else 'leave unselected char(s) and delete rest of text
                cbBox.Text = Left(cbBox.Text, lStart)
            End If
            cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
        ElseIf KeyAscii = vbKeyReturn Then  'user select this string
            cbBox.SelStart = Len(cbBox)
            lResult = SendMessage(cbBox.HWnd, CBN_SELENDOK, 0, 0)
            AutoMatchCBBox = KeyAscii 'let caller a chance to handle "Enter"
        End If
    Else 'generate searching string
        If lLength = 0 Then
            strFindThis = cbBox.Text & Chr(KeyAscii) 'No selection, append it
        Else
            strFindThis = Left(cbBox.Text, lStart) & Chr(KeyAscii)
        End If
    End If
    
    If bContinueSearch Then 'need to search
        Call VBComBoBoxDroppedDown(cbBox)  'open dropdown list
        lResult = SendMessage(cbBox.HWnd, CB_SELECTSTRING, -1, ByVal strFindThis)
        If lResult = CB_ERR Then 'not found
            cbBox.Text = strFindThis 'set cbBox as whatever it is
            cbBox.SelLength = 0 'no selected char(s) since not found
            cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
        Else
            'found string, highlight rest of string for user
            cbBox.SelStart = Len(strFindThis)
            cbBox.SelLength = Len(cbBox) - cbBox.SelStart
        End If
    End If
    On Error GoTo 0
    Exit Function
    
ErrHandle:
    'got problem, simply return whatever pass in
    Debug.Print "Failed: AutoCompleteComboBox due to : " & Err.Description
    Debug.Assert False
    AutoMatchCBBox = KeyAscii
    On Error GoTo 0
End Function

'open dorpdown list
Private Sub VBComBoBoxDroppedDown(ByRef cbBox As ComboBox)
    Call SendMessage(cbBox.HWnd, CB_SHOWDROPDOWN, Abs(True), 0)
End Sub
الرد }}}}
تم الشكر بواسطة: allayl
#5
وثاني حاجة وضع الكود في الفورم الذي يوجد به الكمبو بوكس وسميه باسم comboitem:

كود :
Private Sub ComboItem_Click()
On Error Resume Next
'''''''''''''''' äÓÊÏÚí åÐÇ ÇáßæÏ ãä ÇÏáÉ ÇáãæÏíá ÍÊí íÊã ÇáÈÍË ÈÓÑÚÉ ÏÇÎá ÇáßãÈæ ÈæßÓ
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
KeyAscii = AutoMatchCBBox(ComboItem, KeyAscii)

Adodc2.RecordSource = "select * from emp_data where m_name like '" & Trim(ComboItem.Text) & "%'"
Adodc2.Refresh

If Adodc2.Recordset.BOF Or Adodc2.Recordset.EOF Then
CmdDel.Enabled = False
Else
CmdDel.Enabled = True
End If

End Sub

Private Sub ComboItem_DropDown()
On Error Resume Next  ' ÑÈØ ãÚ ÌÏæá ÈíÇäÇÊ ÇáãæÙÝíä
ComboItem.Clear
Adodc1.Recordset.MoveFirst
Adodc1.Refresh
Do While Not Adodc1.Recordset.EOF
If Trim(("itemname")) <> "" Then
ComboItem.AddItem Adodc1.Recordset.Fields(1)
End If
Adodc1.Recordset.MoveNext
Loop




End Sub

Private Sub ComboItem_KeyPress(KeyAscii As Integer)
On Error Resume Next
'''''''''''''''' äÓÊÏÚí åÐÇ ÇáßæÏ ãä ÇÏáÉ ÇáãæÏíá ÍÊí íÊã ÇáÈÍË ÈÓÑÚÉ ÏÇÎá ÇáßãÈæ ÈæßÓ
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
KeyAscii = AutoMatchCBBox(ComboItem, KeyAscii)

Adodc2.RecordSource = "select * from emp_data where m_name like '" & Trim(ComboItem.Text) & "%'"
Adodc2.Refresh

If Adodc2.Recordset.BOF Or Adodc2.Recordset.EOF Then
CmdDel.Enabled = False
Else
CmdDel.Enabled = True
End If

End Sub

تحياتي....
الرد }}}}
تم الشكر بواسطة: allayl
#6
(22-05-14, 01:56 AM)allayl كتب : ...
المطلوب : عند كاتبة اول حرف يظهر النتائج المشابه فقط
يعني كتب حرف م يظهر لي محمد و ماجد فقط
...

.....

تمت الإجابة في الموضوع (سؤال في البحث بإستخدام Combo)

.....
الرد }}}}
تم الشكر بواسطة: allayl
#7
شكرآ لكم
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Question [سؤال] سؤال في البحث بإستخدام Combo allayl 2 958 14-06-14, 01:23 AM
آخر رد: allayl
  ممكن كود لملئ combo , list المبرمج البسيط 3 593 16-04-13, 01:30 AM
آخر رد: ناجي إبراهيم

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم