 |
|
|
Option Explicit
Dim mnuhandleno As Long, mnucnt As Long
Private Sub Command1_Click()
RemoveMenu mnuhandleno, mnucnt - 1, MF_BYPOSITION Or MF_REMOVE ’Deneme2 isimli menüyü sil
’ mnucnt - 2 olsaydı Deneme1 isimli, mnucnt - 3 olsaydı Kapat Seçeneği silinirdi
End Sub
Private Sub Form_Load()
mnuhandleno = GetSystemMenu(Me.hwnd, False) ’handle numarası verilen
’pencerenin sitem menüsü numarasını bul
Call AppendMenu(mnuhandleno, MF_STRING, &H10, "Deneme1") ’sistem menüsü numarası
’verilen pencerenin sistem menüsüne HEX10 numaralı Deneme1 isimli seçenek ekle
’AppendMenu apisindeki MF_STRING değeri yerine MF_DISABLED,MF_GRAYED,MF_SEPARATOR değerleri vererek menü seçeneklerini inceleyin.
Call AppendMenu(mnuhandleno, MF_STRING, &H20, "Deneme2") ’sistem menüsü numarası
’verilen pencerenin sistem menüsüne HEX10 numaralı Deneme2 isimli seçenek ekle
’Son numarası 0 olan &H30, & H40 gibi daha fazla seçenek eklenebilir.
formyakala Me.hwnd ’handle numarası verilen pencereye kanca atan prosedürü çağır
mnucnt = GetMenuItemCount(mnuhandleno) ’Sistem menüsünde kaç seçenek olduğunu bul seçenek
SetMenuItemBitmaps mnuhandleno, mnucnt - 1, MF_BYPOSITION, Picture1.Picture, Picture2.Picture ’Burası da
’sistem menüsüne resim eklemek için kullanılıyor. mnucnt - 1 sistem menüsü seçenek sayısının bir eksiği
’anlamına geliyor ve kod Deneme2 isimli seçeneğe Picture1 isimli PictureBox içindeki resmi ekliyor. Resmin
’menüde düzgün görüntülene bilmesi için resmin 13x13 ebatlarında olması gerekli.
’Picture1.Picture, Picture2.Picture ifadesi; menünün Checked özelliği False iken gösterilecek resmin
’Picture1 isimli PictureBox içindeki resim, Checked özelliği True iken gösterilecek resmin ise Picture2 isimli
’PictureBox içerisindeki 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 prosedürü çağır. Aksi takdirde program kapanırken hata verir.
End Sub
’Buradan itibaren modüle yapıştırılacak
’Written by Serkan Karakoç
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 menüsü ile ilgiliyse ilgili kodları çalıştır.
’******************************************** **
If wParam = &H10 Then ’mesaj numarası HEX10 ise ilgili kodları çalıştır.
MsgBox "Deneme1 seçildi" _
& Chr(13) & _
"Buraya başka kodlar da yazılabilir"
’******************************************** **
End If
If wParam = &H20 Then ’mesaj numarası HEX10 ise ilgili kodları çalıştır.
MsgBox "Deneme2 seçildi" _
& Chr(13) & _
"Buraya başka kodlar da yazılabilir"
End If
’******************************************** **
End If
End Function
|
| WwW.WeBCaNaVaRi.NeT | > .::|~ Web Tasarım ~|::. > Webmaster Genel > Visual Basic (Moderatör: WeBCaNaVaRi)
Konu: Sistem Menüsü
Yazdır
Gelişmiş Arama
Şubat 24, 2012, 10:53:42 ÖÖ