Menambahkan New Menu Pada System Form

PERSIAPAN			PROPERTIES
NO	CONTROL	ITEM	NAME	VALUE	KETERANGAN
1.	Form	1

Gambar Menambahkan New Menu Pada System Form

Masukkan souce ini ke dalam Form :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

Masukkan souce ini ke dalam Module :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