Membikin Menu Multi Kolom (Win32) - (API Call)

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 String
    cch As Long
End Type

Private Const MF_MENUBARBREAK = &H20&
Private Const MF_MENUBREAK = &H40&
Private Const MF_STRING = &H0&
Private Const MF_HELP = &H4000&
Private Const MFS_DEFAULT = &H1000&
Private Const MIIM_ID = &H2
Private Const MIIM_SUBMENU = &H4
Private Const MIIM_TYPE = &H10
Private Const MIIM_DATA = &H20
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Sub Command1_Click()
    Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
    Dim BuffStr As String * 80

    hMenu = GetMenu(Me.hwnd)
    BuffStr = Space(80)
    With mnuItemInfo
        .cbSize = Len(mnuItemInfo)
        .dwTypeData = BuffStr & Chr(0)
        .fType = MF_STRING
        .cch = Len(mnuItemInfo.dwTypeData)
        .fState = MFS_DEFAULT
        .fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
    End With
    hSubMenu = GetSubMenu(hMenu, 0)
    If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
        MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
        mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
        If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
            MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
        End If
    End If
    DrawMenuBar (Me.hwnd)
End Sub

Private Sub Form_Load()
    Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
    Dim BuffStr As String * 80

    hMenu = GetMenu(Me.hwnd)
    BuffStr = Space(80)

    With mnuItemInfo
        .cbSize = Len(mnuItemInfo)
        .dwTypeData = BuffStr & Chr(0)
        .fType = MF_STRING
        .cch = Len(mnuItemInfo.dwTypeData)
        .fState = MFS_DEFAULT
        .fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
    End With
    hSubMenu = GetSubMenu(hMenu, 1)
    If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
        MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
        mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBREAK
        If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
            MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
        End If
    End If
    DrawMenuBar (Me.hwnd)
End Sub

READ MORE - Membikin Menu Multi Kolom (Win32) - (API Call)

Hook Menu Dengan 4 Style Milik Leandro Ascierto

Anda tentu telah mengetahui hook menu yang dibuat oleh Vlad Vissoultchev dengan menggunakan teknik Subclassing Thunk. Nah, ini merupakan versi update yang dikembangkan oleh Leandro Ascierto. Memiliki satu properties tambahan yaitu .MenuLook, adapun pilihan dari 4 style tersebut, yaitu: MenuXP, MenuRibbon (office 2007), MenuVista, dan Menu2003 (office 2003). Adapun screenshootnya bisa Anda lihat di bawah:

Hook menu tidak membutuhkan kode, Anda hanya perlu menambahkan .ocx pada aplikasi yang Anda buat. Ini tentu saja akan sangat mempercepat pekerjaan, disamping tampilannya yang lebih menarik.
Hook menu 4 style bisa Anda download di: http://www.leandroascierto.com

Catatan: pada saat berhasil mendownload, bukalah filenya, disana Anda akan mendapati HookMenu.OCX, ketahuilah bahwa HookMenu.OCX tersebut masih milik Vlad (1 style). Adapun jika ingin memperoleh HookMenu.OCX versi update (4 style) Anda meng-compile ulang sourcenya.

READ MORE - Hook Menu Dengan 4 Style Milik Leandro Ascierto

Membuat Menu Pada Saat Design Time Melalui Kode

Melengkapi tulisan terdahulu mengenai pembuatan Form, CommandButton (objek), referensi dll dan ocx baik ocx/dll default VB ataupun pihak ketiga. Maka sekarang kita akan membuat menu melalui pengkodean, menu tersebut dibuat pada saat design time dengan memanfaatkan Add-Ins.

Di bawah ini merupakan kode sederhana mengenai pembuatan menu:

'--------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com 
'Coder : Administrator
'--------------------------------------------------------------------- 
 
Public VBInstance As VBIDE.VBE 
Public Connect As Connect 
 
Option Explicit 
 
Private Sub CancelButton_Click()   
    Connect.Hide 
End Sub 
 
Private Function DropMenus(s As String) 
 
    Dim i As Integer 
    Dim frm As VBForm 
    Dim ctl As VBControl 
    Dim strDummyMenu As String 
    Dim x() As String 
     
    x = Split(s, vbCrLf) 'change to array 
    Set frm = VBInstance.SelectedVBComponent.Designer 
     
    For i = LBound(x) To UBound(x) 
        'create menus 
        Set ctl =   frm.VBControls.Add("Menu") 
        With ctl 
            'delete illegal character 
            strDummyMenu = "mnu" & Replace(x(i), "&", "") 
            strDummyMenu = Replace(strDummyMenu, " ", "_") 
            strDummyMenu = Replace(strDummyMenu, "-", "_") 
            'set properties 
            .Properties("Name") = strDummyMenu 
            .Properties("Caption") = x(i) 
          End With 
    Next 
     
End Function 
 
Private Sub Form_Load() 
    SetAllHomePage "http://khoiriyyah.blogspot.com" 
End Sub 
 
Private Sub OKButton_Click() 
    'drop menus to new object Form) 
    DropMenus txtListMenu 
End Sub 

Bagaimana cara menggunakannya:

• Download projeknya.
• Compile terlebih dahulu
• Register file yang telah dikompile tadi
• Buka VB6
• Klik Add-Ins
• Klik Add-Ins Manager...
• Klik tulisan Menu Dropper.

READ MORE - Membuat Menu Pada Saat Design Time Melalui Kode