• 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

Việt hóa toàn bộ Menu

Các Module, Class, UserControl và thư viện OCX, DLL hỗ trợ cho Visual Basic
Hình đại diện của người dùng
siguri92
Thành viên danh dự
Thành viên danh dự
Bài viết: 111
Ngày tham gia: T.Sáu 01/10/2010 6:52 pm

Việt hóa toàn bộ Menu

Gửi bàigửi bởi siguri92 » T.Ba 02/11/2010 1:18 pm

Tên: Unicode Menu
Loại: Module
Ngôn ngữ lập trình: Visual Basic 6
Tác giả: zZ_Shine_Zz
Chức năng: Việt hóa toàn bộ Menu bằng một dòng Code


Đây là bài của bạn zZ_Shine_Zz nhưng mình chỉnh sửa lại chút (đem theo Class thì hơi bất tiện nhỉ). Chỉ cần một Module thôi
Các bạn tạo một Module mới. Copy đoạn code sau vào.

Cách dùng. Nên đặt trong sự kiện Form_Load()
bUniMenu Form1.hWnd
Chúc vui :D

  1. Option Explicit
  2.  
  3. Private Declare Function GetMenu& Lib "user32" (ByVal hWnd&)
  4. Private Declare Function GetSubMenu& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  5. Private Declare Function GetMenuItemCount& Lib "user32" (ByVal hMenu&)
  6. Private Declare Function GetMenuString& Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem&, ByVal lpString$, ByVal nMaxCount&, ByVal wFlag&)
  7. Private Declare Function GetMenuItemID& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  8. Private Declare Function SetMenuItemInfo& Lib "user32" Alias "SetMenuItemInfoW" (ByVal hMenu&, ByVal un&, ByVal BOOL As Boolean, lpcMenuItemInfo As MENUITEMINFO)
  9.  
  10. Private Type MENUITEMINFO
  11.    cbSize           As Long
  12.    fMask            As Long
  13.    fType            As Long
  14.    fState           As Long
  15.    wID              As Long
  16.    hSubMenu         As Long
  17.    hbmpChecked      As Long
  18.    hbmpUnchecked    As Long
  19.    dwItemData       As Long
  20.    dwTypeData       As Long
  21.    cch              As Long
  22.    hbmpItem         As Long
  23. End Type
  24.  
  25. Private Const MIIM_TYPE = &H10
  26.  
  27. '//Set Unicode Menu
  28. Public Function bUniMenu(hWnd&) As Boolean
  29. On Error GoTo ErrHandle:
  30.     Dim mInfo   As MENUITEMINFO
  31.     Dim arrMenu As New Collection
  32.     Dim arrPos  As New Collection
  33.     Dim hMenu&, nCount&, iMnu%, MnuID&
  34.     Dim RetStr  As String * 100
  35.     Static IntK$, IntKN$
  36.    
  37.     IntK = -1: IntKN = -1
  38.    
  39.     mInfo.cbSize = Len(mInfo): mInfo.fMask = MIIM_TYPE
  40.    
  41.     hMenu = GetMenu(hWnd)
  42.     nCount = GetMenuItemCount(hMenu)
  43.    
  44.     For iMnu = 0 To nCount - 1
  45.         IntK = IntK + 1
  46.         arrMenu.Add hMenu, IntK
  47.         arrPos.Add iMnu, IntK
  48.     Next
  49.    
  50.     Do While nCount > 0
  51.         IntKN = IntKN + 1
  52.         MnuID = GetMenuItemID(arrMenu.Item(IntKN), arrPos.Item(IntKN))
  53.        
  54.         If MnuID = -1 Then
  55.             MnuID = GetSubMenu(arrMenu.Item(IntKN), arrPos.Item(IntKN))
  56.             nCount = nCount + GetMenuItemCount(MnuID)
  57.             For iMnu = 0 To GetMenuItemCount(MnuID) - 1
  58.                 IntK = IntK + 1
  59.                 arrMenu.Add MnuID, IntK
  60.                 arrPos.Add iMnu, IntK
  61.             Next
  62.         End If
  63.        
  64.         Call GetMenuString(arrMenu.Item(IntKN), MnuID, RetStr, 100&, 0&)
  65.         mInfo.dwTypeData = StrPtr(ToUnicode(RetStr))
  66.         SetMenuItemInfo arrMenu.Item(IntKN), arrPos.Item(IntKN), True, mInfo
  67.  
  68.         nCount = nCount - 1
  69.         arrMenu.Remove IntKN
  70.         arrPos.Remove IntKN
  71.     Loop
  72.    
  73.     Set arrMenu = Nothing: Set arrPos = Nothing
  74.    
  75.     bUniMenu = True: Exit Function
  76. ErrHandle: bUniMenu = False: End Function
  77.  
  78. '//Convert to Unicode
  79. Private Function ToUnicode$(StrInput$)
  80.     Dim ANSI$, UNI$, i%, sTem$, sUni$, arrUNI$()
  81.     ANSI = "a1|a2|a3|a4|a5|a6|a8|a61a62a63a64a65a81a82a83a84a85A1|A2|A3|A4|A5|A6|A8|A61A62A63A64A65A81A82A83A84A85e1|e2|e3|e4|e5|e6|e61e62e63e64e65E1|E2|E3|E4|E5|E6|E61E62E63E64E65i1|i2|i3|i4|i5|I1|I2|I3|I4|I5|o1|o2|o3|o4|o5|o6|o7|o61o62o63o64o65o71o72o73o74o75O1|O2|O3|O4|O5|O6|O7|O61O62O63O64O65O71O72O73O74O75u1|u2|u3|u4|u5|u7|u71u72u73u74u75U1|U2|U3|U4|U5|U7|U71U72U73U74U75y1|y2|y3|y4|y5|Y1|Y2|Y3|Y4|Y5|d9|D9|"
  82.     UNI = "E1,E0,1EA3,E3,1EA1,E2,103,1EA5,1EA7,1EA9,1EAB,1EAD,1EAF,1EB1,1EB3,1EB5,1EB7,C1,C0,1EA2,C3,1EA0,C2,102,1EA4,1EA6,1EA8,1EAA,1EAC,1EAE,1EB0,1EB2,1EB4,1EB6,E9,E8,1EBB,1EBD,1EB9,EA,1EBF,1EC1,1EC3,1EC5,1EC7,C9,C8,1EBA,1EBC,1EB8,CA,1EBE,1EC0,1EC2,1EC4,1EC6,ED,EC,1EC9,129,1ECB,CD,CC,1EC8,128,1ECA,F3,F2,1ECF,F5,1ECD,F4,1A1,1ED1,1ED3,1ED5,1ED7,1ED9,1EDB,1EDD,1EDF,1EE1,1EE3,D3,D2,1ECE,D5,1ECC,D4,1A0,1ED0,1ED2,1ED4,1ED6,1ED8,1EDA,1EDC,1EDE,1EE0,1EE2,FA,F9,1EE7,169,1EE5,1B0,1EE9,1EEB,1EED,1EEF,1EF1,DA,D9,1EE6,168,1EE4,1AF,1EE8,1EEA,1EEC,1EEE,1EF0,FD,1EF3,1EF7,1EF9,1EF5,DD,1EF2,1EF6,1EF8,1EF4,111,110"
  83.     arrUNI = Split(UNI, ",")
  84.  
  85.     For i = 1 To Len(StrInput)
  86.         If IsNumeric(Mid(StrInput, i + 1, 1)) = False Then
  87.             sUni = sUni & Mid(StrInput, i, 1)
  88.         Else
  89.             sTem = IIf(IsNumeric(Mid(StrInput, i + 2, 1)), Mid(StrInput, i, 3), Mid(StrInput, i, 2))
  90.             i = i + IIf(IsNumeric(Mid(StrInput, i + 2, 1)), 2, 1)
  91.             If InStr(ANSI, sTem) > 0 Then sTem = ChrW("&h" & arrUNI(InStr(ANSI, sTem) \ 3))
  92.             sUni = sUni & sTem
  93.         End If
  94.     Next
  95.     ToUnicode$ = sUni
  96. End Function
  97.  



