• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Auto complete, dropdow Combobox

Các thủ thuật liên quan đến việc xử lý ứng dụng, biểu mẫu và control
Hình đại diện của người dùng
NoBi
Quản trị
Quản trị
Bài viết: 948
Ngày tham gia: T.Ba 18/03/2008 1:22 pm
Đến từ: Sài Gòn
Has thanked: 50 time
Been thanked: 66 time
Liên hệ:

Auto complete, dropdow Combobox

Gửi bàigửi bởi NoBi » CN 21/03/2010 9:45 pm

Thủ thuật: Auto complete, dropdow Combobox
Tác giả: Sưu tầm
Mô tả: Tự động chọn giá trị gần đúng với dữ liệu nhập vào Combobox


  1. Option Explicit
  2.  
  3. '
  4. 'Implement CComboBox:SelectString to search and select item
  5. 'Y. Huang <yinghsuan_h@yahoo.com>
  6. '
  7. 'Copyright? Naaa! But Copyleft...
  8. 'http://www.gnu.org/copyleft/copyleft.html
  9. '
  10. 'In KeyPress Enevt Method: KeyAscii = AutoMatchCBBox(ComBoBox, KeyAscii)
  11. '
  12. 'Reference: WinUser.h
  13. 'VB ComboBox doesn't have SelectString(), so SendMessage to the Window Handle
  14. '#define CB_SELECTSTRING     0x014D
  15. '#define CB_SHOWDROPDOWN     0x014F
  16. '#define CBN_SELENDOK        9
  17. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
  18.                 ByVal hwnd As Long, _
  19.                 ByVal wMsg As Long, _
  20.                 ByVal wParam As Long, _
  21.                 lParam As Any) As Long
  22. Private Const CB_ERR = -1, CB_SELECTSTRING = &H14D, CB_SHOWDROPDOWN = &H14F, CBN_SELENDOK = 9
  23.  
  24. 'call this function in KeyPress event method
  25. Public Function AutoMatchCBBox(ByRef cbBox As ComboBox, ByVal KeyAscii As Integer) As Integer
  26.    
  27.        
  28.     Dim strFindThis As String, bContinueSearch As Boolean
  29.     Dim lResult As Long, lStart As Long, lLength As Long
  30.     AutoMatchCBBox = 0 ' block cbBox since we handle everything
  31.    bContinueSearch = True
  32.     lStart = cbBox.SelStart
  33.     lLength = cbBox.SelLength
  34.  
  35.     On Error GoTo ErrHandle
  36.        
  37.     If KeyAscii < 32 Then 'control char
  38.        bContinueSearch = False
  39.         cbBox.SelLength = 0 'select nothing since we will delete/enter
  40.        If KeyAscii = Asc(vbBack) Then 'take care BackSpace and Delete first
  41.            If lLength = 0 Then 'delete last char
  42.                If Len(cbBox) > 0 Then ' in case user delete empty cbBox
  43.                    cbBox.Text = Left(cbBox.Text, Len(cbBox) - 1)
  44.                 End If
  45.             Else 'leave unselected char(s) and delete rest of text
  46.                cbBox.Text = Left(cbBox.Text, lStart)
  47.             End If
  48.             cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
  49.        ElseIf KeyAscii = vbKeyReturn Then  'user select this string
  50.            cbBox.SelStart = Len(cbBox)
  51.             lResult = SendMessage(cbBox.hwnd, CBN_SELENDOK, 0, 0)
  52.             AutoMatchCBBox = KeyAscii 'let caller a chance to handle "Enter"
  53.        End If
  54.     Else 'generate searching string
  55.        If lLength = 0 Then
  56.             strFindThis = cbBox.Text & Chr(KeyAscii) 'No selection, append it
  57.        Else
  58.             strFindThis = Left(cbBox.Text, lStart) & Chr(KeyAscii)
  59.         End If
  60.     End If
  61.    
  62.     If bContinueSearch Then 'need to search
  63.        Call VBComBoBoxDroppedDown(cbBox)  'open dropdown list
  64.        lResult = SendMessage(cbBox.hwnd, CB_SELECTSTRING, -1, ByVal strFindThis)
  65.         If lResult = CB_ERR Then 'not found
  66.            cbBox.Text = strFindThis 'set cbBox as whatever it is
  67.            cbBox.SelLength = 0 'no selected char(s) since not found
  68.            cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
  69.        Else
  70.             'found string, highlight rest of string for user
  71.            cbBox.SelStart = Len(strFindThis)
  72.             cbBox.SelLength = Len(cbBox) - cbBox.SelStart
  73.         End If
  74.     End If
  75.     On Error GoTo 0
  76.     Exit Function
  77.    
  78. ErrHandle:
  79.     'got problem, simply return whatever pass in
  80.    Debug.Print "Failed: AutoCompleteComboBox due to : " & Err.Description
  81.     Debug.Assert False
  82.     AutoMatchCBBox = KeyAscii
  83.     On Error GoTo 0
  84. End Function
  85.  
  86. 'open dorpdown list
  87. Private Sub VBComBoBoxDroppedDown(ByRef cbBox As ComboBox)
  88.     Call SendMessage(cbBox.hwnd, CB_SHOWDROPDOWN, Abs(True), 0)
  89. End Sub
