• 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
Posts: 496
Joined: Tue 04/11/2008 8:43 am
Has thanked: 6 times
Been thanked: 8 times

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

Postby dactung93 » Thu 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ụ

[vb]
Private Sub Text1_KeyPress(KeyAscii As Integer)
atcm Text1, KeyAscii

End Sub
[/vb]
Attachments
auto.rar
(2.32 KiB) Downloaded 610 times



baohiep
Thành viên danh dự
Thành viên danh dự
Posts: 109
Joined: Sun 27/12/2009 6:37 pm
Location: Tam Kỳ
Has thanked: 3 times
Been thanked: 9 times

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

Postby baohiep » Sun 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
Posts: 496
Joined: Tue 04/11/2008 8:43 am
Has thanked: 6 times
Been thanked: 8 times

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

Postby dactung93 » Mon 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ự
Posts: 109
Joined: Sun 27/12/2009 6:37 pm
Location: Tam Kỳ
Has thanked: 3 times
Been thanked: 9 times

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

Postby baohiep » Thu 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
Posts: 24
Joined: Tue 27/07/2010 9:00 pm
Has thanked: 5 times

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

Postby Koha JeseMen » Sun 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
Posts: 167
Joined: Tue 18/05/2010 11:49 pm
Has thanked: 7 times

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

Postby thinh18tt » Thu 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?


Return to “[VB] Mẹo vặt khác”

Who is online

Users browsing this forum: No registered users and 0 guests