Hình đại diện của người dùng
tuyen_dt18
Guru
Guru
Bài viết: 259
Ngày tham gia: T.Bảy 19/04/2008 8:46 pm
Đến từ: Hưng Yên
Been thanked: 43 time
Liên hệ:

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi tuyen_dt18 » T.Bảy 13/11/2010 7:02 pm

Code hơi dài, đây là một cách nữa :
  1. Option Explicit
  2.  
  3.  
  4. '========== FUNCTIONS   ======================================================
  5. Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
  6. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  7. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  8. Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  9. Private Declare Function GetMenuStringW Lib "user32" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As Long, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  10. Private Declare Function ModifyMenuW Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
  11.  
  12. '========== CONSTANTS   ======================================================
  13. Private Const MF_BYPOSITION         As Long = &H400&
  14. Private Const MF_STRING             As Long = &H0&
  15.  
  16. '-----------------------------------------------------------------------------
  17. Private Function ToUni(ByVal sInput As String) As String
  18.     Dim sAnsi As String, sUni As String, I As Long, sTem As String, sResult As String, ArrUni() As String
  19.     sAnsi = "a1|a2|a3|a4|a5|a6|a8|a61a62a63a64a65a81a82a83a84a85A1|A2|A3|A4|A5|A6|A8|A61A62A63A64A65A81A82A83A84A85e1|e2|e3|e4|e5|e6|e61e62e63e64e65E1|E2|E3|E4|E5|E6|E61E62E63E64E65i1|i2|i3|i4|i5|I1|I2|I3|I4|I5|o1|o2|o3|o4|o5|o6|o7|o61o62o63o64o65o71o72o73o74o75O1|O2|O3|O4|O5|O6|O7|O61O62O63O64O65O71O72O73O74O75u1|u2|u3|u4|u5|u7|u71u72u73u74u75U1|U2|U3|U4|U5|U7|U71U72U73U74U75y1|y2|y3|y4|y5|Y1|Y2|Y3|Y4|Y5|d9|D9|"
  20.     sUni = "E1,E0,1EA3,E3,1EA1,E2,103,1EA5,1EA7,1EA9,1EAB,1EAD,1EAF,1EB1,1EB3,1EB5,1EB7,C1,C0,1EA2,C3,1EA0,C2,102,1EA4,1EA6,1EA8,1EAA,1EAC,1EAE,1EB0,1EB2,1EB4,1EB6,E9,E8,1EBB,1EBD,1EB9,EA,1EBF,1EC1,1EC3,1EC5,1EC7,C9,C8,1EBA,1EBC,1EB8,CA,1EBE,1EC0,1EC2,1EC4,1EC6,ED,EC,1EC9,129,1ECB,CD,CC,1EC8,128,1ECA,F3,F2,1ECF,F5,1ECD,F4,1A1,1ED1,1ED3,1ED5,1ED7,1ED9,1EDB,1EDD,1EDF,1EE1,1EE3,D3,D2,1ECE,D5,1ECC,D4,1A0,1ED0,1ED2,1ED4,1ED6,1ED8,1EDA,1EDC,1EDE,1EE0,1EE2,FA,F9,1EE7,169,1EE5,1B0,1EE9,1EEB,1EED,1EEF,1EF1,DA,D9,1EE6,168,1EE4,1AF,1EE8,1EEA,1EEC,1EEE,1EF0,FD,1EF3,1EF7,1EF9,1EF5,DD,1EF2,1EF6,1EF8,1EF4,111,110"
  21.     ArrUni = Split(sUni, ",")
  22.  
  23.     For I = 1 To Len(sInput)
  24.         If IsNumeric(Mid$(sInput, I + 1, 1)) = False Then
  25.             sResult = sResult & Mid$(sInput, I, 1)
  26.         Else
  27.             sTem = IIf(IsNumeric(Mid$(sInput, I + 2, 1)), Mid$(sInput, I, 3), Mid$(sInput, I, 2))
  28.             I = I + IIf(IsNumeric(Mid$(sInput, I + 2, 1)), 2, 1)
  29.             If InStr(sAnsi, sTem) > 0 Then sTem = ChrW("&H" & ArrUni(InStr(sAnsi, sTem) \ 3))
  30.             sResult = sResult & sTem
  31.         End If
  32.     Next
  33.     ToUni = sResult
  34. End Function
  35. '
  36. Public Sub VietnameseMenu(ByVal hWnd As Long)
  37.     Dim hMenu As Long
  38.     hMenu = GetMenu(hWnd)
  39.     UnicodeMenu hMenu
  40. End Sub
  41. '
  42. Private Sub UnicodeMenu(ByVal hMenu As Long)
  43.     Dim I As Long, dwCount As Long, Ret As Long, hSubMenu As Long, J As Long, dwSubCount As Long, lpString As String
  44.     dwCount = GetMenuItemCount(hMenu)
  45.     For I = 0 To dwCount - 1
  46.         lpString = String$(255, vbNullChar)
  47.         Ret = GetMenuStringW(hMenu, I, StrPtr(lpString), Len(lpString), MF_BYPOSITION)
  48.         Ret = InStr(lpString, vbNullChar)
  49.         lpString = Left$(lpString, Ret - 1)
  50.         lpString = ToUni(lpString)
  51.         ModifyMenuW hMenu, I, MF_STRING Or MF_BYPOSITION, GetMenuItemID(hMenu, I), StrPtr(lpString)
  52.         '
  53.        hSubMenu = GetSubMenu(hMenu, I)
  54.         dwSubCount = GetMenuItemCount(hSubMenu)
  55.         If dwSubCount Then UnicodeMenu hSubMenu
  56.     Next I
  57. End Sub
  58. '
  59.  