Tập tin đính kèm
AutoCompleteComboBox.zip
(3.14 KiB) Đã tải 975 lần


:>

Hình đại diện của người dùng
lanlan
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 310
Ngày tham gia: T.Năm 05/06/2008 8:49 am
Been thanked: 1 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi lanlan » T.Sáu 11/02/2011 4:29 pm

Ai biết áp dụng cái này cho form 2.0 thế nào nhỉ xin chỉ giáo :-?

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi truongphu » T.Bảy 12/02/2011 8:23 am

lan ơi, dạo nầy lan làm gì thế?

thay bằng:
  1. Private Sub cb1_KeyPress(KeyAscii As MSForms.ReturnInteger)
  2.    KeyAscii = AutoMatchCBBox(CB1, KeyAscii)
  3. End Sub
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
lanlan
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 310
Ngày tham gia: T.Năm 05/06/2008 8:49 am
Been thanked: 1 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi lanlan » T.Bảy 12/02/2011 9:46 am

hihi cảm ơn bác vẫn nhớ cháu
cháu mới đi bế mạc khóa về
bác ơi cháu đã làm như bác rùi nhưng runtime 13

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi truongphu » T.Bảy 12/02/2011 12:28 pm

lanlan đã viết:bác ơi cháu đã làm như bác rùi nhưng runtime 13

