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

[phantronghiep07]

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

---

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.

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

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.  

GeSHi © Codebox Plus

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 167 lần

Cách sử dụng cũng đơn giản.

Untitled.png (49.61 KiB) Đã xem 978 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:

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

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.  

GeSHi © Codebox Plus

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

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.  

GeSHi © Codebox Plus

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:

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

1. Private Sub Form_Unload(Cancel As Integer)
2.     XoaPopupMenu hMainMenu
3. End Sub
4.  

GeSHi © Codebox Plus