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.
- Option Explicit
- Private Type POINTAPI
- X As Long
- Y As Long
- End Type
- Private Type MENUITEMINFO
- cbSize As Long
- fMask As Long
- fType As Long
- fState As Long
- wID As Long
- hSubMenu As Long
- hbmpChecked As Long
- hbmpUnchecked As Long
- dwItemData As Long
- dwTypeData As Long
- cch As Long
- End Type
- Const TPM_RETURNCMD = &H100&
- 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
- Private Declare Function CreatePopupMenu Lib "user32" () As Long
- Private Declare Function CreateMenu Lib "user32" () As Long
- Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
- Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
- 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
- Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
- 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
- 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
- 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
- Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
- Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
- Private Const MIIM_TYPE = &H10
- Private Const MIIM_SUBMENU = &H4
- Private Const MIIM_ID As Long = &H2
- Private Const MF_STRING = &H0
- Private Const MF_SEPARATOR = &H800&
- Public hMainMenu&
- Public NhanMenu
- '---------------------------------------------------------------------------------
- Private Function MenuInsert(ByVal hMenu As Long, ByVal strCaption As String, Optional ByVal intPos As Integer = 0, Optional ID As Long = 0) As Long
- Dim typMII As MENUITEMINFO, hSubMenu As Long, intMenuCnt As Integer
- typMII.cbSize = Len(typMII)
- typMII.fMask = MIIM_SUBMENU Or MIIM_ID
- typMII.wID = 0
- Call GetMenuItemInfo(hMenu, intPos, True, typMII)
- If typMII.hSubMenu = 0 Then
- hSubMenu = CreateMenu
- typMII.hSubMenu = hSubMenu
- Call SetMenuItemInfo(hMenu, intPos, True, typMII)
- Else
- hSubMenu = typMII.hSubMenu
- End If
- intMenuCnt = GetMenuItemCount(hSubMenu)
- typMII.fMask = MIIM_TYPE Or MIIM_ID
- typMII.fType = MF_STRING
- typMII.dwTypeData = StrPtr(strCaption)
- typMII.cch = Len(typMII.dwTypeData)
- typMII.wID = ID
- Call InsertMenuItem(hSubMenu, intMenuCnt, True, typMII)
- MenuInsert = GetSubMenu(hMenu, intPos)
- End Function
- '=====================================================================
- Private Function GoTel2Uni(ChuoiGoTelex) As String
- '---------------------------------------------------------------------------------------
- ' Function : GoTel2Uni
- ' Author : phantronghiep07
- ' Phone : 0915 080 282
- '---------------------------------------------------------------------------------------
- Dim i As Integer
- Dim maAcii, Telex
- maAcii = Array(7845, 7847, 7849, 7851, 7853, 226, 225, 224, 7843, 227, 7841, 7855, 7857, 7859, _
- 7861, 7863, 259, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 432, _
- 7871, 7873, 7875, 7877, 7879, 234, 233, 232, 7867, 7869, 7865, 7889, 7891, 7893, _
- 7895, 7897, 244, 243, 242, 7887, 245, 7885, 7899, 7901, 7903, 7905, 7907, 417, _
- 237, 236, 7881, 297, 7883, 253, 7923, 7927, 7929, 7925, 273, 7844, 7846, 7848, _
- 7850, 7852, 194, 193, 192, 7842, 195, 7840, 7854, 7856, 7858, 7860, 7862, 258, _
- 218, 217, 7910, 360, 7908, 7912, 7914, 7916, 7918, 7920, 431, 7870, 7872, 7874, _
- 7876, 7878, 202, 201, 200, 7866, 7868, 7864, 7888, 7890, 7892, 7894, 7896, 212, _
- 211, 210, 7886, 213, 7884, 7898, 7900, 7902, 7904, 7906, 416, 205, 204, 7880, 296, _
- 7882, 221, 7922, 7926, 7928, 7924, 272)
- Telex = Array("aas", "aaf", "aar", "aax", "aaj", "aa", "as", "af", "ar", "ax", "aj", "aws", "awf", _
- "awr", "awx", "awj", "aw", "us", "uf", "ur", "ux", "uj", "uws", "uwf", "uwr", "uwx", _
- "uwj", "uw", "ees", "eef", "eer", "eex", "eej", "ee", "es", "ef", "er", "ex", "ej", _
- "oos", "oof", "oor", "oox", "ooj", "oo", "os", "of", "or", "ox", "oj", "ows", "owf", _
- "owr", "owx", "owj", "ow", "is", "if", "ir", "ix", "ij", "ys", "yf", "yr", "yx", "yj", _
- "dd", "AAS", "AAF", "AAR", "AAX", "AAJ", "AA", "AS", "AF", "AR", "AX", _
- "AJ", "AWS", "AWF", "AWR", "AWX", "AWJ", "AW", "US", "UF", "UR", "UX", _
- "UJ", "UWS", "UWF", "UWR", "UWX", "UWJ", "UW", "EES", "EEF", "EER", _
- "EEX", "EEJ", "EE", "ES", "EF", "ER", "EX", "EJ", "OOS", "OOF", "OOR", _
- "OOX", "OOJ", "OO", "OS", "OF", "OR", "OX", "OJ", "OWS", "OWF", "OWR", _
- "OWX", "OWJ", "OW", "IS", "IF", "IR", "IX", "IJ", "YS", "YF", "YR", "YX", _
- "YJ", "DD")
- GoTel2Uni = ChuoiGoTelex
- For i = 0 To 133
- GoTel2Uni = Replace(GoTel2Uni, Telex(i), ChrW(maAcii(i)))
- Next i
- GoTel2Uni = Replace(GoTel2Uni, "'", "") ' Neu muon hien thi ko dau thi phai go ky tu ' . Vd: Vi'sual Ba'sic
- End Function
- Public Function ID(i As Integer) As Long
- ID = CLng(i) + 1
- End Function
- Public Function ChonPopupMenu(tenForm As Form, hMenu As Long) As Long
- Dim MP As POINTAPI
- GetCursorPos MP
- ChonPopupMenu = TrackPopupMenu(hMenu, TPM_RETURNCMD, MP.X, MP.Y, 0, tenForm.hwnd, 0&)
- End Function
- Public Sub XoaPopupMenu(hMenu As Long)
- DestroyMenu hMenu
- End Sub
- Private Function Cap(Nhan) As Long
- Dim i As Integer
- For i = 1 To Len(Nhan)
- If Mid(Nhan, i, 1) <> "^" Then Exit For
- Next i
- Cap = i - 1
- End Function
- Private Function Xoa6(Nhan) As String
- Xoa6 = Right(Nhan, Len(Nhan) - Cap(Nhan))
- End Function
- Private Function sttCha(mang, cso As Integer) As Long
- Dim i As Integer
- For i = cso - 1 To 0 Step -1
- If Cap(mang(i)) = Cap(mang(cso)) - 2 Then Exit For
- If Cap(mang(i)) = Cap(mang(cso)) - 1 Then sttCha = sttCha + 1
- Next i
- sttCha = sttCha - 1
- End Function
- Private Function soMenu(mang) As Long
- Dim i As Integer
- soMenu = Cap(mang(0))
- For i = 0 To UBound(mang)
- If Cap(mang(i)) > soMenu Then soMenu = Cap(mang(i))
- Next i
- End Function
- Public Sub hPopupMenuViet(nhanArray)
- '---------------------------------------------------------------------------------------
- ' Procedure : hPopupMenuViet
- ' Author : phantronghiep07
- ' Phone : 0915 080 282
- '---------------------------------------------------------------------------------------
- Dim i As Integer
- Dim hSubMenu() As Long
- ReDim hSubMenu(soMenu(nhanArray))
- hMainMenu = CreatePopupMenu
- For i = 0 To UBound(nhanArray)
- If Cap(nhanArray(i)) = 0 Then
- If nhanArray(i) <> "-" Then
- AppendMenu hMainMenu, MF_STRING, ID(i), StrPtr(GoTel2Uni(nhanArray(i)))
- Else
- AppendMenu hMainMenu, MF_SEPARATOR, ID(i), 0& 'Gach phan cach
- End If
- End If
- Next i
- If hMainMenu <> 0 Then
- hSubMenu(0) = hMainMenu
- For i = 1 To UBound(nhanArray)
- If Cap(nhanArray(i)) <> 0 Then
- If i = UBound(nhanArray) Then
- MenuInsert hSubMenu(Cap(nhanArray(i)) - 1), GoTel2Uni(Xoa6(nhanArray(i))), _
- sttCha(nhanArray, i), ID(i)
- Exit For
- End If
- If Cap(nhanArray(i + 1)) > Cap(nhanArray(i)) Then
- hSubMenu(Cap(nhanArray(i))) = MenuInsert(hSubMenu(Cap(nhanArray(i)) - 1), _
- GoTel2Uni(Xoa6(nhanArray(i))), sttCha(nhanArray, i), ID(i))
- Else
- MenuInsert hSubMenu(Cap(nhanArray(i)) - 1), GoTel2Uni(Xoa6(nhanArray(i))), _
- sttCha(nhanArray, i), ID(i)
- End If
- End If
- Next i
- End If
- End Sub
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 177 lần
Cách sử dụng cũng đơn giản.
- Untitled.png (49.61 KiB) Đã xem 1415 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:
- Private Sub Form_Load()
- NhanMenu = Array("Sasch giaso khoa", "^Toasn", "^^Hifnh hojc", "^^^Taajp 1", _
- "^^^Taajp 2", "^^DDaji soos", "^^^Taajp 1", _
- "^^^Taajp 2", "^Vawn", "^^Taajp 1", _
- "^^Taajp 2", "^DDija lys ddija phuwowng", "^^Mieefn Bawsc", _
- "^^Mieefn Nam", "^^^Thafnh phoos Hoof Chis Minh", "^^^Caf Mau", _
- "^^^^Tp Caf Mau", "^^^^^Phuwowfng 1", "^^^^^Phuwowfng 8", _
- "^^^^^^Khosm 1", "^^^^^^Khosm 2", "^^^^^^Khosm 8", _
- "^^^^^^^DDuwowfng Nguyeexn Taast Thafnh", "^^^^^^^DDuwowfng Lee Vixnh Hofa", "^^^^^^^^Caajp nhaajt duwx lieeju", _
- "^^^^^^^^^Thasng 1", "^^^^^^^^^Thasng 5", "^^^^^^^^^^Baso caso", _
- "^^^^^^^^^^^Casc truwowfng", "^^^^^^^^^^^Sowr GD DDT", "^^^^^^^^^Thasng 7", _
- "^^^^^Phuwowfng 9", "^^^^Casi Nuwowsc", "^^^^DDaafm Dowi", _
- "Truyeejn", "^Tieeru thuyeest", "^^Trong nuwowsc", _
- "^^^Truwowsc 1945", "^^^^Laxng majn", "^^^^^Mieefn Bawsc", _
- "^^^^^Mieefn Trung", "^^^^^Mieefn Nam", "^^^^Casch majng", _
- "^^^Sau 1945", "^^Dijch", "^^^Anh", _
- "^^^Phasp", "^^^Nga", "Thow", _
- "-", "Tasc giar", "-", _
- "Thoast")
- hPopupMenuViet NhanMenu
- End Sub
- Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim sMenu As Long, i As Integer
- If Button = 2 Then
- sMenu = ChonPopupMenu(Me, hMainMenu)
- For i = 0 To UBound(NhanMenu)
- If sMenu = ID(i) Then
- If ID(i) = 51 Then
- MsgBox "Tac gia: Phan Trong Hiep" & vbCrLf & "Email: <!-- e --><a href="mailto:phantronghiep07@gmail.com">phantronghiep07@gmail.com</a><!-- e -->" & _
- vbCrLf & "Phone: 0915 080 282"
- Else
- MsgBox NhanMenu(i)
- End If
- Exit For
- End If
- Next i
- End If
- End Sub
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:
- Private Sub Form_Unload(Cancel As Integer)
- XoaPopupMenu hMainMenu
- End Sub