Còn đây là mã nguồn :
Tập tin đính kèm
Vietnamese Menu.rar
(2.69 KiB) Đã tải 1109 lần
Sửa lần cuối bởi tuyen_dt18 vào ngày CN 14/11/2010 1:27 am với 2 lần sửa.
Hỏi ý kiến tác giả trước khi sử dụng hoặc trích dẫn rõ nguồn bài viết khi sử dụng.

Hình đại diện của người dùng
siguri92
Thành viên danh dự
Thành viên danh dự
Bài viết: 111
Ngày tham gia: T.Sáu 01/10/2010 6:52 pm

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi siguri92 » T.Bảy 13/11/2010 11:08 pm

@tuyen_dt18: code của cậu chỉ việt hóa được sub thứ nhất, cái này là việt hóa toàn bộ mà :-/ .
Hình ảnh

Hình đại diện của người dùng
tuyen_dt18
Guru
Guru
Bài viết: 259
Ngày tham gia: T.Bảy 19/04/2008 8:46 pm
Đến từ: Hưng Yên
Been thanked: 43 time
Liên hệ:

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi tuyen_dt18 » CN 14/11/2010 1:14 am

Mình đã sửa lại rồi bạn Download về xem lại nha. Cụ thể là dùng đệ quy với mỗi Mục Menu
Còn với cách của bạn thì toàn bộ các SEPARATOR của Menu đều bị mất, bạn xem lại Code nha
Hình ảnh
Hỏi ý kiến tác giả trước khi sử dụng hoặc trích dẫn rõ nguồn bài viết khi sử dụng.

Hình đại diện của người dùng
nimgiaminh
Thành viên danh dự
Thành viên danh dự
Bài viết: 432
Ngày tham gia: T.Bảy 07/08/2010 9:24 am
Đến từ: Ở dưới đó đó
Has thanked: 6 time
Been thanked: 18 time
Liên hệ:

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi nimgiaminh » T.Sáu 24/12/2010 7:50 am

siguri92 đã viết:Các bạn tạo một Module mới. Copy đoạn code sau vào.

Cách dùng. Nên đặt trong sự kiện Form_Load()

miucon20
Thành viên tích cực
Thành viên tích cực
Bài viết: 193
Ngày tham gia: T.Sáu 04/06/2010 12:35 pm
Has thanked: 27 time
Been thanked: 1 time

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi miucon20 » T.Tư 11/01/2012 7:48 pm

Rất hay và bổ ích

miucon20
Thành viên tích cực
Thành viên tích cực
Bài viết: 193
Ngày tham gia: T.Sáu 04/06/2010 12:35 pm
Has thanked: 27 time
Been thanked: 1 time

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi miucon20 » T.Tư 01/02/2012 2:56 pm

Vậy cho mình hỏi khi sử dụng menu popup có còn hiển thị đ][cj tiếng việt không? bởi vì khi đó menu sẽ bị ẩn đi khi nào gọi mới hiển thị.

tavanchinh
Thành viên chính thức
Thành viên chính thức
Bài viết: 10
Ngày tham gia: T.Tư 29/02/2012 12:55 pm
Has thanked: 2 time

Re: Việt hóa toàn bộ Menu

Gửi bàigửi bởi tavanchinh » T.Tư 07/03/2012 10:25 pm

Bạn tuyen_dt18 ơi cho mình hỏi sau khi copy copy code vào rồi dùng kiểu gõ gì để gõ được tiếng việt như bài của bạn vậy ?


Quay về “[VB] Module, Class, UserControl, OCX”

Đ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