C# KOD ÖRNEKLERİ: Nisan 2013

15 Nisan 2013 Pazartesi

DOSYA İNDİRME PROJE KODLARI

DOSYA İNDİRME PROJE KODLARI İNDİR

Not : VB.Net İle uğraşmayıp programı indirmek isteyenler için Download.exe İNDİR

Imports System.Net
Imports Microsoft.Win32
'
Imports System.Runtime.InteropServices
Imports System.IO
'liste
Imports System.ComponentModel

Public Class frmMain
    Dim Yaz As IO.StreamWriter
    Dim Yükle As IO.StreamReader

Private Property Response As Object

#Region " LİSTE DEĞİŞKEN VE KİTAPLIKLAR"

Private Const WM_DRAWCLIPBOARD As Integer = &H308
    Private Const WM_CHANGECBCHAIN As Integer = &H30D
    Private mNextClipBoardViewerHWnd As IntPtr
    Private Event OnClipboardChanged()

<DllImport("user32")> _
    Private Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
    End Function

<DllImport("user32")> _
    Private Shared Function ChangeClipboardChain(ByVal hWnd As IntPtr, ByVal hWndNext As IntPtr) As _
    <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

<DllImport("user32")> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, _
    ByVal lParam As IntPtr) As IntPtr
    End Function

Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_DRAWCLIPBOARD
                RaiseEvent OnClipboardChanged()
                SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)

Case WM_CHANGECBCHAIN
                If m.WParam.Equals(mNextClipBoardViewerHWnd) Then
                    mNextClipBoardViewerHWnd = m.LParam
                Else
                    SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)
                End If
        End Select
        MyBase.WndProc(m)
    End Sub

#End Region

#Region "PANODAN ALMA.."

Private Sub ClipBoardChanged()
        If My.Computer.Clipboard.ContainsText Then
            If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then
                ListBox1.Items.Add(My.Computer.Clipboard.GetText)
                'If SplitContainer1.SplitterDistance = 37 Then
                '    SplitContainer1.SplitterDistance = 130
                'Else
                '    SplitContainer1.SplitterDistance = 37
                'End If

End If
        End If
    End Sub

#End Region

#Region " frmMain OLAYLARI"

Private Sub frmMain_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        ChangeClipboardChain(Me.Handle, mNextClipBoardViewerHWnd) 'pano olayı
        If ListBox1.Items.Count >= 1 Then
            LinkLstSakla.PerformClick()
        Else
            'Dosya SİLME
            My.Computer.FileSystem.DeleteFile(Application.StartupPath & "\LinkDeposu.txt", FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
        End If

SaveSetting(Application.ProductName, "Ayarlar", "üst", Me.Top)
        SaveSetting(Application.ProductName, "Ayarlar", "Sol", Me.Left)

End Sub

Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Top = GetSetting(Application.ProductName, "Ayarlar", "üst", 200)
        Me.Left = GetSetting(Application.ProductName, "Ayarlar", "Sol", 200)

UstteBtn.Checked = GetSetting(Application.ProductName, "Ayarlar", "Üstte Tut", False)

If UstteBtn.Checked = False Then
            UstteBtn.Image = ÖneAlPic.Image
            UstteBtn.Checked = True
            Me.TopMost = False
        Else

UstteBtn.Image = ArakayAlPic.Image
            UstteBtn.Checked = False
            Me.TopMost = True
        End If
        Me.Focus()
        Me.SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", "C:\Users\" & KullAdi & "\Downloads\")
        '
        Try
            KurulumuBaslat()

Dim Dsyveyol As String = Application.StartupPath & "\LinkDeposu.txt"
            Dim dosyaBoyut As IO.FileInfo
            dosyaBoyut = My.Computer.FileSystem.GetFileInfo(Dsyveyol)
            'MessageBox.Show("Dosya Boyut: " & dosyaBoyut.Length & " byte(s)")

'Dosya  yoksa veya içi boş ise
            If Not System.IO.File.Exists(Dsyveyol) Or dosyaBoyut.Length <= 0 Then GoTo pasgec
            Call ListeYükle()
            If ListBox1.Items.Count - 1 >= 0 Then ListBox1.SelectedIndex = 0
            'LinkListesiAcPic_Click(sender, e)  'Pano olayı
pasgec:

mNextClipBoardViewerHWnd = SetClipboardViewer(Me.Handle)
            AddHandler Me.OnClipboardChanged, AddressOf ClipBoardChanged
        Catch exc As Exception

MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub
#End Region

#Region "KURULUM OLAYLARI.."
    Sub KurulumuBaslat()

Try
            AddHandler Indirilen.DownloadProgressChanged, AddressOf IlerlemeBariGoster
            AddHandler Indirilen.DownloadFileCompleted, AddressOf IndirmeBitti
            AddHandler SystemEvents.TimerElapsed, AddressOf IndirGuncelle
        Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try
    End Sub

#End Region

#Region "İNDİRME İŞLEMLERİ..."

Sub IndirGuncelle(ByVal sender As Object, ByVal e As Microsoft.Win32.TimerElapsedEventArgs)

Try
            GecenSure = TimeSpan.FromTicks((Now.Ticks - BaslamaSuresi))
            lblGecenSure.Text = "Geçen Süre: " & String.Format("{0:00}:{1:00}:{2:00}", GecenSure.TotalHours, GecenSure.Minutes, GecenSure.Seconds)
            IndirmeHizi = (GecerliBayt - KalanBayt)
            lblHizKBayt.Text = "Hız: " & FormatNumber(IndirmeHizi / 1000, 2).ToString & " KB/s"
            lblHizKBit.Text = "Hız: " & FormatNumber((IndirmeHizi / 1000) * 8, 2).ToString & " Kb/s"
            KalanBayt = GecerliBayt

Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub

Sub Indir()

Try
            Indirilen.DownloadFileAsync(indirilenDsy, SaklamaAdresiTxt.Text)
            IndirmeyaBasla = True

btniptal.Enabled = True
            IndirmeyeBaslaBtn.Enabled = False
            IndirmeyaBasla = False
        Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub

Sub IndirmeBitti(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs)

Try
            If e.Cancelled Then
                lblDurum.Text = " İptal edildi"
                btnInenDsyAc.Enabled = False
                IndirmeyeBaslaBtn.BackColor = Color.Transparent
                IndirmeyeBaslaBtn.ForeColor = Color.Black
            Else
                lblDurum.Text = "Tamamlandı!"
                Beep()
                btnInenDsyAc.Enabled = True
                IndirmeyeBaslaBtn.BackColor = Color.Transparent
                IndirmeyeBaslaBtn.ForeColor = Color.Black
            End If

btniptal.Enabled = False
            IndirmeyeBaslaBtn.Enabled = True

If TimerID.ToInt32 > 0 Then
                SystemEvents.KillTimer(TimerID)
                TimerID = Nothing
                İlerlemeBarı.Visible = False
            End If

Catch exc As Exception
            MessageBox.Show(e.Error.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub

Sub IlerlemeBariGoster(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs)
        Try
            İlerlemeBarı.Value = e.ProgressPercentage
            lblilerlemeBarı.Text = "İlerleme: " & e.ProgressPercentage.ToString & "%"
            lblIndirilenBayt.Text = "İndirilen: " & FormatNumber(e.BytesReceived / 1000, 2).ToString & " KB"
            lblDosyaBoyutu.Text = "Dosya Boyutu: " & FormatNumber(e.TotalBytesToReceive / 1000, 2).ToString & " KB"
            GecerliBayt = e.BytesReceived

Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub

Private Sub IndirmeyeBaslaBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IndirmeyeBaslaBtn.Click
        Try
            İlerlemeBarı.Visible = True
            indirilenDsy = New Uri(IndirmeAdresiTxt.Text)
            İlerlemeBarı.MarqueeAnimationSpeed = 32
            TimerID = SystemEvents.CreateTimer((2000))
            Call Indir()
            BaslamaSuresi = Now.Ticks
            GecerliBayt = 0
            KalanBayt = 0
            IndirmeHizi = 0
            İlerlemeBarı.Value = 0
            lblDurum.ForeColor = System.Drawing.Color.FromName("Red")
            lblDurum.Text = "Başladı.."

Catch exc As Exception
            MessageBox.Show(exc.Message, "İndir Butonu!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try

End Sub

Private Sub btniptal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btniptal.Click
        Try
            If TimerID.ToInt32 > 0 Then
                SystemEvents.KillTimer(TimerID)
                TimerID = Nothing
                İlerlemeBarı.Visible = False
                IndirmeyeBaslaBtn.BackColor = Color.Transparent
                IndirmeyeBaslaBtn.ForeColor = Color.Black
                IndirmeyeBaslaBtn.Enabled = False
            End If
            Indirilen.CancelAsync()

Catch exc As Exception

MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Try

End Sub

Private Sub btnOpenDownload_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

Try
            If My.Computer.FileSystem.FileExists(SaklamaAdresiTxt.Text) Then
                Process.Start(SaklamaAdresiTxt.Text)
            Else
                MessageBox.Show("Saklama konumunda Dosya yok" & vbNewLine & _
                    vbNewLine & "Dosya indirildi ve başarıyla kaydedildi ", "  Dosya açamılmıyor", _
                        MessageBoxButtons.OK, MessageBoxIcon.Error)
            End If

Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try
    End Sub

#End Region

Public Sub DosyaVarMi()

Dim dosyaVarmi1 = My.Computer.FileSystem.FileExists(SaklamaAdresiTxt.Text)
        If dosyaVarmi1 = True Then
            Static i As Integer
            i = i.ToString + 1
            yDsy = dsy & "(" & i & ")" '& ".rar"
            SaklamaAdresiTxt.Text = "C:\Users\" & KullAdi & "\Downloads\" & yDsy
        End If
    End Sub

Private Sub HedefDznSec_Click(sender As System.Object, e As System.EventArgs) Handles HedefDznSec.Click

Dim KlasorYoluDlg As New FolderBrowserDialog
        KlasorYoluDlg.SelectedPath = "C:\Users\" & KullAdi & "\Downloads\"
        KlasorYoluDlg.SelectedPath = SaklamaAdresiTxt.Text
        If (KlasorYoluDlg.ShowDialog() = DialogResult.OK) Then
            Windows.Forms.Cursor.Current = Cursors.AppStarting
            SaklamaAdresiTxt.Text = KlasorYoluDlg.SelectedPath
            SaveSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text)

End If

End Sub

Private Sub PanoyaAlPic_Click(sender As System.Object, e As System.EventArgs)
        On Error Resume Next
        'panoya al
        Clipboard.SetText(IndirmeAdresiTxt.Text, TextDataFormat.Text)
    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)
        'burdan aşağısı sadece dosya adını bulur

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 PanodanYapistirPic_Click(sender As System.Object, e As System.EventArgs) Handles PanodanYapistirPic.Click
        ''panodan Texte Yapıştır
        IndirmeAdresiTxt.Text = Clipboard.GetText
        dsy = DosyaAdıBul(IndirmeAdresiTxt.Text)
        If dsy = "" Then Exit Sub

SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text) & "\"
        SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text & (dsy) ' & ".rar")

