• 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

Tự động nhập như Address bar

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Tự động nhập như Address bar

Gửi bàigửi bởi dactung93 » T.Năm 27/01/2011 6:31 pm

Thủ thuật: Tự động nhập như Address bar
Tác giả: Sưu tầm



Mình không biết đã bài này có bị trùng không nhưng cứ pose lên đây, nếu bạn nào chưa biết thì đây cũng là một cách rất hay để lập trình Web browser hay từ điển hoặc là gõ Tốc Ký trong các kỹ thuật Hook bàn phím



  1. Function RemoveDups(LB As ListBox)
  2.  
  3.  
  4. On Error Resume Next
  5.  
  6. If LB.ListCount > 1 Then
  7.     For x = 0 To LB.ListCount - 1
  8.         y = LB.List(x)
  9.         C.Add y, y
  10.     Next x
  11.    
  12.     LB.Clear
  13.    
  14.     For x = 1 To C.Count
  15.         LB.AddItem C.Item(x)
  16.     Next x
  17.    
  18.     Set C = Nothing
  19. End If
  20. End Function
  21. Function atcm(ctl As Control, KeyAscii As Integer)
  22.     If KeyAscii = 8 Then
  23.         GoTo en
  24.     ElseIf KeyAscii = 13 Then
  25.         GoTo nx
  26.     End If
  27.     If ctl.SelLength = 0 Then
  28.         ctl.Text = ctl.Text & Chr(KeyAscii)
  29.     ElseIf ctl.SelLength > 0 And KeyAscii = 32 Then
  30.         ctl.Text = ctl.Text & " "
  31.         ctl.SelStart = Len(ctl.Text)
  32.         KeyAscii = 0
  33.         Exit Function
  34.     ElseIf ctl.SelLength > 0 Then
  35.         ctl.Text = Left(ctl.Text, Len(ctl.Text) - ctl.SelLength) & Chr(KeyAscii)
  36.     End If
  37.     ctl.SelStart = Len(ctl.Text)
  38. nx:
  39.     If KeyAscii = 32 Or KeyAscii = 13 Then
  40.         tem = Trim(ctl.Text)
  41.         tem = Split(tem, " ")
  42.         If Len(tem(UBound(tem))) > 2 And UBound(tem) > 0 Then
  43.             If InStr(tem(UBound(tem)), vbCrLf) = 0 Then
  44.                 If Len(tem(UBound(tem))) > 2 Then List1.AddItem tem(UBound(tem))
  45.             Else
  46.                 Dim ttem
  47.                 ttem = Split(tem(UBound(tem)), vbCrLf)
  48.                If Len(ttem(UBound(ttem))) > 2 Then List1.AddItem ttem(UBound(ttem))
  49.             End If
  50.         Else
  51.             Set tem = Nothing
  52.             tem = Split(ctl.Text, vbCrLf)
  53.             If InStr(Trim("" & tem(UBound(tem)) & ""), " ") = 0 Then
  54.                 If Len(Trim("" & tem(UBound(tem)) & "")) > 2 Then List1.AddItem Trim("" & tem(UBound(tem)) & "")
  55.             Else
  56.                 rtem = Split(Trim("" & tem(UBound(tem)) & ""), " ")
  57.                 If Len(rtem(UBound(rtem))) > 2 Then List1.AddItem rtem(UBound(rtem))
  58.             End If
  59.         End If
  60.         RemoveDups List1
  61.     Else
  62.         tps = Split(ctl.Text, " ")
  63.         If UBound(tps) = 0 Or InStr(tps(UBound(tps)), vbCrLf) > 0 Then
  64.             Set tps = Nothing
  65.             tps = Split(ctl.Text, vbCrLf)
  66.         End If
  67.         css = Len(ctl.Text)
  68.         For i = 0 To List1.ListCount - 1
  69.             If Len(tps(UBound(tps))) > 0 Then
  70.                 If StrComp(tps(UBound(tps)), Left(List1.List(i), Len(Trim("" & tps(UBound(tps)) & ""))), vbTextCompare) = 0 Then
  71.                     ctl.Text = ctl.Text & Right(List1.List(i), Len(List1.List(i)) - Len(Trim("" & tps(UBound(tps)) & "")))
  72.                     ctl.SelStart = css
  73.                     ctl.SelLength = Len(ctl.Text) - css
  74.                     Exit For
  75.                 End If
  76.             Else
  77.                 Exit For
  78.             End If
  79.         Next i
  80.     End If
  81.     If KeyAscii <> 13 Then KeyAscii = 0
  82. en:
  83.  
  84. End Function
  85.  
  86.  


Sử dụng:
Bạn thêm 1 listbox để lưu các từ sẽ được tự động thêm vào.

Sử dụng hàm atcm trong event KeyPress

Ví dụ

  1. Private Sub Text1_KeyPress(KeyAscii As Integer)
  2. atcm Text1, KeyAscii
  3.  
  4. End Sub
  5.  
Tập tin đính kèm
auto.rar
(2.32 KiB) Đã tải 530 lần



baohiep
Thành viên danh dự
Thành viên danh dự
Bài viết: 109
Ngày tham gia: CN 27/12/2009 6:37 pm
Đến từ: Tam Kỳ
Has thanked: 3 time
Been thanked: 9 time

Re: Tự động nhập như Address bar

Gửi bàigửi bởi baohiep » CN 27/02/2011 7:07 pm

Mình có một cách hay hơn mà lại ngắn gọn. Bạn làm như sau:
1. Tạo combobox với tên Combo1
2. Thêm từ
3. Nhập đoạn code này vào:
  1. Private Sub Combo1_Change()
  2. SendKeys "%{DOWN}"
  3. End Sub
  4.  

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Re: Tự động nhập như Address bar

Gửi bàigửi bởi dactung93 » T.Hai 28/02/2011 12:48 pm

Hơ hơ. Đó là khi bạn đã add item vào trong 1 cái combobox.
Nhưng cách trên có thể chỉ cần add 1 danh sách vào listbox và sử dụng đc trong cả Textbox, combobox, ....

baohiep
Thành viên danh dự
Thành viên danh dự
Bài viết: 109
Ngày tham gia: CN 27/12/2009 6:37 pm
Đến từ: Tam Kỳ
Has thanked: 3 time
Been thanked: 9 time

Re: Tự động nhập như Address bar

Gửi bàigửi bởi baohiep » T.Năm 03/03/2011 8:34 pm

Mình hiểu rồi.

Koha JeseMen
Thành viên chính thức
Thành viên chính thức
Bài viết: 24
Ngày tham gia: T.Ba 27/07/2010 9:00 pm
Has thanked: 5 time

Re: Tự động nhập như Address bar

Gửi bàigửi bởi Koha JeseMen » CN 17/04/2011 1:39 pm

Bài này hay đấy :D
Tớ sẽ dùng cái này vào một số ứng dụng dùng cho tìm kiếm :D

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: Tự động nhập như Address bar

Gửi bàigửi bởi thinh18tt » T.Năm 16/04/2015 9:33 am

Bạn ơi, như vậy là mình tách từng từ ra nhỉ? Có làm được như google hoặc các công cụ tìm kiếm, là cả câu, cả đoạn không?


Quay về “[VB] Mẹo vặt khác”

Đ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.2 khách