Add 3D Line Under The Menu

'Add 1 Frame and 1 Menu to your Form.
'Insert the following code to your form:
Private Sub Form_Load()
Frame1.Caption = ""
Frame1.Height = 30
Frame1.Width = Screen.Width + 100
Frame1.Move -50, 0
End Sub

Readmore...

Disable Text Box Pop Up Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Text Box to your form.
'Insert this code to the module :
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_RBUTTONUP = &H205
Public lpPrevWndProc As Long
Private lngHWnd As Long

Public Sub Hook(hWnd As Long)
lngHWnd = hWnd
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Public Sub UnHook()
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_RBUTTONUP
'You can put here your own popup menu.
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function

'Insert the following code to your form:
Private Sub Form_Load()
'Replace 'Text1' with the name of your Text Box
Call Hook(Text1.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHook
End Sub

Readmore...

Add Pop Up Menu To Text Box

'Add 1 Text Box to your form. Add 1 Menu (Name it MyMenu) and at least 1 Sub Menu.
'Insert the following code to your form:
Private Const WM_RBUTTONDOWN = &H204
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Sub OpenContextMenu(FormName As Form, MenuName As Menu)
Call SendMessage(FormName.hwnd, WM_RBUTTONDOWN, 0, 0&)
FormName.PopupMenu MenuName
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Replace 'MyMenu' with the menu you want to pop up.
If Button = vbRightButton Then Call OpenContextMenu(Me, Me.MyMenu)
End Sub

Readmore...

Align Menu To Right

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button and 1 Menu to your form.
'Insert this code to the module :
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Const MIIM_TYPE = &H10
Public Const MFT_RIGHTJUSTIFY = &H4000
Public Const MFT_STRING = &H0&
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo _
As MENUITEMINFO) As Long
Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, _
lpcMenuItemInfo As MENUITEMINFO) As Long
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

'Insert this code to your form:
Private Sub Command1_Click()
Dim MnuInfo As MENUITEMINFO
mnuH& = GetMenu(Me.hwnd)
MnuInfo.cbSize = Len(MnuInfo)
MnuInfo.fMask = MIIM_TYPE
'If you want to align to right only few menus, and leave the rest in left side,
'Replace the '0' below and the '0' two lines above the 'End Sub' with the number
'of menus you want to leave in the left side.
myTemp& = GetMenuItemInfo(mnuH&, 0, True, MnuInfo)
MnuInfo.fType = MFT_RIGHTJUSTIFY Or MFT_STRING
'Replace all 'MenuCaption' below with the caption of the first menu from left.
MnuInfo.cch = Len("MenuCaption")
MnuInfo.dwTypeData = "MenuCaption"
MnuInfo.cbSize = Len(MnuInfo)
myTemp& = SetMenuItemInfo(mnuH&, 0, True, MnuInfo)
myTemp& = DrawMenuBar(Me.hwnd)
End Sub

Readmore...

Put Bitmaps On Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button And 2 Picture Boxes to your form.
'Set Picture Boxes AutoSize property to True. Add pictures to the Picture Boxes.
'When the menu will be enabled, the picture in Picture1 will be displayed near him.
'When the menu will be disabled, the picture in Picture2 will be displayed near him.
'The pictures should not be bigger than 13x13.
'Add menu to your form, Add 1 sub menu to the menu and name it MyMenu.
'When you run this program, press on the button to enable\disable menu.
'Insert this code to the module :
Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal _
nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal _
nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal _
nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal _
hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4&

'Insert this code to your form:
Private Sub Command1_Click()
MyMenu.Enabled = Not MyMenu.Enabled
End Sub

Private Sub Form_Load()
'Replace 'Form1' with the name of your form
hMenu& = GetMenu(Form1.hWnd)
'Replace '0' with the menu position. '0' means the first menu from left.
'If it was the second from left, you should been place there '1'.
hSubMenu& = GetSubMenu(hMenu&, 0)
'Replace '0' with the sub menu position. '0' means the upper sub menu.
'If it was the second from top, you should been place there '1'.
hID& = GetMenuItemID(hSubMenu&, 0)
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture2.Picture
End Sub

Readmore...

Add PopUp Menu To TreeView

'Add 1 TreeView to your form. Add few nodes to the treeview.
'Add 1 Menu (Named MyMenu) and few Sub Menus.
'When you will click on the right mouse button the menu will popup.
'Insert the following code to your form:

Private Sub TreeView1_Mousedown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nod As Node
If Button = vbRightButton Then
Set nod = TreeView1.HitTest(x, y)
On Error GoTo EmptyNode
nod.Selected = True
On Error GoTo 0
Me.PopupMenu MyMenu
EmptyNode:
On Error GoTo 0
End If
End Sub

Readmore...

Put Split In Menu

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add menu to your form. Add 4 Sub Menus to this menu.
'Insert this code to the module :
Public 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
Public Declare Function GetMenu Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Public Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" _
Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpmii As MENUITEMINFO) As Long
Public Declare Function SetMenuItemInfo Lib "user32" _
Alias "SetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal uItem As Long, _
ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_CHECKMARKS = &H8
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public Const MFT_RADIOCHECK = &H200&
Public Const MFT_STRING = &H0&
Public Const RGB_STARTNEWCOLUMNWITHVERTBAR = &H20&
Public Const RGB_STARTNEWCOLUMN = &H40&
Public Const RGB_EMPTY = &H100&
Public Const RGB_VERTICALBARBREAK = &H160&
Public Const RGB_SEPARATOR = &H800&