Call DosyaVarMi()

SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text
    End Sub

Private Sub SilPic_Click(sender As System.Object, e As System.EventArgs) Handles SilPic.Click

IndirmeAdresiTxt.Text = ""
        SaklamaAdresiTxt.Text = ""
        lblDurum.ForeColor = System.Drawing.Color.FromName("ControlText")
        IndirmeyeBaslaBtn.BackColor = Color.Transparent
        IndirmeyeBaslaBtn.ForeColor = Color.Black
        IndirmeyeBaslaBtn.Enabled = False
        Me.SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", "C:\Users\" & KullAdi & "\Downloads\")

End Sub

Private Sub IndirmeAdresiTxt_TextChanged(sender As System.Object, e As System.EventArgs) Handles IndirmeAdresiTxt.TextChanged

IndirmeyeBaslaBtn.Enabled = True
        IndirmeyeBaslaBtn.BackColor = Color.Red
        IndirmeyeBaslaBtn.ForeColor = Color.White
    End Sub

Private Sub Hkk_Click(sender As System.Object, e As System.EventArgs) Handles Hkk.Click
        HkkFrm.Top = Me.Top
        HkkFrm.Left = Me.Left + Me.Width - HkkFrm.Width
        HkkFrm.ShowDialog()
    End Sub

Private Sub btnInenDsyAc_Click(sender As System.Object, e As System.EventArgs) Handles btnInenDsyAc.Click

