Visual Basic 4 All - programowanie kurs vba przykłady tutorial sources - Jak do menu systemowego naszej aplikacji dodać nową pozycję ?(autor:marins)

Szybkie szukanie

sobota, 11 luty 2012

Start

Start

Tips & Tricks

Jak do menu systemowego naszej aplikacji dodać nową pozycję ?(autor:marins)

Napisał Administrator

wtorek, 24 styczeń 2006

1. Tworzymy nowy projekt Ctrl + N
2. Dodajemy forme, a do niej kod:

Option Explicit
Private Sub Form_Load()
Dim d As String
d = SubClass(Form1, "&O programie...")
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub

3. Dodajemy Modul i poniższy kod do niego:

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
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert 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
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 Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public lProcOld As Long
Public Const MF_UNCHECKED = &H0& 'niewci�nięty
Public Const MF_CHECKED = &H8& 'wci�nięty
Public Const MF_GRAYED = &H1& 'Nieaktywny
Public Const MF_MENUBARBREAK = &H20& 'menu tak jak w win95
Public Const MF_POPUP = &H10& 'wiadomo co
Public Const MF_ENABLED = &H0& 'aktwyny
Public Const MF_OWNERDRAW = &H100& 'bez menu
Public Const IDM_ABOUT As Long = 1010

Public Function SysMenuHandler(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If iMsg = WM_SYSCOMMAND Then
If wParam = IDM_ABOUT Then
MsgBox "Wrocławska Baza COMMANDOS" & vbCrLf & "http://www.commandos.cenega.net/", vbInformation, "O programie..."
Exit Function
End If
End If
SysMenuHandler = CallWindowProc(lProcOld, hWnd, iMsg, wParam, lParam)
End Function

Public Function SubClass(Nazwa_Formy As Form, Tekst_Menu As String)
Dim lhSysMenu As Long, lRet As Long
lhSysMenu = GetSystemMenu(Nazwa_Formy.hWnd, 0&)
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString)
lRet = AppendMenu(lhSysMenu, MF_STRING, IDM_ABOUT, Tekst_Menu)
Nazwa_Formy.Show
lProcOld = SetWindowLong(Nazwa_Formy.hWnd, GWL_WNDPROC, AddressOf SysMenuHandler)
End Function
4. Uruchamiamy projekt i delektujemy się efektem