PopUp Dosya Menüsüne Uygulama Ekleme

MasaÜstünde sağ fare tuşuna basıldığında çıkan Menüye ulaşmak her zaman kolaydır.Buraya Çok sık kullandığınız programlarınızı  eklemeniz için VB:NET 2010 ile yapılmış bir örnek

Imports Microsoft.Win32 'Dosya Menüsüne Uygulama Ekleme örneği 'ikon Dosyası>>> %SystemRoot%\system32\SHELL32.dll Imports vb = Microsoft.VisualBasic Imports System.IO Public Class Form1 Dim programAdi As String Dim VarsayilanAdi As String Dim programExe As String Dim programYolu As String Dim uzanti As String Dim DizinYolu As String Dim UyPozisyonu As String Dim Uygulamaikonu As String Dim kayit As RegistryKey Private Sub DsyAçBtn_Click(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.Click Dim openDLG As New OpenFileDialog openDLG.InitialDirectory = GetSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", "C:\Program Files") openDLG.Multiselect = False openDLG.DefaultExt = "exe" openDLG.Filter = "Programlar (*.exe)|*.exe" If openDLG.ShowDialog = DialogResult.OK Then If vb.Right((openDLG.FileName), 4) = ".exe" Then UyYoluTxt.Text = openDLG.FileName Else Exit Sub End If programYolu = Trim(UyYoluTxt.Text) If Not ikonYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri() UygulamaAdıTxt.Text = DosyaAdıBul(DosyaAdıBul(openDLG.FileName)) programAdi = UygulamaAdıTxt.Text UyVarsayılanAdıTxt.Text = DosyaAdıBul(DosyaAdıBul(openDLG.FileName)) & uzanti SaveSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", openDLG.InitialDirectory) End If End Sub Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles MnEkleBtn.Click On Error Resume Next Dim anahtar As String = "DesktopBackground\Shell" 'Masaüstüne boş alana tıklayınca gelmesini istiyorsan regedit te kullanman gereken alan kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(programAdi) 'Sağ Click menüme programAdinı Oluşturdum. If Clipboard.ContainsImage() Then 'picurebox içine panoyu aktar ikonPic.Image = Clipboard.GetImage() End If kayit.SetValue("Icon", ikonYoluTxt.Text) kayit.SetValue("Position", UyPozisyonu) 'Programın menüdeki pozisyonunu belirledim. Top,center,bottom kayit.CreateSubKey("command").SetValue("", programYolu) MessageBox.Show("İşlem tamam") Exit Sub End Sub Public Function DosyaAdıBul(ByVal DosyaYolu As String) As String On Error Resume Next Dim SonPozisyon, Yenipozisyon As Integer, Filtre As String SonPozisyon = InStr(DosyaYolu, "\") Yenipozisyon = SonPozisyon Do While SonPozisyon > 0 Yenipozisyon = SonPozisyon SonPozisyon = InStr(Yenipozisyon + 1, DosyaYolu, "\") Loop Filtre = Mid(DosyaYolu, Yenipozisyon + 1) SonPozisyon = InStr(Filtre, ".") Yenipozisyon = SonPozisyon Do While SonPozisyon > 0 Yenipozisyon = SonPozisyon SonPozisyon = InStr(Yenipozisyon + 1, Filtre, ".") Loop Filtre = Mid(Filtre, 1, Yenipozisyon - 1) Return Filtre End Function Private Sub PictureBox1_MouseLeave(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.MouseLeave Dim tooltip As New ToolTip() tooltip.SetToolTip(DsyAçBtn, "Dosya menüsünüe eklenecek Programı seçin") End Sub Private Sub RegisterAcPic_Click(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.Click 'regedit 'i açar ' 'HKEY_CLASSES_ROOT\"*\shell" BURAYA EKLENİYOR System.Diagnostics.Process.Start("C:\Windows\System32\regedt32.exe") End Sub Private Sub RegisterAcPic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.MouseLeave Dim tooltip As New ToolTip() tooltip.SetToolTip(RegisterAcPic, "Kayıtlar >>DesktopBackground\Shell") End Sub Private Sub ikonPic_Click(sender As System.Object, e As System.EventArgs) Handles ikonPic.Click Dim openDLG As New OpenFileDialog openDLG.Multiselect = False openDLG.DefaultExt = "ico" openDLG.Filter = "Ikon (*.ico)|*.ico" If openDLG.ShowDialog = DialogResult.OK Then If vb.Right((openDLG.FileName), 4) = ".ico" Then ikonYoluTxt.Text = openDLG.FileName Me.ikonPic.Image = Image.FromFile(openDLG.FileName, True) If Not UyYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri() End If End Sub Private Sub RBUst_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBUst.CheckedChanged If RBUst.Checked = False Then Exit Sub Me.UyPozisyonuTxt.Text = "top" SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text) End Sub Private Sub RBOrta_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBOrta.CheckedChanged If RBOrta.Checked = False Then Exit Sub Me.UyPozisyonuTxt.Text = "center" SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text) End Sub Private Sub RBAlt_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBAlt.CheckedChanged If RBAlt.Checked = False Then Exit Sub Me.UyPozisyonuTxt.Text = "bottom" SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text) End Sub Public Sub PozisyonYeri() UyPozisyonu = GetSetting(Application.ProductName, "Ayarlar", "RB", "top") Select Case UyPozisyonu Case "top" : RBUst.Checked = True Case "center" : RBOrta.Checked = True Case "bottom" : RBAlt.Checked = True End Select Grup1.Enabled = True End Sub Private Sub Button1_Click_1(sender As System.Object, e As System.EventArgs) Handles Button1.Click UyYoluTxt.Text = "" ikonYoluTxt.Text = "" ikonPic.Image = Nothing UyPozisyonuTxt.Text = "" UygulamaAdıTxt.Text = "" UyVarsayılanAdıTxt.Text = "" Grup1.Enabled = False End Sub End Class