sorry... :(
tưởng dễ ăn, hóa ra.!

* tưởng dễ: control chuẩn: cb2_KeyPress(KeyAscii As Integer)
thì control msforms 2.0: cb1_KeyPress(KeyAscii As msforms.ReturnInteger)

* hóa ra: Module dùng combobox.hwnd mà combobox 2.0 lại không hổ trợ hwnd, thế mới chết

=> không dùng được trên form 2.0

tạm khắc phục:
  1. Private Sub cb1_KeyPress(KeyAscii As MSForms.ReturnInteger)
  2.     On Error Resume Next
  3.    KeyAscii = AutoMatchCBBox(CB1, KeyAscii)
  4. End Sub


vì không hổ trợ hwnd nên động thái open dorpdown list không có
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
lanlan
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 310
Ngày tham gia: T.Năm 05/06/2008 8:49 am
Been thanked: 1 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi lanlan » T.Bảy 12/02/2011 12:39 pm

hihi cháu ngộ ra rùi
cháu thay cái [Call VBComBoBoxDroppedDown(cbBox)] bằng [ComboBox1.DropDown]
cháu cảm ơn bác nhìu chúc bác năm mới sức khỏe vạn sự như ý...

tiện cho cháu hỏi thêm tí cháu có dùng cái ocx Codejock Software nhưng không hỉu sao view unicode thì được như nhập unicode những chữ (đ, ạ,ô) nó thành dấu hỏi chít phạm quy rùi
hihi

thinh18tt
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 167
Ngày tham gia: T.Ba 18/05/2010 11:49 pm
Has thanked: 7 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi thinh18tt » T.Hai 28/02/2011 3:42 pm

NoBi đã viết:Thủ thuật: Auto complete, dropdow Combobox
Tác giả: Sưu tầm
Mô tả: Tự động chọn giá trị gần đúng với dữ liệu nhập vào Combobox


  1. Option Explicit
  2.  
  3. '
  4. 'Implement CComboBox:SelectString to search and select item
  5. 'Y. Huang <yinghsuan_h@yahoo.com>
  6. '
  7. 'Copyright? Naaa! But Copyleft...
  8. 'http://www.gnu.org/copyleft/copyleft.html
  9. '
  10. 'In KeyPress Enevt Method: KeyAscii = AutoMatchCBBox(ComBoBox, KeyAscii)
  11. '
  12. 'Reference: WinUser.h
  13. 'VB ComboBox doesn't have SelectString(), so SendMessage to the Window Handle
  14. '#define CB_SELECTSTRING     0x014D
  15. '#define CB_SHOWDROPDOWN     0x014F
  16. '#define CBN_SELENDOK        9
  17. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
  18.                 ByVal hwnd As Long, _
  19.                 ByVal wMsg As Long, _
  20.                 ByVal wParam As Long, _
  21.                 lParam As Any) As Long
  22. Private Const CB_ERR = -1, CB_SELECTSTRING = &H14D, CB_SHOWDROPDOWN = &H14F, CBN_SELENDOK = 9
  23.  
  24. 'call this function in KeyPress event method
  25. Public Function AutoMatchCBBox(ByRef cbBox As ComboBox, ByVal KeyAscii As Integer) As Integer
  26.    
  27.        
  28.     Dim strFindThis As String, bContinueSearch As Boolean
  29.     Dim lResult As Long, lStart As Long, lLength As Long
  30.     AutoMatchCBBox = 0 ' block cbBox since we handle everything
  31.    bContinueSearch = True
  32.     lStart = cbBox.SelStart
  33.     lLength = cbBox.SelLength
  34.  
  35.     On Error GoTo ErrHandle
  36.        
  37.     If KeyAscii < 32 Then 'control char
  38.        bContinueSearch = False
  39.         cbBox.SelLength = 0 'select nothing since we will delete/enter
  40.        If KeyAscii = Asc(vbBack) Then 'take care BackSpace and Delete first
  41.            If lLength = 0 Then 'delete last char
  42.                If Len(cbBox) > 0 Then ' in case user delete empty cbBox
  43.                    cbBox.Text = Left(cbBox.Text, Len(cbBox) - 1)
  44.                 End If
  45.             Else 'leave unselected char(s) and delete rest of text
  46.                cbBox.Text = Left(cbBox.Text, lStart)
  47.             End If
  48.             cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
  49.        ElseIf KeyAscii = vbKeyReturn Then  'user select this string
  50.            cbBox.SelStart = Len(cbBox)
  51.             lResult = SendMessage(cbBox.hwnd, CBN_SELENDOK, 0, 0)
  52.             AutoMatchCBBox = KeyAscii 'let caller a chance to handle "Enter"
  53.        End If
  54.     Else 'generate searching string
  55.        If lLength = 0 Then
  56.             strFindThis = cbBox.Text & Chr(KeyAscii) 'No selection, append it
  57.        Else
  58.             strFindThis = Left(cbBox.Text, lStart) & Chr(KeyAscii)
  59.         End If
  60.     End If
  61.    
  62.     If bContinueSearch Then 'need to search
  63.        Call VBComBoBoxDroppedDown(cbBox)  'open dropdown list
  64.        lResult = SendMessage(cbBox.hwnd, CB_SELECTSTRING, -1, ByVal strFindThis)
  65.         If lResult = CB_ERR Then 'not found
  66.            cbBox.Text = strFindThis 'set cbBox as whatever it is
  67.            cbBox.SelLength = 0 'no selected char(s) since not found
  68.            cbBox.SelStart = Len(cbBox) 'set insertion position @ the end of string
  69.        Else
  70.             'found string, highlight rest of string for user
  71.            cbBox.SelStart = Len(strFindThis)
  72.             cbBox.SelLength = Len(cbBox) - cbBox.SelStart
  73.         End If
  74.     End If
  75.     On Error GoTo 0
  76.     Exit Function
  77.    
  78. ErrHandle:
  79.     'got problem, simply return whatever pass in
  80.    Debug.Print "Failed: AutoCompleteComboBox due to : " & Err.Description
  81.     Debug.Assert False
  82.     AutoMatchCBBox = KeyAscii
  83.     On Error GoTo 0
  84. End Function
  85.  
  86. 'open dorpdown list
  87. Private Sub VBComBoBoxDroppedDown(ByRef cbBox As ComboBox)
  88.     Call SendMessage(cbBox.hwnd, CB_SHOWDROPDOWN, Abs(True), 0)
  89. End Sub


VBComBoBoxDroppedDown không chạy được với UniCombobox, có cách nào dùng được không bác ơi!

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Auto complete, dropdow Combobox

Gửi bàigửi bởi truongphu » T.Hai 28/02/2011 4:24 pm

thinh18tt đã viết:VBComBoBoxDroppedDown không chạy được với UniCombobox


Đó là đương nhiên. Bạn không đọc ở trên: ngay cả MS Form 2.0 cũng chả dùng được
(lanlan dùng ở trên là may rủi)
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh


Quay về “[VB] Ứng dụng - Form và Control”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách