• 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 Popup Menu đa cấp

Những thủ thuật, mẹo vặt dành cho Visual Basic
Nội qui chuyên mục
1. Gửi bài viết tại đây, người quản lý sẽ chuyển vào trong nếu bài viết đạt yêu cầu.
2. Gửi bài theo mẫu qui định: viewtopic.php?f=2&t=5
[thuthuat]Tên thủ thuật[/thuthuat]
[tacgia]Tên tác giả[/tacgia]
[mota]Mô tả, chú thích công dụng của thủ thuật[/mota]
[end][/end]
Hình đại diện của người dùng
phantronghiep07
Thành viên chính thức
Thành viên chính thức
Bài viết: 29
Ngày tham gia: T.Năm 29/04/2010 2:34 pm
Been thanked: 4 time

Việt hóa Popup Menu đa cấp

Gửi bàigửi bởi phantronghiep07 » T.Năm 11/02/2016 12:41 pm

Thủ thuật: Việt hóa Popup Menu đa cấp
Tác giả: Phan Trọng Hiệp
Mô tả:
Untitled 2.jpg



VB6 hỗ trợ tiếng Việt rất kém so với các ngôn ngữ lập trình khác, muốn hiện Popup Menu khi tương tác lên 1 đối tượng nào đó, phải dùng tiếng Việt không dấu làm giảm giá trị phần mềm. Mình viết Module Việt hóa Popup Menu này đã nhiều năm, nhưng chuyển sang dùng ngôn ngữ VB.Net lâu rồi nên bỏ quên nó, hôm nay dọn dẹp máy tính, tình cờ thấy đc, đưa lên chia sẻ với mọi người. Popup Menu có tất cả 24 cấp.
  1. Option Explicit
  2.  
  3. Private Type POINTAPI
  4.     X As Long
  5.     Y As Long
  6. End Type
  7.  
  8. Private Type MENUITEMINFO
  9.     cbSize As Long
  10.     fMask As Long
  11.     fType As Long
  12.     fState As Long
  13.     wID As Long
  14.     hSubMenu As Long
  15.     hbmpChecked As Long
  16.     hbmpUnchecked As Long
  17.     dwItemData As Long
  18.     dwTypeData As Long
  19.     cch As Long
  20. End Type
  21. Const TPM_RETURNCMD = &H100&
  22.  
  23. Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuW" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Long) As Long
  24. Private Declare Function CreatePopupMenu Lib "user32" () As Long
  25. Private Declare Function CreateMenu Lib "user32" () As Long
  26. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  27. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  28. Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpmii As MENUITEMINFO) As Long
  29. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  30. Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemW" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
  31. Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoW" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
  32. Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
  33. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  34. Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
  35.  
  36. Private Const MIIM_TYPE = &H10
  37. Private Const MIIM_SUBMENU = &H4
  38. Private Const MIIM_ID As Long = &H2
  39.  
  40. Private Const MF_STRING = &H0
  41. Private Const MF_SEPARATOR = &H800&
  42.  
  43. Public hMainMenu&
  44. Public NhanMenu
  45. '---------------------------------------------------------------------------------
  46. Private Function MenuInsert(ByVal hMenu As Long, ByVal strCaption As String, Optional ByVal intPos As Integer = 0, Optional ID As Long = 0) As Long
  47.     Dim typMII As MENUITEMINFO, hSubMenu As Long, intMenuCnt As Integer
  48.  
  49.     typMII.cbSize = Len(typMII)
  50.     typMII.fMask = MIIM_SUBMENU Or MIIM_ID
  51.     typMII.wID = 0
  52.  
  53.     Call GetMenuItemInfo(hMenu, intPos, True, typMII)
  54.  
  55.     If typMII.hSubMenu = 0 Then
  56.         hSubMenu = CreateMenu
  57.         typMII.hSubMenu = hSubMenu
  58.         Call SetMenuItemInfo(hMenu, intPos, True, typMII)
  59.     Else
  60.         hSubMenu = typMII.hSubMenu
  61.     End If
  62.  
  63.     intMenuCnt = GetMenuItemCount(hSubMenu)
  64.     typMII.fMask = MIIM_TYPE Or MIIM_ID
  65.     typMII.fType = MF_STRING
  66.     typMII.dwTypeData = StrPtr(strCaption)
  67.     typMII.cch = Len(typMII.dwTypeData)
  68.     typMII.wID = ID
  69.  
  70.     Call InsertMenuItem(hSubMenu, intMenuCnt, True, typMII)
  71.  
  72.     MenuInsert = GetSubMenu(hMenu, intPos)
  73. End Function
  74. '=====================================================================
  75.  
  76. Private Function GoTel2Uni(ChuoiGoTelex) As String
  77. '---------------------------------------------------------------------------------------
  78. ' Function   : GoTel2Uni
  79. ' Author      : phantronghiep07
  80. ' Phone       : 0915 080 282
  81. '---------------------------------------------------------------------------------------
  82.  
  83.     Dim i As Integer
  84.     Dim maAcii, Telex
  85.  
  86.     maAcii = Array(7845, 7847, 7849, 7851, 7853, 226, 225, 224, 7843, 227, 7841, 7855, 7857, 7859, _
  87.                    7861, 7863, 259, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 432, _
  88.                    7871, 7873, 7875, 7877, 7879, 234, 233, 232, 7867, 7869, 7865, 7889, 7891, 7893, _
  89.                    7895, 7897, 244, 243, 242, 7887, 245, 7885, 7899, 7901, 7903, 7905, 7907, 417, _
  90.                    237, 236, 7881, 297, 7883, 253, 7923, 7927, 7929, 7925, 273, 7844, 7846, 7848, _
  91.                    7850, 7852, 194, 193, 192, 7842, 195, 7840, 7854, 7856, 7858, 7860, 7862, 258, _
  92.                    218, 217, 7910, 360, 7908, 7912, 7914, 7916, 7918, 7920, 431, 7870, 7872, 7874, _
  93.                    7876, 7878, 202, 201, 200, 7866, 7868, 7864, 7888, 7890, 7892, 7894, 7896, 212, _
  94.                    211, 210, 7886, 213, 7884, 7898, 7900, 7902, 7904, 7906, 416, 205, 204, 7880, 296, _
  95.                    7882, 221, 7922, 7926, 7928, 7924, 272)
  96.  
  97.     Telex = Array("aas", "aaf", "aar", "aax", "aaj", "aa", "as", "af", "ar", "ax", "aj", "aws", "awf", _
  98.                   "awr", "awx", "awj", "aw", "us", "uf", "ur", "ux", "uj", "uws", "uwf", "uwr", "uwx", _
  99.                   "uwj", "uw", "ees", "eef", "eer", "eex", "eej", "ee", "es", "ef", "er", "ex", "ej", _
  100.                   "oos", "oof", "oor", "oox", "ooj", "oo", "os", "of", "or", "ox", "oj", "ows", "owf", _
  101.                   "owr", "owx", "owj", "ow", "is", "if", "ir", "ix", "ij", "ys", "yf", "yr", "yx", "yj", _
  102.                   "dd", "AAS", "AAF", "AAR", "AAX", "AAJ", "AA", "AS", "AF", "AR", "AX", _
  103.                   "AJ", "AWS", "AWF", "AWR", "AWX", "AWJ", "AW", "US", "UF", "UR", "UX", _
  104.                   "UJ", "UWS", "UWF", "UWR", "UWX", "UWJ", "UW", "EES", "EEF", "EER", _
  105.                   "EEX", "EEJ", "EE", "ES", "EF", "ER", "EX", "EJ", "OOS", "OOF", "OOR", _
  106.                   "OOX", "OOJ", "OO", "OS", "OF", "OR", "OX", "OJ", "OWS", "OWF", "OWR", _
  107.                   "OWX", "OWJ", "OW", "IS", "IF", "IR", "IX", "IJ", "YS", "YF", "YR", "YX", _
  108.                   "YJ", "DD")
  109.  
  110.     GoTel2Uni = ChuoiGoTelex
  111.     For i = 0 To 133
  112.         GoTel2Uni = Replace(GoTel2Uni, Telex(i), ChrW(maAcii(i)))
  113.     Next i
  114.     GoTel2Uni = Replace(GoTel2Uni, "'", "")    ' Neu muon hien thi ko dau thi phai go ky tu ' . Vd: Vi'sual Ba'sic
  115. End Function
  116.  
  117. Public Function ID(i As Integer) As Long
  118.     ID = CLng(i) + 1
  119. End Function
  120.  
  121. Public Function ChonPopupMenu(tenForm As Form, hMenu As Long) As Long
  122.     Dim MP As POINTAPI
  123.     GetCursorPos MP
  124.    
  125.     ChonPopupMenu = TrackPopupMenu(hMenu, TPM_RETURNCMD, MP.X, MP.Y, 0, tenForm.hwnd, 0&)
  126. End Function
  127.  
  128. Public Sub XoaPopupMenu(hMenu As Long)
  129.     DestroyMenu hMenu
  130. End Sub
  131.  
  132. Private Function Cap(Nhan) As Long
  133.     Dim i As Integer
  134.    
  135.     For i = 1 To Len(Nhan)
  136.         If Mid(Nhan, i, 1) <> "^" Then Exit For
  137.     Next i
  138.     Cap = i - 1
  139. End Function
  140.  
  141. Private Function Xoa6(Nhan) As String
  142.     Xoa6 = Right(Nhan, Len(Nhan) - Cap(Nhan))
  143. End Function
  144.  
  145.  
  146. Private Function sttCha(mang, cso As Integer) As Long
  147.     Dim i As Integer
  148.    
  149.     For i = cso - 1 To 0 Step -1
  150.         If Cap(mang(i)) = Cap(mang(cso)) - 2 Then Exit For
  151.         If Cap(mang(i)) = Cap(mang(cso)) - 1 Then sttCha = sttCha + 1
  152.     Next i
  153.     sttCha = sttCha - 1
  154. End Function
  155.  
  156. Private Function soMenu(mang) As Long
  157.     Dim i As Integer
  158.     soMenu = Cap(mang(0))
  159.     For i = 0 To UBound(mang)
  160.         If Cap(mang(i)) > soMenu Then soMenu = Cap(mang(i))
  161.     Next i
  162. End Function
  163.  
  164. Public Sub hPopupMenuViet(nhanArray)
  165. '---------------------------------------------------------------------------------------
  166. ' Procedure : hPopupMenuViet
  167. ' Author      : phantronghiep07
  168. ' Phone       : 0915 080 282
  169. '---------------------------------------------------------------------------------------
  170.    Dim i As Integer
  171.     Dim hSubMenu() As Long
  172.    
  173.     ReDim hSubMenu(soMenu(nhanArray))
  174.     hMainMenu = CreatePopupMenu
  175.    
  176.     For i = 0 To UBound(nhanArray)
  177.         If Cap(nhanArray(i)) = 0 Then
  178.             If nhanArray(i) <> "-" Then
  179.                 AppendMenu hMainMenu, MF_STRING, ID(i), StrPtr(GoTel2Uni(nhanArray(i)))
  180.             Else
  181.                 AppendMenu hMainMenu, MF_SEPARATOR, ID(i), 0&     'Gach phan cach
  182.            End If
  183.         End If
  184.     Next i
  185.    
  186.     If hMainMenu <> 0 Then
  187.         hSubMenu(0) = hMainMenu
  188.         For i = 1 To UBound(nhanArray)
  189.             If Cap(nhanArray(i)) <> 0 Then
  190.            
  191.                 If i = UBound(nhanArray) Then
  192.                     MenuInsert hSubMenu(Cap(nhanArray(i)) - 1), GoTel2Uni(Xoa6(nhanArray(i))), _
  193.                                 sttCha(nhanArray, i), ID(i)
  194.                     Exit For
  195.                 End If
  196.                
  197.                 If Cap(nhanArray(i + 1)) > Cap(nhanArray(i)) Then
  198.                     hSubMenu(Cap(nhanArray(i))) = MenuInsert(hSubMenu(Cap(nhanArray(i)) - 1), _
  199.                             GoTel2Uni(Xoa6(nhanArray(i))), sttCha(nhanArray, i), ID(i))
  200.                    
  201.                     Else
  202.                         MenuInsert hSubMenu(Cap(nhanArray(i)) - 1), GoTel2Uni(Xoa6(nhanArray(i))), _
  203.                                 sttCha(nhanArray, i), ID(i)
  204.                
  205.                 End If
  206.             End If
  207.         Next i
  208.     End If
  209. End Sub
  210.  

Các bạn download tập tin này về để soạn Popup Menu:
Popup menu Unicode da cap.rar
(31.65 KiB) Đã tải 164 lần

Cách sử dụng cũng đơn giản.
Untitled.png
Untitled.png (49.61 KiB) Đã xem 943 lần

Khi soạn xong, bấm nút OK để chép code tạo Popup Menu vào Clipboard.
Nút Preview để xem trước Popup Menu.
Nút Add để lấy code tạo Popup Menu trong Clipboard vào listbox để chỉnh sửa.
Nút Copy Module to Clipboard để chép Module Việt hóa Popup Menu vào Clipboard.
Và đây là ví dụ để sử dụng Module:
  1. Private Sub Form_Load()
  2.     NhanMenu = Array("Sasch giaso khoa", "^Toasn", "^^Hifnh hojc", "^^^Taajp 1", _
  3.         "^^^Taajp 2", "^^DDaji soos", "^^^Taajp 1", _
  4.         "^^^Taajp 2", "^Vawn", "^^Taajp 1", _
  5.         "^^Taajp 2", "^DDija lys ddija phuwowng", "^^Mieefn Bawsc", _
  6.         "^^Mieefn Nam", "^^^Thafnh phoos Hoof Chis Minh", "^^^Caf Mau", _
  7.         "^^^^Tp Caf Mau", "^^^^^Phuwowfng 1", "^^^^^Phuwowfng 8", _
  8.         "^^^^^^Khosm 1", "^^^^^^Khosm 2", "^^^^^^Khosm 8", _
  9.         "^^^^^^^DDuwowfng Nguyeexn Taast Thafnh", "^^^^^^^DDuwowfng Lee Vixnh Hofa", "^^^^^^^^Caajp nhaajt duwx lieeju", _
  10.         "^^^^^^^^^Thasng 1", "^^^^^^^^^Thasng 5", "^^^^^^^^^^Baso caso", _
  11.         "^^^^^^^^^^^Casc truwowfng", "^^^^^^^^^^^Sowr GD DDT", "^^^^^^^^^Thasng 7", _
  12.         "^^^^^Phuwowfng 9", "^^^^Casi Nuwowsc", "^^^^DDaafm Dowi", _
  13.         "Truyeejn", "^Tieeru thuyeest", "^^Trong nuwowsc", _
  14.         "^^^Truwowsc 1945", "^^^^Laxng majn", "^^^^^Mieefn Bawsc", _
  15.         "^^^^^Mieefn Trung", "^^^^^Mieefn Nam", "^^^^Casch majng", _
  16.         "^^^Sau 1945", "^^Dijch", "^^^Anh", _
  17.         "^^^Phasp", "^^^Nga", "Thow", _
  18.         "-", "Tasc giar", "-", _
  19.         "Thoast")
  20.     hPopupMenuViet NhanMenu
  21. End Sub
  22.  

  1. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.     Dim sMenu As Long, i As Integer
  3.    
  4.     If Button = 2 Then
  5.         sMenu = ChonPopupMenu(Me, hMainMenu)
  6.                
  7.         For i = 0 To UBound(NhanMenu)
  8.             If sMenu = ID(i) Then
  9.                 If ID(i) = 51 Then
  10.                     MsgBox "Tac gia: Phan Trong Hiep" & vbCrLf & "Email: <!-- e --><a href="mailto:phantronghiep07@gmail.com">phantronghiep07@gmail.com</a><!-- e -->" & _
  11.                                 vbCrLf & "Phone: 0915 080 282"
  12.                     Else
  13.                     MsgBox NhanMenu(i)
  14.                 End If
  15.                 Exit For
  16.             End If
  17.         Next i
  18.     End If
  19.    
  20. End Sub
  21.  

Cuối cùng, khi thoát chương trình thì xóa Popup Menu vừa tạo để giải phóng bộ nhớ của máy:
  1. Private Sub Form_Unload(Cancel As Integer)
  2.     XoaPopupMenu hMainMenu
  3. End Sub
  4.  


Chí nhỏ vui với việc nhỏ !
Giấc mơ con ru ngủ cuộc đời con !

Quay về “[VB] Thủ thuật, mẹo vặt”

Đ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