Catch exc As Exception
            MessageBox.Show(exc.Message, "  Bilgi!", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try
    End Sub

Private Sub HedefKlasörAç_Click(sender As System.Object, e As System.EventArgs) Handles HedefKlasörAç.Click

Try
            Dim openDLG As New OpenFileDialog
            openDLG.Title = "İndirilen Dosyalar"
            openDLG.InitialDirectory = "C:\Users\" & KullAdi & "\Downloads\" ' IndirmeAdresiTxt.Text

'KlasorYoluDlg.SelectedPath = "C:\Users\" & KullAdi & "\Downloads\"
            openDLG.Filter = "Tüm Dosyalar (*.*)|*.*"

If openDLG.ShowDialog = Windows.Forms.DialogResult.OK Then
                System.Diagnostics.Process.Start(openDLG.FileName)
            End If
        Catch exc As Exception
            MessageBox.Show(exc.Message, " Klasör Sorunu...")
        End Try
    End Sub

Private Sub LinkDsyAc_Click(sender As System.Object, e As System.EventArgs) Handles LinkDsyAc.Click
        Dim openDLG As New OpenFileDialog
        openDLG.InitialDirectory = Application.StartupPath
        openDLG.Filter = "Text Dosyası (*.txt|*.txt"
        If openDLG.ShowDialog = DialogResult.OK Then
            Call ListeYükle()
        End If

End Sub
    Public Sub ListeYükle()
        On Error GoTo hata
        Dim yol As String = Application.StartupPath
        Yükle = New IO.StreamReader(yol & "\LinkDeposu.txt")

While (Yükle.Peek() > -1)
            Me.ListBox1.Items.Add(Yükle.ReadLine)
        End While
        Yükle.Close()
        Exit Sub
hata:
        System.IO.File.Create(yol & "\LinkDeposu.txt")
        Return
    End Sub

Private Sub LinkLstSakla_Click(sender As System.Object, e As System.EventArgs) Handles LinkLstSakla.Click
        On Error Resume Next
        Dim yol As String = Application.StartupPath
        Dim i As Integer
        Yaz = New IO.StreamWriter(yol & "\LinkDeposu.txt")
        For i = 0 To Me.ListBox1.Items.Count - 1
            Yaz.WriteLine(Me.ListBox1.Items.Item(i))
        Next
        Yaz.Close()
    End Sub

Private Sub ListBox1_DoubleClick(sender As System.Object, e As System.EventArgs) Handles ListBox1.DoubleClick
        Me.IndirmeAdresiTxt.Text = ListBox1.Items(ListBox1.SelectedIndex)

'dsy = System.IO.Path.GetFileName(IndirmeAdresiTxt.Text)
        dsy = DosyaAdıBul(IndirmeAdresiTxt.Text)
        If dsy = "" Then Exit Sub
        SaklamaAdresiTxt.Text = GetSetting(Application.ProductName, "Ayarlar", "Hedef Dizini", Me.SaklamaAdresiTxt.Text) & "\"

'SaklamaAdresiTxt.Text = "C:\Users\" & KullAdi & "\Downloads\"
        SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text & (dsy & ".rar")
        'uzantı Rar mı exe mi bulsun
        Call DosyaVarMi()
        SaklamaAdresiTxt.Text = SaklamaAdresiTxt.Text

End Sub

Private Sub ListBox1_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles ListBox1.KeyDown
        On Error Resume Next
        If e.KeyCode = Keys.Delete Then
            Call SatirSil()
        End If

If e.KeyCode = Keys.Enter Then
            Call ListBox1_DoubleClick(sender, e)
        End If

If e.KeyCode = Keys.Escape Then
            Me.Close()
        End If

End Sub

Private Sub SatirSil()
        On Error Resume Next
        Dim secilecek, silinecek, LS As Integer
        If ListBox1.SelectedIndex <= ListBox1.Items.Count - 1 Then

silinecek = ListBox1.SelectedIndex
            secilecek = silinecek - 1
            Me.ListBox1.Items.RemoveAt(silinecek)
            Me.ListBox1.SelectedIndex = secilecek
            LS = LS - 1
        End If

If ListBox1.SelectedIndex = -1 And ListBox1.Items.Count - 1 >= 0 Then
            If silinecek = 0 Then
                Me.ListBox1.SetSelected(secilecek + 1, True)
                Exit Sub
            End If
        End If

End Sub

Private Sub SeciliSatiriSil_Click(sender As System.Object, e As System.EventArgs) Handles SeciliSatiriSil.Click
        Call SatirSil()
    End Sub

Private Sub TumListeyiSil_Click(sender As System.Object, e As System.EventArgs) Handles TumListeyiSil.Click
        Me.ListBox1.Items.Clear()
    End Sub

Private Sub UstteBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles UstteBtn.CheckedChanged
        If UstteBtn.Checked = False Then
            UstteBtn.Image = ArakayAlPic.Image
            Me.TopMost = False
        Else
            UstteBtn.Image = ÖneAlPic.Image
            Me.TopMost = True
        End If
        SaveSetting(Application.ProductName, "Ayarlar", "Üstte Tut", UstteBtn.Checked)
    End Sub

Private Sub UstteBtn_MouseLeave(sender As System.Object, e As System.EventArgs) Handles UstteBtn.MouseLeave
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(UstteBtn, "Formu Üstte Tut")
    End Sub

Private Sub HedefKlasörAç_MouseLeave(sender As System.Object, e As System.EventArgs) Handles HedefKlasörAç.MouseLeave
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(HedefKlasörAç, "Hedef Klasörü Aç")
    End Sub
End Class

Masa Üstü Menüye Program Eklemek

VB.Net ile ilgileniyorsanız....
Masa Üstü Menüye Program Ekleme Kodları İNDİR

Masa Üstünde Farenin sağ tuşuna tıklandığında çıkan PopUp Menüye Çok sık kullandığınız Programlarınızı eklemek istiyorsanız..
Sadece EXE programını .................................. İNDİR

Imports Microsoft.Win32
'Dosya Menüsüne Uygulama Ekleme örneği

Imports vb = Microsoft.VisualBasic
Imports System.IO
Public Class Form1

#Region " DEĞİŞKEN TANIMLAMALARI..."
    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
#End Region

#Region " FORM LOAD VE CLOSED..."
    Private Sub KapatPic_Click(sender As System.Object, e As System.EventArgs) Handles KapatPic.Click
        Me.Close()
    End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        '458; 338
        Me.Width = 458
        Me.Height = 339
        MnEkleBtn.BackColor = Color.Gray 'buton enabled=false
    End Sub
#End Region

#Region " FORM TAŞIMA..."
#Region " windows mesajı"
    Const TEST_ET As Integer = &H84
    Const YAKALA As Integer = &H1
    Const BASLIK As Integer = &H2
#End Region

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg
            Case TEST_ET
                MyBase.WndProc(m)
                If m.Result = YAKALA Then m.Result = BASLIK
            Case Else
                MyBase.WndProc(m)
        End Select
    End Sub
#End Region

#Region " MENÜYE EKLENECEK DOSYAYI SEÇMEK..."

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

MnEkleBtn.BackColor = SystemColors.ButtonFace
            programYolu = Trim(UyYoluTxt.Text)

If Not ikonYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri()

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 = programAdi
            UyVarsayılanAdıTxt.Text = programAdi

Dim result As Icon = Nothing
            result = Icon.ExtractAssociatedIcon(openDLG.FileName)
            Me.Icon = result
            Me.ikonPic.Image = Me.Icon.ToBitmap

If Clipboard.ContainsImage() Then 'picturebox 'u  panoya aktar
                ikonPic.Image = Clipboard.GetImage()
            End If
            ikonYoluTxt.Text = openDLG.FileName

If Not UyYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri()
            SaveSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", openDLG.InitialDirectory)
        End If

End Sub

#End Region

#Region " MENÜYÜ OLUŞTURMA DÜĞMESİNİ TIKLAMAK"

Private Sub MnEkleBtn_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 'picureboxu  panoya 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("[ " & programAdi & " ]" & " Menüye Eklendi")

Exit Sub

End Sub
#End Region

#Region " UYARI-BİLGİ MESAJLARI..."

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_MouseLeave(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.MouseLeave

Dim tooltip As New ToolTip()
        tooltip.SetToolTip(RegisterAcPic, "Kayıtlı yer : >> HKEY_CLASES_ROOT\DesktopBackground\Shell")
    End Sub

Private Sub MinimixePic_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles MinimizePic.MouseMove
        MinimizePic.Image = ImMinimize.Images("Mini_R-19x8.png")
    End Sub

Private Sub MinimixePic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles MinimizePic.MouseLeave
        MinimizePic.Image = ImMinimize.Images("Mini_gri-19x8.png")
    End Sub

Private Sub KapatPic_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles KapatPic.MouseMove
        KapatPic.Image = ImKapat.Images("kapat_R-23x23.png")
    End Sub

Private Sub KapatPic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles KapatPic.MouseLeave
        KapatPic.Image = ImKapat.Images("kapat_G-23x23.png")
    End Sub

#End Region

#Region " REGİSTER- KAYIT DEFTERİNİ AÇ..."
    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

#End Region

#Region " RADIOBUTONLARLA MENÜYE YERLEŞME YERİNİ SEÇMEK.."

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"
        RBUst.ForeColor = Color.Red
        RBOrta.ForeColor = Color.WhiteSmoke
        RBAlt.ForeColor = Color.WhiteSmoke
        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"
        RBOrta.ForeColor = Color.Red
        RBAlt.ForeColor = Color.WhiteSmoke
        RBUst.ForeColor = Color.WhiteSmoke
        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"
        RBAlt.ForeColor = Color.Red
        RBOrta.ForeColor = Color.WhiteSmoke
        RBUst.ForeColor = Color.WhiteSmoke
        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

#End Region

#Region " GİRİŞ BİLGİLERİNİ-TEXTLERİ SİLMEK.."

Private Sub GirişSilLbl_Click(sender As System.Object, e As System.EventArgs) Handles GirişSilLbl.Click

UyYoluTxt.Text = ""
        ikonYoluTxt.Text = ""
        ikonPic.Image = Nothing
        UyPozisyonuTxt.Text = ""
        UygulamaAdıTxt.Text = ""
        UyVarsayılanAdıTxt.Text = ""
        Grup1.Enabled = False
        MnEkleBtn.Enabled = False
        MnEkleBtn.BackColor = Color.Gray
    End Sub
#End Region

#Region " BAĞLAM MENÜSÜNÜ SİLMEK.."

Private Sub BaglamMenuSil()

Try
            Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"
            Dim SilinecekUygulama, UzantısızDsyAdi As New TextBox
            SilinecekUygulama.Text = System.IO.Path.GetFileName(UyYoluTxt.Text)
            Dim uz As Integer
            uz = (Len(SilinecekUygulama.Text))
            UzantısızDsyAdi.Text = Mid(SilinecekUygulama.Text, 1, uz - 4)
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(UzantısızDsyAdi.Text)
            kayit.DeleteSubKey("command") 'Önce alt menüyü siliiyor 
            'sonra
            '
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True)
            kayit.DeleteSubKey(UzantısızDsyAdi.Text) 'Sonra bunu siliyor diğeri zaten önce silinmiş
            MessageBox.Show("[ " & UzantısızDsyAdi.Text & " ]" & " Kaydı silindi.")

Catch ex As Exception
            Debug.WriteLine(ex.Message)
            MessageBox.Show(" Dosya Menüde Kayıtlı değil")
            Debug.WriteLine(ex.StackTrace)
        End Try

End Sub

Private Sub KayıtSilLbl_Click(sender As System.Object, e As System.EventArgs) Handles KayıtSilLbl.Click
        If MnEkleBtn.Enabled = False Then Exit Sub
        Call BaglamMenuSil()
    End Sub
#End Region

End Class

8 Nisan 2013 Pazartesi

UserControl örneği

USERCONTROL FORM ÖRNEĞİ İNDİR

User Control, programcının kendi ihtiyaçları doğrultusunda oluşturabileceği özelleştirilmiş kontrollerdir. Mesela bir Form, textbox vb.. Daha geniş açıklama ve örnek için Tıkla

Public Class Form1

Private Sub ToolStripButton1_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripButton1.Click
        Dim UserCntrl As New UserControl1
        Me.Controls.Add(UserCntrl)
        UserCntrl.BringToFront()

End Sub

Private Sub ToolStripButton2_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripButton2.Click
        Dim UserCntrl As New UserControl2
        Me.Controls.Add(UserCntrl)
        UserCntrl.BringToFront()
       
    End Sub

Private Sub ToolStripButton3_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripButton3.Click
        Dim UserCntrl As New UserControl1(" ERDOĞAN", "ASLAN", "EMEKLİ")
        Me.Controls.Add(UserCntrl)
        UserCntrl.BringToFront()
        UserCntrl.Label1.Text = "BİRİNCİ USER KONTROL PARAMETRELİ"
    End Sub

Private Sub ToolStripButton4_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripButton4.Click
        Dim UserCntrl As New UserControl3
        Me.Controls.Add(UserCntrl)
        UserCntrl.BringToFront()
    End Sub
    Private Sub ToolStripButton6_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripButton6.Click
        UsrFrmKapat.PerformClick()
    End Sub

Private Sub UsrFrmKapat_Click(sender As System.Object, e As System.EventArgs) Handles UsrFrmKapat.Click
        'HER İKİ KOD DA ÇALIŞIYOR

'Dim ctrl = (From c As Control In Me.Controls _
        '             Where TypeOf c Is UserControl1 _
        '             OrElse TypeOf c Is UserControl2 _
        '             OrElse TypeOf c Is UserControl3 Select c).ToList
        'For Each uc In ctrl
        '    uc.Dispose()
        'Next
        'Kontrol sayısı çok ise FOR -NEXT döngüsü da kolay ve mantıklı
        For i = Me.Controls.Count - 1 To 0 Step -1
            Dim cntrl As Control = Me.Controls(i)
            If (TypeOf cntrl Is UserControl) Then
                cntrl.Dispose()
            End If
        Next
       
       End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Static sy As Integer = 0
        sy = sy + 1
        Dim s As String = "ABCÇDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
        Dim r As New Random
        Dim sb As New System.Text.StringBuilder
        For i As Integer = 1 To 20
            Dim idx As Integer = r.Next(0, 35)
            sb.Append(s.Substring(idx, 1))
        Next
        Label3.Text = sy.ToString
        TextBox1.Text += sb.ToString & vbCrLf
    End Sub

End Class

Public Class UserControl1

Private Sub UserControl1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.BackColor = Color.NavajoWhite
    End Sub

Public Sub New()
        InitializeComponent() 'bileşeni(component) başlat(initialize)
        Me.Dock = DockStyle.Fill

End Sub

Public Sub New(ByVal ad As String, ByVal soyad As String, ByVal meslek As String)
        InitializeComponent()
        TextBox1.Text = "ERDOĞAN"
        TextBox2.Text = "ASLAN"
        TextBox3.Text = "EMEKLİ"
        Me.Dock = DockStyle.Fill

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.Dispose()
    End Sub
End Class
Public Class UserControl2

Private Sub UserControl2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.BackColor = Color.Bisque
    End Sub
    Public Sub New()
        'Bu çağrı Windows Form Designer tarafından gereklidir.
        InitializeComponent()
        Me.Dock = DockStyle.Fill
        'Initializecomponent () çağrısından sonra herhangi bir başlatma ekleyin.
    End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.Dispose()
    End Sub
End Class
Public Class UserControl3
    Public Sub New()
        InitializeComponent()
        Me.Dock = DockStyle.Fill
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click, MyBase.Click
        Me.Dispose()
     
    End Sub
End Class

Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.ComponentModel
Imports Microsoft.VisualBasic

Namespace UserControls

Public Class BilgiUserKontrol
        Inherits System.Windows.Forms.UserControl

' Create the controls.
        Private errorProvider1 As System.Windows.Forms.ErrorProvider
        Private AdıTtxt As System.Windows.Forms.TextBox
        Private AdresTxt As System.Windows.Forms.TextBox
        Private ŞehirTxt As System.Windows.Forms.TextBox
        Private iliTxt As System.Windows.Forms.TextBox
        Private PostaKoduTxt As System.Windows.Forms.TextBox
        Private ÜlkeTxt As System.Windows.Forms.TextBox
        Private WithEvents EpostaTxt As System.Windows.Forms.TextBox
        Private AdıLbl As System.Windows.Forms.Label
        Private AdresLbl As System.Windows.Forms.Label
        Private İliLbl As System.Windows.Forms.Label
        Private ÜlkeLbl As System.Windows.Forms.Label
        Private EpostaLbl As System.Windows.Forms.Label
        Private components As System.ComponentModel.IContainer
        Private _p1 As String
        Private _p2 As String
        Private _p3 As String

' Define the constructor.
        Public Sub New()
            InitializeComponent()
            Me.Dock = DockStyle.Fill

End Sub

Sub New(p1 As String, p2 As String, p3 As String)
            ' TODO: Complete member initialization 
            _p1 = p1
            _p2 = p2
            _p3 = p3
        End Sub

' Initialize the control elements.
        Public Sub InitializeComponent()
            Me.components = New System.ComponentModel.Container()
            Me.errorProvider1 = New System.Windows.Forms.ErrorProvider(Me.components)
            Me.AdıTtxt = New System.Windows.Forms.TextBox()
            Me.AdresTxt = New System.Windows.Forms.TextBox()
            Me.ŞehirTxt = New System.Windows.Forms.TextBox()
            Me.iliTxt = New System.Windows.Forms.TextBox()
            Me.PostaKoduTxt = New System.Windows.Forms.TextBox()
            Me.ÜlkeTxt = New System.Windows.Forms.TextBox()
            Me.EpostaTxt = New System.Windows.Forms.TextBox()
            Me.AdıLbl = New System.Windows.Forms.Label()
            Me.AdresLbl = New System.Windows.Forms.Label()
            Me.İliLbl = New System.Windows.Forms.Label()
            Me.ÜlkeLbl = New System.Windows.Forms.Label()
            Me.EpostaLbl = New System.Windows.Forms.Label()
            Me.Button1 = New System.Windows.Forms.Button()
            CType(Me.errorProvider1, System.ComponentModel.ISupportInitialize).BeginInit()
            Me.SuspendLayout()
            '
            'errorProvider1
            '
            Me.errorProvider1.ContainerControl = Me
            '
            'AdıTtxt
            '
            Me.AdıTtxt.Location = New System.Drawing.Point(83, 11)
            Me.AdıTtxt.Name = "AdıTtxt"
            Me.AdıTtxt.Size = New System.Drawing.Size(232, 20)
            Me.AdıTtxt.TabIndex = 0
            '
            'AdresTxt
            '
            Me.AdresTxt.Location = New System.Drawing.Point(83, 35)
            Me.AdresTxt.Name = "AdresTxt"
            Me.AdresTxt.Size = New System.Drawing.Size(232, 20)
            Me.AdresTxt.TabIndex = 1
            '
            'ŞehirTxt
            '
            Me.ŞehirTxt.Location = New System.Drawing.Point(83, 59)
            Me.ŞehirTxt.Name = "ŞehirTxt"
            Me.ŞehirTxt.Size = New System.Drawing.Size(96, 20)
            Me.ŞehirTxt.TabIndex = 2
            '
            'iliTxt
            '
            Me.iliTxt.Location = New System.Drawing.Point(179, 59)
            Me.iliTxt.Name = "iliTxt"
            Me.iliTxt.Size = New System.Drawing.Size(56, 20)
            Me.iliTxt.TabIndex = 3
            '
            'PostaKoduTxt
            '
            Me.PostaKoduTxt.Location = New System.Drawing.Point(235, 59)
            Me.PostaKoduTxt.Name = "PostaKoduTxt"
            Me.PostaKoduTxt.Size = New System.Drawing.Size(80, 20)
            Me.PostaKoduTxt.TabIndex = 4
            '
            'ÜlkeTxt
            '
            Me.ÜlkeTxt.Location = New System.Drawing.Point(83, 83)
            Me.ÜlkeTxt.Name = "ÜlkeTxt"
            Me.ÜlkeTxt.Size = New System.Drawing.Size(232, 20)
            Me.ÜlkeTxt.TabIndex = 5
            '
            'EpostaTxt
            '
            Me.EpostaTxt.Location = New System.Drawing.Point(83, 107)
            Me.EpostaTxt.Name = "EpostaTxt"
            Me.EpostaTxt.Size = New System.Drawing.Size(232, 20)
            Me.EpostaTxt.TabIndex = 6
            '
            'AdıLbl
            '
            Me.AdıLbl.Location = New System.Drawing.Point(8, 8)
            Me.AdıLbl.Name = "AdıLbl"
            Me.AdıLbl.Size = New System.Drawing.Size(78, 23)
            Me.AdıLbl.TabIndex = 0
            Me.AdıLbl.Text = "Adı:"
            Me.AdıLbl.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
            '
            'AdresLbl
            '
            Me.AdresLbl.Location = New System.Drawing.Point(8, 32)
            Me.AdresLbl.Name = "AdresLbl"
            Me.AdresLbl.Size = New System.Drawing.Size(78, 23)
            Me.AdresLbl.TabIndex = 1
            Me.AdresLbl.Text = "Adres"
            Me.AdresLbl.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
            '
            'İliLbl
            '
            Me.İliLbl.Location = New System.Drawing.Point(8, 56)
            Me.İliLbl.Name = "İliLbl"
            Me.İliLbl.Size = New System.Drawing.Size(78, 23)
            Me.İliLbl.TabIndex = 2
            Me.İliLbl.Text = "İL / İlçe / Kod"
            Me.İliLbl.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
            '
            'ÜlkeLbl
            '
            Me.ÜlkeLbl.Location = New System.Drawing.Point(8, 80)
            Me.ÜlkeLbl.Name = "ÜlkeLbl"
            Me.ÜlkeLbl.Size = New System.Drawing.Size(78, 23)
            Me.ÜlkeLbl.TabIndex = 3
            Me.ÜlkeLbl.Text = "Ülke / Bölge:"
            Me.ÜlkeLbl.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
            '
            'EpostaLbl
            '
            Me.EpostaLbl.Location = New System.Drawing.Point(8, 104)
            Me.EpostaLbl.Name = "EpostaLbl"
            Me.EpostaLbl.Size = New System.Drawing.Size(78, 23)
            Me.EpostaLbl.TabIndex = 4
            Me.EpostaLbl.Text = "EPosta :"
            Me.EpostaLbl.TextAlign = System.Drawing.ContentAlignment.MiddleLeft
            '
            'Button1
            '
            Me.Button1.Location = New System.Drawing.Point(240, 133)
            Me.Button1.Name = "Button1"
            Me.Button1.Size = New System.Drawing.Size(75, 23)
            Me.Button1.TabIndex = 7
            Me.Button1.Text = "Kapat"
            Me.Button1.UseVisualStyleBackColor = True
            '
            'BilgiUserKontrol
            '
            Me.Controls.Add(Me.Button1)
            Me.Controls.Add(Me.AdıLbl)
            Me.Controls.Add(Me.AdresLbl)
            Me.Controls.Add(Me.İliLbl)
            Me.Controls.Add(Me.ÜlkeLbl)
            Me.Controls.Add(Me.EpostaLbl)
            Me.Controls.Add(Me.AdıTtxt)
            Me.Controls.Add(Me.AdresTxt)
            Me.Controls.Add(Me.ŞehirTxt)
            Me.Controls.Add(Me.iliTxt)
            Me.Controls.Add(Me.PostaKoduTxt)
            Me.Controls.Add(Me.ÜlkeTxt)
            Me.Controls.Add(Me.EpostaTxt)
            Me.Name = "BilgiUserKontrol"
            Me.Size = New System.Drawing.Size(339, 167)
            CType(Me.errorProvider1, System.ComponentModel.ISupportInitialize).EndInit()
            Me.ResumeLayout(False)
            Me.PerformLayout()

End Sub

Private Sub MyValidatingCode()
            'Kontrolde metin yok onaylayın.
            If EpostaTxt.Text.Length = 0 Then
                Throw New Exception("E-posta adresi gerekli bir alandır")
            Else
                'Bir "." ve e-posta adresini bir "@"  olduğunu doğrulayın
                If EpostaTxt.Text.IndexOf(".") = -1 Or EpostaTxt.Text.IndexOf("@") = -1 Then
                    Throw New Exception("E-posta adresi geçerli bir e-posta adresi biçimi olmalıdır." + _
                      Microsoft.VisualBasic.ControlChars.Cr + "Örneğin 'eraslancemil@gmail.com gibi'")
                End If
            End If
        End Sub
        'TextEmail içine kullanıcı tarafından veri girişi onaylayın.
        Private Sub textEmail_Validating(sender As Object, _
                                         e As System.ComponentModel.CancelEventArgs) Handles EpostaTxt.Validating
            Try
                MyValidatingCode()

Catch ex As Exception
                'kullanıcı tarafından düzeltilmesi için metni seçer ve Olayı iptal eder.
                e.Cancel = True
                EpostaTxt.Select(0, EpostaTxt.Text.Length)

'Görüntülemek için metin ile ErrorProvider hata ayarlayın.
                Me.errorProvider1.SetError(EpostaTxt, ex.Message)
            End Try
        End Sub
        Public Sub New(ByVal ad As String, ByVal soyad As String, ByVal meslek As String, ByVal priviance As String _
                       , ByVal kod As String, ByVal ülke As String, ByVal eposta As String)
            InitializeComponent()
            'Parametreli User text formu
            AdıTtxt.Text = "ERDOĞAN"
            AdresTxt.Text = "ASLAN"
            ŞehirTxt.Text = "BORNOVA"
            iliTxt.Text = "İZMİR"
            PostaKoduTxt.Text = "35030"
            ÜlkeTxt.Text = "TÜRKİYE"
            EpostaTxt.Text = "eraslancemil@gmail.com"
            Me.Dock = DockStyle.Fill

End Sub

Private Sub textEmail_Validated(sender As Object, e As System.EventArgs) Handles EpostaTxt.Validated
            ' Tüm koşullar yerine getirilmiş ise, hataları temizleyin.
            errorProvider1.SetError(EpostaTxt, "")
        End Sub
        Friend WithEvents Button1 As System.Windows.Forms.Button

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
            Me.Dispose()
        End Sub
    End Class
End Namespace

7 Nisan 2013 Pazar

UZANTI İKONLARINI BULUP GÖSTERME

UZANTI (.doc,.zip,.rar vb.) İKONLARINI BULUP GÖSTERME KOD İNDİR

Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Imports uygulama.Form1.Form1

Public Class Form1
    Public DsyTipi As String
    Public HataVar As Boolean = False

#Region "   FORM1 İÇİNDEKİ (PUBLIC CLASS FORM1) YAPISI.."

'yeni açtığımız formun içine yeniden bir'(Public Class Form1) Açıyoruz.
    'Ikonu göstermek için  Private IconBilgisi As Hashtable ve  Private GecerliBoyut As ImageSize tanımlaması yapılır
    ' (Public Property CurrentImageSize() As ImageSize),(Public Enum ImageSize),(Public Property CurrentImageSize() As ImageSize)
    ' (Private Function IkonGosterPic() As Object) Oluşturulur.
    'Bu Formda 3 öğe bulunur 1-(public Class) 2-(Public Structure EmbeddedIconInfo) 3-(Public Class RegisteredFileType)
    Public Class Form1
        Private IconBilgisi As Hashtable
        Private GecerliBoyut As ImageSize

Public Property CurrentImageSize() As ImageSize
            Get
                Return GecerliBoyut
            End Get
            Set(ByVal value As ImageSize)
                Me.GecerliBoyut = value
            End Set
        End Property

Public Enum ImageSize
            ''' <summary>
            ''' View image in 16x16 px.
            ''' </summary>
            Small

''' <summary>
            ''' View image in 32x32 px.
            ''' </summary>
            Large
        End Enum

Private Function IkonGosterPic() As Object
            'IkonGosterPic', 'çeviri.Form1.Form1' üyesi değil. hatasını önler
            Throw New NotImplementedException
        End Function

End Class

Public Structure EmbeddedIconInfo
        'Structure=yapı
        Public FileName As String
        Public IconIndex As Integer
    End Structure

Public Class RegisteredFileType
        <DllImport("shell32.dll", EntryPoint:="ExtractIconA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Shared Function ExtractIcon(ByVal hInst As Integer, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As IntPtr
        End Function
        <DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
        Shared Function ExtractIconEx(ByVal szFileName As String, ByVal nIconIndex As Integer, ByVal phiconLarge() As IntPtr, ByVal phiconSmall() As IntPtr, ByVal nIcons As Integer) As Integer
        End Function
        <DllImport("user32.dll", EntryPoint:="DestroyIcon", SetLastError:=True)> _
        Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Integer
        End Function

Public Shared Function DosyaTipindenIconAl() As Hashtable
            Try
                'HKEY_CLASSES_ROOT kayıt defteri bölümü temsil etmek için bir kayıt defteri anahtarı nesne oluşturma
                Dim rkRoot As RegistryKey = Registry.ClassesRoot

'Tüm alt anahtarlar isimlerini alır.
                Dim keyNames As String() = rkRoot.GetSubKeyNames()
                Dim IconBilgisi As New Hashtable()

'Dosya Ikonunu bul
                For Each keyName As String In keyNames
                    If [String].IsNullOrEmpty(keyName) Then
                        Continue For
                    End If
                    Dim indexOfPoint As Integer = keyName.IndexOf(".")

'Bu anahtarı bir dosya (Extension) uzantısı,  örneğin(.Zip; .bmp; .jpg) değilse, atlayın.
                    If indexOfPoint <> 0 Then
                        Continue For
                    End If

Dim rkFileType As RegistryKey = rkRoot.OpenSubKey(keyName)
                    If rkFileType Is Nothing Then
                        Continue For
                    End If

'Dosya türü bilgileri içeren bu anahtarın varsayılan değeri alır.
                    Dim defaultValue As Object = rkFileType.GetValue("")
                    If defaultValue Is Nothing Then
                        Continue For
                    End If

'Bu dosya türü ile varsayılan simge ortakları belirten anahtarına gidin.
                    Dim defaultIcon As String = defaultValue.ToString() + "\DefaultIcon"
                    Dim rkFileIcon As RegistryKey = rkRoot.OpenSubKey(defaultIcon)
                    If rkFileIcon IsNot Nothing Then
                        'Dosya simgesi ve bu dosyada simge dizini içereni alın.
                        Dim value As Object = rkFileIcon.GetValue("")
                        If value IsNot Nothing Then
                            'Hatayı önlemek için dizede tüm gereksiz "  işareti temizleyin.
                            Dim fileParam As String = value.ToString().Replace("""", "")
                            IconBilgisi.Add(keyName, fileParam)
                        End If
                        rkFileIcon.Close()
                    End If
                    rkFileType.Close()
                Next
                rkRoot.Close()
                Return IconBilgisi
            Catch exc As Exception
                Throw exc
            End Try
        End Function

Public Shared Function DosyadanSimgeAl(ByVal DosyaVeIcon As String) As Icon
            Try
                Dim embeddedIcon As EmbeddedIconInfo = GomuluSimgeBilgisiAl(DosyaVeIcon)

' tanıtıcı Simgesini alır.
                Dim lIcon As IntPtr = ExtractIcon(0, embeddedIcon.FileName, embeddedIcon.IconIndex)

'Gerçek simgeyi alır.
                Return Icon.FromHandle(lIcon)
            Catch exc As Exception
                Throw exc
            End Try
        End Function

Public Shared Function DosyadanSimgeAl(ByVal DosyaVeIcon As String, ByVal Buyukse As Boolean) As Icon
            Dim SimgeSayisiniBul As UInteger = 0
            Dim YapayH As IntPtr() = New IntPtr(0) {IntPtr.Zero}
            Dim UzantiIconuH As IntPtr() = New IntPtr(0) {IntPtr.Zero}

Try
                Dim embeddedIcon As EmbeddedIconInfo = GomuluSimgeBilgisiAl(DosyaVeIcon)

If Buyukse Then
                    SimgeSayisiniBul = ExtractIconEx(embeddedIcon.FileName, 0, UzantiIconuH, YapayH, 1)
                Else
                    SimgeSayisiniBul = ExtractIconEx(embeddedIcon.FileName, 0, YapayH, UzantiIconuH, 1)
                End If

If SimgeSayisiniBul > 0 AndAlso UzantiIconuH(0) <> IntPtr.Zero Then
                    'Ilk simgeyi al.
                    Dim extractedIcon As Icon = DirectCast(Icon.FromHandle(UzantiIconuH(0)).Clone(), Icon)

Return extractedIcon
                Else
                    ' alınacak Simge yok
                    Return Nothing
                End If
            Catch exc As Exception
                'Simge hatası ayıklayın.
                Throw New ApplicationException("Simgesi ayıklamak olamazdı", exc)
            Finally
                'Çıkış kaynakları.
                For Each ptr As IntPtr In UzantiIconuH
                    If ptr <> IntPtr.Zero Then
                        DestroyIcon(ptr)
                    End If
                Next

For Each ptr As IntPtr In YapayH
                    If ptr <> IntPtr.Zero Then
                        DestroyIcon(ptr)
                    End If
                Next
            End Try

End Function

Protected Shared Function GomuluSimgeBilgisiAl(ByVal DosyaVeIcon As String) As EmbeddedIconInfo
            Dim embeddedIcon As New EmbeddedIconInfo()
            If [String].IsNullOrEmpty(DosyaVeIcon) Then
                Return embeddedIcon
            End If

'Use to store the file contains icon.
            Dim fileName As String = [String].Empty

'The index of the icon in the file.
            Dim iconIndex As Integer = 0
            Dim iconIndexString As String = [String].Empty

Dim commaIndex As Integer = DosyaVeIcon.IndexOf(",")
            'if DosyaVeIcon is some thing likes that: "C:\\Program Files\\NetMeeting\\conf.exe,1".
            If commaIndex > 0 Then
                fileName = DosyaVeIcon.Substring(0, commaIndex)
                iconIndexString = DosyaVeIcon.Substring(commaIndex + 1)
            Else
                fileName = DosyaVeIcon
            End If

If Not [String].IsNullOrEmpty(iconIndexString) Then
                'Get the index of icon.
                iconIndex = Integer.Parse(iconIndexString)
                If iconIndex < 0 Then
                    iconIndex = 0
                    'To avoid the invalid index.
                End If
            End If

embeddedIcon.FileName = fileName
            embeddedIcon.IconIndex = iconIndex

Return embeddedIcon
        End Function

Shared Function DosyadanSimgeAl(icon As Drawing.Icon, Buyukse As Boolean) As Drawing.Icon
            Throw New NotImplementedException
        End Function

End Class

#End Region

#Region "   FORM1 OLAYLARI.."
    Private Property GecerliBoyut As ImageSize
    Private Property IconBilgisi As Hashtable

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Try
            'Gets file type and icon info.
            Me.IconBilgisi = RegisteredFileType.DosyaTipindenIconAl()
            Me.GecerliBoyut = ImageSize.Large

'Loads file types to ListBox.
            For Each objString As Object In Me.IconBilgisi.Keys
                Me.TipListesi.Items.Add(objString)
            Next

Catch exc As Exception
            MessageBox.Show(exc.Message)
        End Try

End Sub

#Region "    RADIOBUTTON SECİM OLAYLARI.."

Private Sub BykRdioBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles BykRdioBtn.CheckedChanged

Try

If Me.TipListesi.Items.Count <= 0 OrElse Me.TipListesi.SelectedItem Is Nothing Then
                Return
            End If

Me.GecerliBoyut = ImageSize.Large
            Call UzantiVeIConuBulGoster()

Catch exc As Exception
            MessageBox.Show(exc.Message)
        End Try

End Sub

Private Sub BykRdioBtn_RightToLeftChanged(sender As System.Object, e As System.EventArgs) Handles BykRdioBtn.RightToLeftChanged
        If Me.BykRdioBtn.Checked Then
            Me.GecerliBoyut = ImageSize.Large
            'Me.Cevir()
            Beep()
            Call UzantiVeIConuBulGoster()
        End If
    End Sub

Private Sub KckRdioBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles KckRdioBtn.CheckedChanged
        If Me.KckRdioBtn.Checked Then
            Me.GecerliBoyut = ImageSize.Small
            'Me.Cevir()
            Call UzantiVeIConuBulGoster()
        End If
    End Sub
#End Region

#Region "     ARAMA BUTONU OLAYLARI.."

Private Sub AramaBtn_Click(sender As System.Object, e As System.EventArgs) Handles AramaBtn.Click
        If String.IsNullOrEmpty(Me.ArananTxt.Text.Trim()) Then
            Return
        End If
        Dim ArananAd As String = [String].Empty
        If Not Me.ArananTxt.Text.Contains(".") Then
            ArananAd = "." + Me.ArananTxt.Text
        Else
            'Aranan metin yoksa 'bir nokta ekleyin.
            ArananAd = Me.ArananTxt.Text
        End If

'Dosya türleri ve simgelerini koleksiyonlarında arar.
        Dim objAdi As Object = Me.IconBilgisi(ArananAd)
        If objAdi IsNot Nothing Then
            Me.TipListesi.SelectedItem = ArananAd
        End If

End Sub
#End Region

#Region "     TİP LİSTE OLAYLARI.."

Private Sub TipListesi_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles TipListesi.SelectedIndexChanged

ArananTxt.Text = TipListesi.Items(TipListesi.SelectedIndex)

Call UzantiVeIConuBulGoster()

If HataVar = True Then
            Timer1.Interval = 50
            Timer1.Start()
            Lbl_HataMsj.Text = "(" & ArananTxt.Text & ")" & " Ikonu Oluşturamadı"
            IkonGosterPic.Image = Nothing
        Else
            Lbl_HataMsj.Visible = False
            Lbl_HataMsj.Text = ""
        End If

End Sub

#End Region

Private Sub ArananTxt_TextChanged(sender As System.Object, e As System.EventArgs) Handles ArananTxt.TextChanged
        If String.IsNullOrEmpty(Me.ArananTxt.Text.Trim()) Then
            Me.AramaBtn.Enabled = False
        Else
            Me.AramaBtn.Enabled = True
        End If
    End Sub

Public Sub UzantiVeIConuBulGoster()
        'Dim DsyTipi As String = Me.TipListesi.SelectedItem.ToString()

Try
            Dim DosyaVeIcon As String = (Me.IconBilgisi(ArananTxt.Text)).ToString()

If [String].IsNullOrEmpty(DosyaVeIcon) Then
                Return
            End If

Dim icon As Icon = Nothing

Dim Buyukse As Boolean = True

If GecerliBoyut = ImageSize.Small Then
                Buyukse = False
            End If

icon = RegisteredFileType.DosyadanSimgeAl(DosyaVeIcon, Buyukse)

'RegisteredFileType.DosyadanSimgeAl (DosyaVeIcon);
            'Simge sıfır olamaz.

If icon IsNot Nothing Then
                'Resim kutusu simgesi çizin.
                Me.IkonGosterPic.Image = icon.ToBitmap()
            Else
                'simgesi geçersiz ise   bir hata resimi göster
                Me.IkonGosterPic.Image = Me.IkonGosterPic.ErrorImage
            End If
        Catch exc As Exception
            HataVar = True
            'mesajı labelde bir timer ile belli bir süre vermek daha kullanışlı olur. hata değişkeni ona yarayacak
            'MessageBox.Show(exc.Message & vbCrLf & "(" & ArananTxt.Text & ")" & " Ikonu Oluşturamadı")
        End Try
    End Sub

Private Sub IkonGoster(DsyTipi As String)
        Try
            Throw New NotImplementedException

Catch ex As Exception

End Try
    End Sub

Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick

Lbl_HataMsj.Visible = True
        Timer1.Interval = Timer1.Interval - 1
        If Timer1.Interval = 1 Then Lbl_HataMsj.Visible = False : HataVar = False : Timer1.Stop()
    End Sub

#End Region

End Class

6 Nisan 2013 Cumartesi

SÜRÜCÜ İKONUNU DEĞİŞTİRMEK

SÜRÜCÜ İKONUNU DEĞİŞTİRME KOD veya EXE indir

Public Class Form1
   Public Class Form1
    Public Frm2_Kapalı As Boolean = False

#Region " windows mesajı ve  Form Taşı"

Const TEST_ET As Integer = &H84
    Const YAKALA As Integer = &H1
    Const BASLIK As Integer = &H2
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg
            Case TEST_ET
                MyBase.WndProc(m)
                If m.Result = YAKALA Then m.Result = BASLIK
            Case Else
                MyBase.WndProc(m)
        End Select
    End Sub
#End Region

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If TextBox1.Text = "" Then
            Beep()
            Label4.Text = ""
            Label4.Text = "Bir simge seçiniz."
            Timer1.Interval = 75
            Timer1.Start()
            Exit Sub
        End If
        If ComboBox1.SelectedItem = "" Then
            Beep()
            Timer1.Interval = 75
            Timer1.Start()
            Label4.Text = "Bir sürücü harfi seçiniz."
            Exit Sub
        Else
            My.Computer.Registry.CurrentUser.CreateSubKey("Software\\Classes\\Applications\\Explorer.exe\\Drives" & "\\" & ComboBox1.SelectedItem & "\\" & "DefaultIcon")
            My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Classes\Applications\Explorer.exe\Drives\" & ComboBox1.SelectedItem & "\" & "DefaultIcon", "", TextBox1.Text, Microsoft.Win32.RegistryValueKind.String)
            Beep()
            Label4.Text = "Simge başarıyla değiştirildi!"
            Timer1.Interval = 75
            Timer1.Start()
            Button1.Enabled = True
        End If
    End Sub

Private Sub PictureBox2_Click(sender As System.Object, e As System.EventArgs) Handles DsyAçPic.Click
        OpenFileDialog1.ShowDialog()
        TextBox1.Text = OpenFileDialog1.FileName
    End Sub

Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Label4.Visible = True
        Timer1.Interval = Timer1.Interval - 1
        If Timer1.Interval = 1 Then Label4.Visible = False : Timer1.Stop()
    End Sub

Private Sub Form1_Move(sender As System.Object, e As System.EventArgs) Handles MyBase.Move
        If Frm2_Kapalı = False Then Exit Sub
        Form2.Top = Me.Top + 23
        Form2.Left = Me.Left + Me.Width
        Form2.Show()
    End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Frm2_Kapalı = False
        NotifyIcon1.Visible = True
    End Sub

Private Sub KapatPic_Click(sender As System.Object, e As System.EventArgs) Handles KapatPic.Click
        Me.Close()
    End Sub

Private Sub KapatPic_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles KapatPic.MouseMove
        KapatPic.Image = ImKapat.Images("kapat_R-23x23.png")
    End Sub

Private Sub KapatPic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles KapatPic.MouseLeave
        KapatPic.Image = ImKapat.Images("kapat_G-23x23.png")
    End Sub

Private Sub YardımLbl_Click(sender As System.Object, e As System.EventArgs) Handles YardımLbl.Click
        If Frm2_Kapalı = True Then
            Frm2_Kapalı = False
            Form2.Close()
        Else
            Frm2_Kapalı = True 'Gösteriliyor
            Form2.Show()
        End If
    End Sub

Private Sub YardımLbl_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles YardımLbl.MouseMove
        YardımLbl.ForeColor = Color.Lime
    End Sub

Private Sub YardımLbl_MouseLeave(sender As System.Object, e As System.EventArgs) Handles YardımLbl.MouseLeave
        YardımLbl.ForeColor = Color.White
    End Sub

Private Sub MinimizePic_Click(sender As System.Object, e As System.EventArgs)

End Sub

Private Sub NotifyIcon1_MouseClick(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseClick
  
        If Me.Visible Then
            Me.Hide()
            If Frm2_Kapalı = True Then Form2.Close()
        Else
            Me.Show()
            Me.WindowState = FormWindowState.Normal
            Me.StartPosition = FormStartPosition.CenterScreen
        End If
    End Sub

Private Sub Form1_Resize(sender As System.Object, e As System.EventArgs) Handles MyBase.Resize
        If Me.WindowState = FormWindowState.Minimized Then
            Me.Visible = False
            Exit Sub
        End If

End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        System.Diagnostics.Process.Start("Explorer", "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")

End Sub
    Private Sub Button1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseMove
        Label4.Visible = True
        Label4.Text = "İkonu değişecek Klasörü Aç"
    End Sub

Private Sub Button1_MouseLeave(sender As System.Object, e As System.EventArgs) Handles Button1.MouseLeave
        Label4.Visible = False
        Label4.Text = ""
    End Sub
End Class

fORM2