• 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

InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Các thủ thuật liên quan đến việc xử lý ứng dụng, biểu mẫu và control
Giang Hồ
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 50
Ngày tham gia: T.Bảy 12/05/2007 2:36 pm
Đến từ: http://vn-soft.net
Been thanked: 1 time
Liên hệ:

InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi Giang Hồ » T.Tư 21/05/2008 1:27 pm

Tên thủ thuật: InputBox hỗ trợ Tiếng Việt Unicode
Tác giả: Trần Đại Nghĩa
Mô tả: InputBox hỗ trợ xuất nhập thông tin Unicode, có hỗ trợ nhập kí tự password
------------------------------------------------
Hồi trước Giang Hồ cần cái này mà hỏi trên diễn đàn ko ai có. Seach trên internet cũng chẳng thấy đâu. Giờ lại cần đến nó nên bực mình ngồi viết lun. Giang Hồ viết cả trưa mới xong. Ai dùng được thì thanks phát nha



Đoạn này cho vào Module

Mã: Chọn hết

  1. 'InputBox ho tro xuat nhap du lieu Unicode co ho tro password
  2. 'Tac gia: Tran Dai Nghia (Giang Ho)
  3. 'Email: gianghopphoenix@yahoo.com
  4. 'Website: http://www.giangho.biz; http://www.caulacbovb.com
  5. 'Ngay viet: 19/05/2008
  6. '---------------------------------------------------------
  7.  
  8. Private Const GWL_WNDPROC = (-4&)
  9. Private Const WH_CBT As Long = &H5
  10. Private Const HCBT_ACTIVATE As Long = &H5
  11. Public Const WM_SETTEXT = &HC
  12. Public Const WM_SETFONT = &H30
  13. Public Const NV_INPUTBOX As Long = &H5000&
  14. Private Const EM_SETPASSWORDCHAR = &HCC
  15.  
  16. Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal w As Long, ByVal i As Long, ByVal U As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long
  17. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&) As Long
  18. Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
  19. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal CodeNo As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  20. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  21. Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  22. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
  23. 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
  24. Public Declare Function MessageBoxW Lib "user32.dll" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
  25. Private Declare Function SetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As Long) As Long
  26. Private Declare Function DefWindowProcW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  27. Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  28. Public Declare Function GetWindowTextW Lib "user32.dll" (ByVal hwnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
  29. Public Declare Function GetWindowTextLengthW Lib "user32" (ByVal hwnd As Long) As Long
  30. Private Declare Function SetTimer& Lib "user32" (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
  31. Private Declare Function KillTimer& Lib "user32" (ByVal hwnd&, ByVal nIDEvent&)
  32. Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
  33.  
  34. Private pHook2 As Long, pHook3 As Long, hEdit As Long, hIdEvent As Long, UsePass As Boolean
  35. Private sStatic As String, sDefault As String, sTitle As String, sInput As String, txt As String
  36.  
  37. Private Function InputHookProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  38. Dim hStatic1 As Long, hStatic2 As Long, hButton As Long, hFont As Long
  39. InputHookProc = CallNextHookEx(pHook2, ncode, wParam, lParam)
  40. If ncode = HCBT_ACTIVATE Then
  41.    hFont = CreateFont(13, 0, 0, 0, 500, 0, 0, 0, 0, 0, 0, 0, 0, "Tahoma")
  42.    
  43.    hStatic1 = FindWindowEx(wParam, 0&, "Static", vbNullString)
  44.    hStatic2 = FindWindowEx(wParam, hStatic1, "Static", vbNullString)
  45.    If hStatic2 = 0 Then hStatic2 = hStatic1
  46.    SendMessage hStatic2, WM_SETFONT, hFont, ByVal 1&
  47.    DefWindowProcW hStatic2, WM_SETTEXT, &H0&, StrPtr(sStatic)
  48.    DefWindowProcW wParam, WM_SETTEXT, &H0&, StrPtr(sTitle)
  49.    
  50.    hButton = FindWindowEx(wParam, 0&, "Button", "OK")
  51.    SendMessage hButton, WM_SETFONT, hFont, ByVal 1&
  52.    DefWindowProcW hButton, WM_SETTEXT, &H0&, StrPtr("Xác nh" & ChrW(7853) & "n")
  53.    
  54.    hButton = FindWindowEx(wParam, 0&, "Button", "Cancel")
  55.    SendMessage hButton, WM_SETFONT, hFont, ByVal 1&
  56.    DefWindowProcW hButton, WM_SETTEXT, &H0&, StrPtr("H" & ChrW(7911) & "y b" & ChrW(7887))
  57.  
  58.     hEdit = FindWindowEx(wParam, 0&, "Edit", "")
  59.     SendMessage hEdit, WM_SETFONT, hFont, ByVal 1&
  60.    
  61.     If sDefault <> "" Then
  62.     SetWindowTextW hEdit, StrPtr(sDefault) 'Khong ho tro Tieng Viet o Input Textbox khi Style = Windows Classic
  63.     SendKeys "+{END}" 'Select text
  64.     End If
  65.      
  66.     If UsePass Then SendMessage hEdit, EM_SETPASSWORDCHAR, Asc("*"), 0
  67.    
  68.     UnhookWindowsHookEx pHook3
  69. End If
  70. End Function
  71.  
  72. Public Function UniInputBox(ByVal Prompt As String, Optional ByVal Title As String = "", Optional ByVal Default As String = "", Optional ByVal Password As Boolean = False) As String
  73.     pHook3 = SetWindowsHookEx(WH_CBT, AddressOf InputHookProc, App.hInstance, GetCurrentThreadId())
  74.     UsePass = Password
  75.     sStatic = VnToUni(Prompt)
  76.     sDefault = VnToUni(Default)
  77.     sTitle = VnToUni(Title)
  78.     SetTimer 0, NV_INPUTBOX, 50, AddressOf TimerProc 'Lay du lieu Tieng Viet o Input Text Box
  79.     txt = InputBox(sStatic, sTitle, sDefault)
  80.     KillTimer 0, hIdEvent
  81.     If txt <> "" Then UniInputBox = StripNulls(sInput)
  82. End Function
  83.  
  84. Public Sub TimerProc(ByVal hwnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
  85. If hEdit <> 0 Then sInput = GetUniText(hEdit) 'Copy lien tuc ^^!
  86. hIdEvent = idEvent
  87. End Sub
  88.  
  89. Private Function GetUniText(ByVal hwnd As Long) As String
  90. Dim lLen As Long, sBuf As String
  91. lLen = 1 + GetWindowTextLengthW(hwnd)
  92. If (lLen > 1) Then
  93.     sBuf = String$(lLen, 0)
  94.     GetWindowTextW hwnd, StrPtr(sBuf), lLen
  95.     GetUniText = (sBuf)
  96. Else
  97.     GetUniText = vbNullString
  98. End If
  99. End Function
  100.  
  101. Private Function StripNulls(ByVal sString As String) As String
  102. Dim lPos As Long
  103.     lPos = InStr(sString, vbNullChar)
  104.     If (lPos = 1) Then
  105.         StripNulls = vbNullString
  106.     ElseIf (lPos > 1) Then
  107.         StripNulls = Left$(sString, lPos - 1)
  108.         Exit Function
  109.     End If
  110.     StripNulls = sString
  111. End Function
  112.  
  113. 'Code convert TCVN3 -> Unicode by TruongPhu
  114. Public Function VnToUni(str As String) As String
  115. Dim i&, arrUNI() As String, sUni$, ABC$, UNI$
  116. ABC = "¸µ¶·¹¨¾»¼½Æ©ÊÇÈÉËÐÌÎÏѪÕÒÓÔÖÝ×ØÜÞãßáâä«èåæçé¬íêëìîóïñòô­øõö÷ùýúûüþ®¸µ¶·¹¡¾»¼½Æ¢ÊÇÈÉËÐÌÎÏÑ£ÕÒÓÔÖÝ×ØÜÞãßáâä¤èåæçé¥íêëìîóïñòô¦øõö÷ùýúûüþ§"
  117. UNI = "225,224,7843,227,7841,259,7855,7857,7859,7861,7863,226,7845,7847,7849,7851,7853,233,232,7867,7869,7865,234,7871,7873,7875,7877,7879,237,236,7881,297,7883,243,242,7887,245,7885,244,7889,7891,7893,7895,7897,417,7899,7901,7903,7905,7907,250,249,7911,361,7909,432,7913,7915,7917,7919,7921,253,7923,7927,7929,7925,273,225,224,7843,227,7841,258,7855,7857,7859,7861,7863,194,7845,7847,7849,7851,7853,233,232,7867,7869,7865,202,7871,7873,7875,7877,7879,237,236,7881,297,7883,243,242,7887,245,7885,212,7889,7891,7893,7895,7897,416,7899,7901,7903,7905,7907,250,249,7911,361,7909,431,7913,7915,7917,7919,7921,253,7923,7927,7929,7925,272"
  118. arrUNI = Split(UNI, ",")
  119. For i = 1 To Len(str$)
  120. If InStr(ABC, Mid(str$, i, 1)) > 0 Then
  121.  sUni = sUni & ChrW(arrUNI(InStr(ABC, Mid(str$, i, 1)) - 1))
  122.  Else
  123.  sUni = sUni & Mid(str$, i, 1)
  124.  End If
  125. Next
  126. VnToUni = sUni
  127. End Function


Đoạn này cho vào Form


Mã: Chọn hết

  1. Dim ret As String
  2.  
  3. Private Sub Form_Initialize()
  4. InitCommonControls
  5. End Sub
  6.  
  7.  
  8. Private Sub Command1_Click()
  9. ret = UniInputBox("InputBox hç trî nhËp xuÊt TiÕng ViÖt Unicode" & vbCrLf & _
  10. "T¸c gi¶: TrÇn §¹i NghÜa (Giang Hå)" & vbCrLf & "Hç trî nhËp Password" & vbCrLf & _
  11. "Textbox kh«ng hç trî Unicode ë Windows Classic Style", "Input Box Unicode", "NÕu thÊy hay th× nhÊn Thanks c¸i nha !")
  12. If ret <> "" Then MessageBoxW hwnd, StrPtr(ret), StrPtr("www.caulacbovb.com"), 0
  13. End Sub
  14.  
  15. Private Sub Command2_Click()
  16. ret = UniInputBox("NhËp Password v« ®©y !", "Enter Password", , True)
  17. If ret <> "" Then MessageBoxW hwnd, StrPtr(ret), StrPtr("www.caulacbovb.com"), 0
  18. End Sub


Ai làm không được thì tải cái ví dụ này về xem nhé
Tập tin đính kèm
InputBox Unicode.zip
(11.58 KiB) Đã tải 1535 lần


Code chỉ một lần mà fix bug thì mãi mãi
-----------------------------------
VnSecurity 2008 - Bảo vệ máy tính theo phong cách của bạn
Website: http://vn-soft.net

Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi clarkkent » T.Tư 21/05/2008 1:46 pm

Tuyệt vời. Kiểu gõ là TCVN3 à... :D
• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

Giang Hồ
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 50
Ngày tham gia: T.Bảy 12/05/2007 2:36 pm
Đến từ: http://vn-soft.net
Been thanked: 1 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi Giang Hồ » T.Tư 21/05/2008 1:56 pm

clarkkent đã viết:Tuyệt vời. Kiểu gõ là TCVN3 à... :D

Tác thao tác xuất nhập với Inputbox đều là Unicode. Còn trong code thì có thể dùng 1 kiểu gõ/ bảng mã bất kỳ rồi convert -> Unicode (mình quen dùng TCVN3)
Code chỉ một lần mà fix bug thì mãi mãi
-----------------------------------
VnSecurity 2008 - Bảo vệ máy tính theo phong cách của bạn
Website: http://vn-soft.net

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi QuangHoa » T.Tư 21/05/2008 2:03 pm

Hay đấy GOOD JOB !
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

DiodeZ
Thành viên danh dự
Thành viên danh dự
Bài viết: 156
Ngày tham gia: T.Tư 09/04/2008 5:58 pm
Đến từ: /root
Has thanked: 1 time
Been thanked: 3 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi DiodeZ » T.Tư 21/05/2008 2:20 pm

Oh my god! sao mình chỉ để ý việt hóa form, menu, msgbox mà ko để ý inputbox ta. thank pác nhiều lắm!

Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi DQHung » T.Tư 21/05/2008 5:04 pm

Cái này chỉ có Button và Title là được việt hóa thế còn Text trong đó thì sao ?

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi QuangHoa » T.Năm 22/05/2008 8:32 am

Cái mã nguồn thì Text không được việt hóa nhưng cái file .exe làm sẳn thì lại được Việt hóa. Là thế nào vậy giang hồ
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

Giang Hồ
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 50
Ngày tham gia: T.Bảy 12/05/2007 2:36 pm
Đến từ: http://vn-soft.net
Been thanked: 1 time
Liên hệ:

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi Giang Hồ » T.Năm 22/05/2008 3:13 pm

Hjx, đã ghi rõ rồi mờ

Textbox không hỗ trợ Unicode ở chế độ Windows Classsic Style B-)

Đây là 1 hạn chế mà Giang Hồ vẫn chưa tìm được cách khắc phục

Các bác cứ chép 1 thằng VB6.exe.manifest vô thư mục của VB là ok thui :)
Code chỉ một lần mà fix bug thì mãi mãi
-----------------------------------
VnSecurity 2008 - Bảo vệ máy tính theo phong cách của bạn
Website: http://vn-soft.net

Anti-Plus
Bài viết: 1
Ngày tham gia: T.Năm 15/05/2008 8:48 pm

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi Anti-Plus » T.Sáu 23/05/2008 9:06 pm

@ Giang Hồ : Cái này mình có thể dùng cho Macro trong Excel có được không ? Nếu được, thì mong bro chỉ dẫn cách sử dụng trong excel giúp mình luôn nhé. Nếu có file demo minh họa kèm theo thì càng tốt.

Cám ơn rất nhiều !

n.d.tuan
Bài viết: 3
Ngày tham gia: CN 30/11/2008 11:51 pm

Re: InputBox hỗ trợ Tiếng Việt Unicode đây bà con

Gửi bàigửi bởi n.d.tuan » T.Hai 01/12/2008 12:05 am

Anti-Plus đã viết:@ Giang Hồ : Cái này mình có thể dùng cho Macro trong Excel có được không ? Nếu được, thì mong bro chỉ dẫn cách sử dụng trong excel giúp mình luôn nhé. Nếu có file demo minh họa kèm theo thì càng tốt.

Cám ơn rất nhiều !


Bạn xem thêm cái này thế nào

Hình ảnh

Hình ảnh

Hình ảnh

ControlForOffice


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