Option Explicit

Dim mnuhandleno As Long, mnucnt As Long

Private Sub Command1_Click()
RemoveMenu mnuhandleno, mnucnt - 1, MF_BYPOSITION Or MF_REMOVE ’Deneme2 isimli menuyu sil
’ mnucnt - 2 olsaydı Deneme1 isimli, mnucnt - 3 olsaydı Kapat Seceneği silinirdi
End Sub

Private Sub Form_Load()

mnuhandleno = GetSystemMenu(Me.hwnd, False) ’handle numarası verilen
’pencerenin sitem menusu numarasını bul
Call AppendMenu(mnuhandleno, MF_STRING, &H10, "Deneme1") ’sistem menusu numarası
’verilen pencerenin sistem menusune HEX10 numaralı Deneme1 isimli secenek ekle
’AppendMenu apisindeki MF_STRING değeri yerine MF_DISABLED,MF_GRAYED,MF_SEPARATOR değerleri vererek menu seceneklerini inceleyin.
Call AppendMenu(mnuhandleno, MF_STRING, &H20, "Deneme2") ’sistem menusu numarası
’verilen pencerenin sistem menusune HEX10 numaralı Deneme2 isimli secenek ekle
’Son numarası 0 olan &H30, & H40 gibi daha fazla secenek eklenebilir.
formyakala Me.hwnd ’handle numarası verilen pencereye kanca atan proseduru cağır
mnucnt = GetMenuItemCount(mnuhandleno) ’Sistem menusunde kac secenek olduğunu bul secenek
SetMenuItemBitmaps mnuhandleno, mnucnt - 1, MF_BYPOSITION, Picture1.Picture, Picture2.Picture ’Burası da
’sistem menusune resim eklemek icin kullanılıyor. mnucnt - 1 sistem menusu secenek sayısının bir eksiği
’anlamına geliyor ve kod Deneme2 isimli seceneğe Picture1 isimli PictureBox icindeki resmi ekliyor. Resmin
’menude duzgun goruntulene bilmesi icin resmin 13x13 ebatlarında olması gerekli.
’Picture1.Picture, Picture2.Picture ifadesi; menunun Checked ozelliği False iken gosterilecek resmin
’Picture1 isimli PictureBox icindeki resim, Checked ozelliği True iken gosterilecek resmin ise Picture2 isimli
’PictureBox icerisindeki resim olduğunu ifade eder. Picturebox yerine ImageList nesnesi de kullanılabilir.
End Sub

Private Sub Form_Unload(Cancel As Integer)
Formbirak Me.hwnd ’Pencere kapatılırken handle numarası verilen pencereye atılan
’kancayı bırakan proseduru cağır. Aksi takdirde program kapanırken hata verir.
End Sub




’Buradan itibaren module yapıştırılacak
’Written by Serkan Karakoc
Option Explicit
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) 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 Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public 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 WM_SYSCOMMAND = &H112
Public Const GWL_WNDPROC = (-4)
’******************************************** ***** **
Public Const MF_STRING = &H0&
Public Const MF_CHECKED = &H8&
Public Const MF_DISABLED = &H2&
Public Const MF_GRAYED = &H1&
Public Const MF_SEPARATOR = &H800&
’******************************************** ***** **
Public Const MF_BYPOSITION = &H400&
Public Const MF_REMOVE = &H1000

Dim PrevProc As Long
Public Sub formyakala(handle As Long)
’handle numarası verilen pencereye kanca at
PrevProc = SetWindowLong(handle, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub Formbirak(handle As Long)
’handle numarası verilen pencereyi bırak
SetWindowLong handle, GWL_WNDPROC, PrevProc
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_SYSCOMMAND Then ’yapılan işlem sistem menusu ile ilgiliyse ilgili kodları calıştır.
’******************************************** **
If wParam = &H10 Then ’mesaj numarası HEX10 ise ilgili kodları calıştır.
MsgBox "Deneme1 secildi" _
& Chr(13) & _
"Buraya başka kodlar da yazılabilir"
’******************************************** **
End If
If wParam = &H20 Then ’mesaj numarası HEX10 ise ilgili kodları calıştır.
MsgBox "Deneme2 secildi" _
& Chr(13) & _
"Buraya başka kodlar da yazılabilir"
End If
’******************************************** **
End If
End Function


'alıntıdır tarafımdan kontrol edildi calışıyor
__________________