این هم ی سورس کد دیگه که خیلی بکار میاد برای آیتمهای منوی سیستمی:
Visual Basic 6.0 (Source Code)
After reading the other replies, I thought about throwing the following
example into the group.
Please read the comments in the code.
Create a new project, add some menu structure to the form. Make as many
menus and sub-menus as you want. Also put a StatusBar on the form.
Add a module to the project.
Paste the following code to the form's (General)(Declaration) section:
==================================================
Option Explicit
Private Sub Form_Load()
StatusBar1.Style = sbrSimple
gPrevWndProc = SubClass(Me.hWnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubClass Me.hWnd, gPrevWndProc
End Sub
==================================================
Paste the following code to the module's (General)(Declaration) section:
==================================================
Option Explicit
Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const SC_RESTORE = &HF120&
Public Const SC_MOVE = &HF010&
Public Const SC_SIZE = &HF000&
Public Const SC_MINIMIZE = &HF020&
Public Const SC_MAXIMIZE = &HF030&
Public Const SC_CLOSE = &HF060&
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 gPrevWndProc As Long
Public Function SubClass(hWnd As Long) As Long
On Error GoTo SubClass_Error
'Use the Debug object to print some calculation that will rais an error.
'This way the program jumps to the SubClass_Error label,
'and the hWnd's object is NOT subclassed in te IDE
'
'Because the Debug object is ignored in the compiled (.exe) program,
'the hWnd's object IS subclassed in the .exe
'
'Comment-out the next line to subclass also in the IDE
'Debug.Print 1 / 0
'
'NOTE: ------------------------------------------------------+
'Pausing or Stopping a subclassed form can result in |
'unpredictable situations or even let VB crash |
'------------------------------------------------------------+
SubClass = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
SubClass_Error:
End Function
Public Function UnSubClass(hWnd As Long, lpPrevWndProc As Long) As Long
UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Function
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Dim hSysMenu As Long
Dim sMenuText As String
Dim uFlags As Long
Dim uItem As Long
Select Case uMsg
Case WM_MENUSELECT
uItem = wParam And &HFFFF&
uFlags = wParam \ &H10000 And &HFFFF&
Select Case uItem
Case 0 ' No menu
sMenuText = ""
'The following values are defined by Visual Basic
'They always start from 1 and increment through each menu
item
'The following prompts correspond to system menu commands
Case SC_RESTORE
sMenuText = "Restore this window to it's previous size"
Case SC_MOVE
sMenuText = "Move this window"
Case SC_SIZE
sMenuText = "Size this window"
Case SC_MINIMIZE
sMenuText = "Minimize this window to the taskbar"
Case SC_MAXIMIZE
sMenuText = "Maximize this window"
Case SC_CLOSE
sMenuText = "Close this window"
Case Else
'This is where I need help also!!
*************************************
'The uItem seems to identify the menu item, but I don't
see any logic *
'The uFlags gives information about grayed, chacked etc.
*
'For this example, just show the values:
*****************************
_
End Select
Form1.StatusBar1.simpleText = sMenuText
WindowProc = CallWindowProc(gPrevWndProc, hWnd, uMsg, wParam,
lParam)
Case Else
WindowProc = CallWindowProc(gPrevWndProc, hWnd, uMsg, wParam,
lParam)
End Select
End Function