Jump to content

Recommended Posts

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

 

 xtqxdoz2.png

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

 



			
		
Link to post
Share on other sites
Guest
This topic is now closed to further replies.
  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...