'Insert the following code to your form:
Private Sub Form_Load()
Dim r As Long
Dim hSubMenu As Long
Dim mnuItemCount As Long
Dim mInfo As MENUITEMINFO
'Replace the '0' below with the menu position. In this case put 0 because the menu that you
'want to put split on it is the first menu from the left. If the menu position was the second from 'the left, you've should been put there '1'.
hSubMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
mnuItemCount = GetMenuItemCount(hSubMenu)
mInfo.cbSize = Len(mInfo)
mInfo.fMask = MIIM_TYPE
mInfo.fType = MFT_STRING
mInfo.dwTypeData = Space$(256)
mInfo.cch = Len(mInfo.dwTypeData)
'Replace the '1' below with your desirable split position. Put '1' to enter the split after
'the first sub menu, put '1' to put it after the second sub menu and so on.
'If you want to put the split before the last sub menu, put there 'mnuItemCount - 1'.
'If you want to put it before 2 sub menus from the last, put there 'mnuItemCount - 1'.
'If you replace the '1' Don't forget to replace also the '1' in the line above the 'End Sub'
r = GetMenuItemInfo(hSubMenu,1, True, mInfo)
mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
mInfo.fMask = MIIM_TYPE
'If you Replaced the '1' three lines above, replace the '1' below with the same number.
r = SetMenuItemInfo(hSubMenu,1, True, mInfo)
End Subm

Readmore...

Add New Menu Item To The Form's Sytem Menu

The system menu is the default pop up menu (with Restore, Move, Minimize, Maximize, etc.) that pops up when you right clicking on the title bar, or when you right clicking on the task bar.

Note: to perform this task, the code below uses subclassing. that's mean that if you won't close your program properly, it may cause your Visual Basic Environment to crash.
You can close your program by pressing Alt +F4, clicking the form X button, or any other way, but don't close the program by pressing the Visual Basic Stop button.

Module Code

Option Explicit Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
(ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As _
Long, ByVal lpNewItem As String) As Long

Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As _
Long, ByVal bRevert As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal _
dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const SC_NEWMENU = 2
Public Const SC_MINIMIZE = &HF020
Public Const WM_SYSCOMMAND = &H112
Public Const WM_INITMENUPOPUP = &H117
Public Const BITMASK = &HFFFF0000
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const MF_GREYED = &H1&

Public Function FrmProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
   
    'this allows each form to have its own window proc
    'and hence to be able to access its own properties in the Win Proc
    FrmProc = FrmFromHwnd(hwnd).WindowProc(hwnd, Msg, wParam, lParam)
   
End Function
Private Function FrmFromHwnd(hwnd As Long) As Object
   
    Dim lo_Form As Object
    Dim ll_Pointer As Long
   
    'make function point to our subclassed form
    ll_Pointer = GetWindowLong(hwnd, GWL_USERDATA)
    CopyMemory lo_Form, ll_Pointer, 4
    Set FrmFromHwnd = lo_Form
   
    'don't forget to clean up afterwards!
    CopyMemory lo_Form, 0&, 4
   
End Function

Form Code

Option Explicit
Private ml_OldWinProc As Long Private Sub Form_Load()
   
    AddAboutMenu
    SubClass
       
End Sub
Private Sub Form_Unload(Cancel As Integer)
    UnSubClass
   
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim ll_SysMenu As Long
    Select Case Msg
   
        Case WM_SYSCOMMAND
     
            'the user clicked on the new menu item
            If wParam = SC_NEWMENU Then
            ' you can put here whatever you want to run when the menu is clicked
                MsgBox "You've clicked the new item"
            End If
           
        Case WM_INITMENUPOPUP
       
            'disable the menu option if the form is minimized. If you want
            'that it will be enabled, remove the lines below from "If lParam ..."
            'till "End If" that found 1 line above the "End Select"
            If lParam And BITMASK Then
                ll_SysMenu = GetSystemMenu(hwnd, 0)
                If wParam = ll_SysMenu Then
                    EnableMenuItem ll_SysMenu, SC_NEWMENU, ByVal _
                       IIf(WindowState = vbMinimized, MF_GREYED, 0)
                End If
            End If
    End Select
   
    WindowProc = CallWindowProc(ml_OldWinProc, hwnd, Msg, wParam, lParam)
   
End Function
Private Sub SubClass()
    'store object refernce so we can check its properties later
    SetWindowLong Me.hwnd, GWL_USERDATA, ObjPtr(Me)   
    ml_OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf FrmProc)
End Sub
Private Sub UnSubClass()
    If ml_OldWinProc Then
        Call SetWindowLong(Me.hwnd, GWL_WNDPROC, ml_OldWinProc)
    End If
End Sub
Private Sub AddAboutMenu()
    Dim ll_OwnerWindowHandle As Long
    Dim ll_MenuHandle As Long
   
    ll_OwnerWindowHandle = Me.hwnd
    'Get system menu
    ll_MenuHandle = GetSystemMenu(ll_OwnerWindowHandle, False)
    'Add new menu item
    Call AppendMenu(ll_MenuHandle, MF_SEPARATOR, 0&, 0&)
    'replace the "New Item" below with the text you want to appear on the new
    'menu item
    Call AppendMenu(ll_MenuHandle, MF_STRING, SC_NEWMENU, "&New Item")
   
End Sub

Readmore...