Jump to content
Larkozs

Exe Programın Ikonunu Almak

Önerilen Mesajlar

7rk73kn7.png

 

Imports vb = Microsoft.VisualBasic
Imports System.IO
Public Class Form1
    Dim programAdi As String
 
 
    
    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
 
            UygulamaAdıTxt.Text = System.IO.Path.GetFileName(openDLG.FileName)
            programAdi = Mid(UygulamaAdıTxt.Text, 1, Len(UygulamaAdıTxt.Text) - 4) '".exe" kısmını çıkarıyoruz
            UygulamaAdıTxt.Text = UygulamaAdıTxt.Text 'programAdi
            UyVarsayılanAdıTxt.Text = programAdi
 
            Dim sonuc As Icon = Nothing
            sonuc= Icon.ExtractAssociatedIcon(openDLG.FileName)
            Me.Icon = sonuc
            Me.ikonPic.Image = Me.Icon.ToBitmap
 
            If Clipboard.ContainsImage() Then 'picturebox 'u  panoya aktar
                ikonPic.Image = Clipboard.GetImage()
            End If
         
            SaveSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", openDLG.InitialDirectory)
        End If
    End Sub
End Class
 
 
PROGRAM İÇİNDEN KENDİ  İKONUNU DESKTOP POPUP MENÜYE EKLEME ÖRNEĞİ
 
 
 
qghqlu9t.png
 
he9yltww.png
 
 
cz5ujazn.png
 
#Region "  MASAÜSTÜ POPUP MENÜSÜNE KISAYOL EKLEME-SİLME İŞLEMLERİ "
 
    Private Sub MasaUstuMn_Click(sender As System.Object, e As System.EventArgs) Handles MasaUstuMn.Click
 
        If MasaUstuMn.Checked = True Then
            On Error Resume Next
            MasaUstuMn.Checked = False
            MasaUstuMn.Image = IconLst.Images("Bağlam_Menu_R.ico")
 
            Dim kayit As RegistryKey
            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(Application.ProductName) 'Sağ Click menüme programAdinı Oluşturdum.
 
            Dim icoYol As String = (Application.StartupPath & "\" & Application.ProductName & ".exe") '        'MessageBox.Show(icoYol)
 
            kayit.SetValue("Icon", icoYol)
 
            kayit.SetValue("Position", "Top") 'Programın menüdeki pozisyonunu belirledim. Top,center,bottom
            kayit.CreateSubKey("command").SetValue("", Application.StartupPath & "\" & Application.ProductName & ".exe")
 
        Else
            MasaUstuMn.Checked = True
            Call BaglamMenuSil()
            MasaUstuMn.Image = IconLst.Images("Bağlam_Menu_G.ico")
        End If
    End Sub
    Private Sub BaglamMenuSil()
 
        Try
            Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(Application.ProductName)
            kayit.DeleteSubKey("command") 'Önce alt menüyü siliiyor 
            'sonra
            '
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True)
            kayit.DeleteSubKey(Application.ProductName) 'Sonra bunu siliyor diğeri zaten önce silinmiş
 
            'MessageBox.Show("Masaüstü PopUp Menüsü Silindi")
 
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
            MessageBox.Show(ex.Message)
            Debug.WriteLine(ex.StackTrace)
        End Try
 
    End Sub
 
 
#End Region

 

İletiyi paylaş


Link to post
Sitelerde Paylaş
Misafir
Bu konu kapalıdır ama konuya cevap yazmaya yetkiniz var görünüyor.

×
×
  • Yeni Oluştur...