Otomatik ve Manuel olarak Listeden Duvar Kağıdı Eklemek desktop Duvar Kağıdı Değiştirme. ekleme Otomatik Duvar kağıdı değiştirme kodları. vb.net. er_as WellPaper Otomatik ve Manuel olarak Listeden Duvar Kağıdı Ekleme KODU İNDİR Listeden Duvar Kağıdı Ekleme EXE_v2.0.09.2015 İNDİRAnaform :#Region " IMPORT.. " Imports System.Media Imports Microsoft.Win32 Imports System.IO #End Region Public Class Anafrm #Region " DEĞİŞKENLER.." Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer Private Const SETDESKWALLPAPER As Integer = &H14 Private Const UPDATEINIFILE = &H1 Private SabitDeskPaper As String Private S_OtoSure As String Private dakika As Integer Private Yaz As IO.StreamWriter Private Oku As IO.StreamReader #End Region #Region " FORM OLAYLARI.." Public Sub AyarSakla() SaveSetting(Application.ProductName, ProductName, "SabitDeskPaper", SabitDeskPaper) If ListBox1.SelectedIndex = -1 Or SecilenSatirTS.Text = -1 Then ListBox1.SelectedIndex = -1 SaveSetting(Application.ProductName, ProductName, "Seçilen Satır", ListBox1.SelectedIndex) SaveSetting(Application.ProductName, ProductName, "Seçilen Oto Süre", S_OtoSure) End Sub Private Sub Anafrm_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed End End Sub Private Sub Anafrm_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown 'formun Load bölümünde veya özelliklerinde (Keypreview = TRUE) yapılmalıdır 'ESC ile kapat If e.KeyCode = Keys.Escape Then Call AyarSakla() NotifyIcon1.Dispose() Application.Exit() End If End Sub Private Sub DuvarKagidiFrm_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing TrayaEkleBtnTs.PerformClick() e.Cancel = True End Sub Private Sub AnaFrm_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Try Timer2.Start() TraydaGosterTSmn.Enabled = True FormuGosterTSmn.Enabled = False PnlOtoAyar.Visible = GetSetting(Application.ProductName, ProductName, "OtoAyar Paneli Göster", True) SureBelirleCmb.Text = GetSetting(Application.ProductName, ProductName, "Otomatik Süre Belirle", 5) S_OtoSure = GetSetting(Application.ProductName, ProductName, "Seçilen Oto Süre", "Dakika") ilkSesYok = True 'Başlarken option seçiminde ses vermesin Select Case S_OtoSure Case "Dakika" DakikaOpBtn.Checked = True Case "Saatlik" SaatOpBtn.Checked = True End Select Me.ShowInTaskbar = False If My.Computer.Network.IsAvailable = False Then WebdeAraTS.Enabled = False Else WebdeAraTS.Enabled = True End If ' SabitDeskPaper = GetSetting(Application.ProductName, ProductName, "SabitDeskPaper", "Genişlet") If SabitDeskPaper = "Genişlet" Then GenisletOpBtn.Checked = True ElseIf SabitDeskPaper = "Ortala" Then OrtalaOpBtn.Checked = True ElseIf SabitDeskPaper = "Döşe" Then DoseOpBtn.Checked = True End If Dim dosya As String = Application.StartupPath & "\" & "DuvarKagidiListesi.txt" If dosya <> Nothing Then ListBox1.Items.Clear() Call ListeYukle() ListeyiSaklaTS.Enabled = True ListedenYukleTS.Enabled = True ListeyiSilTS.Enabled = True ListBox1.SelectedIndex = GetSetting(Application.ProductName, ProductName, "Seçilen Satır", 0) If ListBox1.SelectedIndex = -1 Then ListBox1.SelectedIndex = 0 PictureBox1.ImageLocation = (Me.ListBox1.SelectedItem) End If ilkSesYok = False 'ses vermeye ayarla Catch ex As Exception 'MessageBox.Show("Liste Boş." & vbCrLf & "(Örnek Duvar Kağıdı) dizininden Seçiniz") '(ex.Message) ResimYukleTS.PerformClick() ListBox1.SelectedIndex = 0 'Me.ListBox1.Items.Count - 1 End Try End Sub #End Region #Region " LİSTE OLAYLARI.." Public Sub ListeYukle() Try Dim yol = Application.StartupPath & "\DuvarKagidiListesi.txt" Oku = New IO.StreamReader(yol, System.Text.Encoding.Default) While (Oku.Peek() > -1) RTrim(ListBox1.Items.Add(Oku.ReadLine)) End While Oku.Close() ListBox1.SelectedItem = +1 Catch ex As Exception 'MessageBox.Show(ex.Message) MessageBox.Show("(DuvarKagidiListesi.txt) Dosyası Bulunamadı" & vbCrLf & "(Örnek Duvar Kağıdı) dizininden" & vbCrLf & "Resim yükleyip Listeyi saklayın") End Try End Sub Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged PictureBox1.ImageLocation = (Me.ListBox1.SelectedItem) SecilenLBL.Text = PictureBox1.ImageLocation SecilenSatirTS.Text = Me.ListBox1.SelectedIndex No = Me.ListBox1.SelectedIndex 'Me.Text = No End Sub Private Sub ResimYukleTS_Click(sender As System.Object, e As System.EventArgs) Handles ResimYukleTS.Click 'Dim dosya As String 'Dim count As Integer 'Dim yol As String = Application.StartupPath & "\Örnek Duvar Kağıdı\" 'Dim uz As String = "*.jpg" 'dosya = Dir(yol, FileAttribute.Hidden) 'If dosya <> "" Then ' count = count + 1 'End If 'While dosya <> "" ' dosya = Dir() ' count = count + 1 ' ListBox1.Items.Add(yol) 'End While 'ListBox1.Items.AddRange(Directory.GetFiles(yol, uz, SearchOption.TopDirectoryOnly)) OpenFileDialog1.InitialDirectory = Application.StartupPath OpenFileDialog1.Filter = "Ressim Dosyaları|*.jpg;*.jpg|Tüm Dosyalar|*.*" If OpenFileDialog1.ShowDialog() = DialogResult.OK Then PictureBox1.Load(OpenFileDialog1.FileName) End If Dim file As String For Each file In OpenFileDialog1.FileNames ListBox1.Items.Add(file) Next 'Listeyi kendi klasöründe OTOMATİK sakla Dim DsyAdi As String = Application.StartupPath & "\DuvarKagidiListesi.txt" Yaz = New StreamWriter(DsyAdi, False, System.Text.Encoding.Default) Dim i As Integer For i = 0 To Me.ListBox1.Items.Count - 1 Yaz.WriteLine(Me.ListBox1.Items.Item(i)) Next Yaz.Close() End Sub Private Sub ListedenYukleTS_Click(sender As System.Object, e As System.EventArgs) Handles ListedenYukleTS.Click OpenFileDialog1.Filter = "Text Dosyaları|*.txt;*.txt|Tüm Dosyalar|*.*" OpenFileDialog1.InitialDirectory = Application.StartupPath OpenFileDialog1.FileName = Application.ExecutablePath & OpenFileDialog1.FileName OpenFileDialog1.FileName = "DuvarKagidiListesi.txt" If OpenFileDialog1.ShowDialog() = DialogResult.OK Then Oku = New IO.StreamReader(OpenFileDialog1.FileName) While (Oku.Peek() > -1) ListBox1.Items.Add(Oku.ReadLine) End While Oku.Close() End If End Sub Private Sub ListeyiSaklaTS_Click(sender As System.Object, e As System.EventArgs) Handles ListeyiSaklaTS.Click SaveFileDialog1.Filter = "Dosya Biçimi|*.txt;*.txt" SaveFileDialog1.InitialDirectory = Application.StartupPath SaveFileDialog1.FileName = "DuvarKagidiListesi.txt" If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then Dim Yol = SaveFileDialog1.FileName & "\DuvarKagidiListesi.txt" Yaz = New IO.StreamWriter(SaveFileDialog1.FileName, False, System.Text.Encoding.Default) Dim i As Integer For i = 0 To ListBox1.Items.Count - 1 Yaz.WriteLine(RTrim(ListBox1.Items.Item(i))) Next Yaz.Close() End If End Sub #End Region #Region " KOMUT BUTONLARINI TIKLAMA." Private Sub OtomatikDegissinTS_Click(sender As System.Object, e As System.EventArgs) Handles OtomatikDegissinTS.Click, OtomatikDegissinTSM.Click If PnlOtoAyar.Visible = False Then PnlOtoAyar.Visible = True PnlOtoAyar.BringToFront() ListBox1.BringToFront() Else PnlOtoAyar.Visible = False End If SaveSetting(Application.ProductName, ProductName, "OtoAyar Paneli Göster", PnlOtoAyar.Visible) End Sub Private Sub WebdeAraTS_Click(sender As System.Object, e As System.EventArgs) Handles WebdeAraTS.Click Dim url As String = "https://www.google.com/search?q=Wallpapers" Process.Start(url) End Sub #End Region #Region " SATIR SİLMEK. (Buton ve DEL tuşu ile)" Private Sub ListeyiSilTS_Click(sender As System.Object, e As System.EventArgs) Handles ListeyiSilTS.Click, ListeyiSilTSM.Click ListBox1.Items.Clear() SecilenSatirTS.Text = -1 End Sub Private Sub ListBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseDown 'Seçili satır üstünde Farenin sağ tuşuna tıklanırsa seçili itemi duvar kağıdı yap If e.Button = Windows.Forms.MouseButtons.Right Then ListBox1_DoubleClick(sender, e) End If 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 'Sol ok tuşu ile EKLE yukarı-aşağı tuşu ile seç If e.KeyCode = Keys.Left Then ListBox1_DoubleClick(sender, e) End If End Sub Private Sub SatirSil() Dim secilecek, silinecek 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 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 #End Region #Region " Ok tuşu ile (boyutunu), Enter tuşu ve DoubleClick ile DUVAR KAĞIDINI SABİTLEMEK .." Private Sub ListBox1_DoubleClick(sender As System.Object, e As System.EventArgs) Handles ListBox1.DoubleClick GenisletOpBtn.Checked = True If SabitDeskPaper = "Genişlet" Then GenisletOpBtn.Checked = True ElseIf SabitDeskPaper = "Ortala" Then OrtalaOpBtn.Checked = True ElseIf SabitDeskPaper = "Döşe" Then DoseOpBtn.Checked = True End If Call BtnOKOnayla() End Sub Public Sub BtnOKOnayla() Dim listdata As String listdata = Me.PictureBox1.ImageLocation Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True) If Me.GenisletOpBtn.Checked = CheckState.Unchecked And Me.OrtalaOpBtn.Checked = CheckState.Unchecked And Me.DoseOpBtn.Checked = CheckState.Unchecked Then MsgBox("Bir boyut seçiniz....") Exit Sub ElseIf Me.GenisletOpBtn.Checked = True Then key.SetValue("WallpaperStyle", "2") key.SetValue("TileWallpaper", "0") Call Me.SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, listdata, UPDATEINIFILE) ElseIf Me.OrtalaOpBtn.Checked = True Then key.SetValue("WallpaperStyle", "0") key.SetValue("TileWallpaper", "0") Call Me.SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, listdata, UPDATEINIFILE) ElseIf Me.DoseOpBtn.Checked = True Then key.SetValue("WallpaperStyle", "0") key.SetValue("TileWallpaper", "1") Call Me.SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, listdata, UPDATEINIFILE) End If End Sub Private Sub GenisletOpBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles GenisletOpBtn.CheckedChanged, OrtalaOpBtn.CheckedChanged, DoseOpBtn.CheckedChanged If GenisletOpBtn.Checked = True Then SabitDeskPaper = "Genişlet" ElseIf OrtalaOpBtn.Checked = True Then SabitDeskPaper = "Ortala" ElseIf DoseOpBtn.Checked = True Then SabitDeskPaper = "Döşe" End If Call BtnOKOnayla() SaveSetting(Application.ProductName, ProductName, "SabitDeskPaper", SabitDeskPaper) End Sub #End Region #Region " OTOMATİK DUVAR KAĞIDI SÜRESİNİ OPTIONLARINDAN SEÇMEK VE BAŞLATMAK.." Private Sub S_BaslatBtn_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles S_BaslatBtn.MouseDown If e.Button = Windows.Forms.MouseButtons.Right Then Call ilerle() End If End Sub Private Sub DakikaOpBtn_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles DakikaOpBtn.CheckedChanged, SaatOpBtn.CheckedChanged If DakikaOpBtn.Checked = False And SaatOpBtn.Checked = False Then MsgBox("Hiçbir Değiştirme oranı seçilmedi.") Exit Sub ElseIf DakikaOpBtn.Checked = True Then S_OtoSure = "Dakika" ElseIf SaatOpBtn.Checked = True Then S_OtoSure = "Saatlik" End If End Sub Private Sub SureBelirleCmb_TextChanged(sender As System.Object, e As System.EventArgs) Handles SureBelirleCmb.TextChanged Timer1.Interval = SureBelirleCmb.Text.ToString LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Select Case SureBelirleCmb.Text Case 1 Timer1.Interval = 1000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 2 Timer1.Interval = 1000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" & SureBelirleCmb.Text & " Dakika" Case 3 Timer1.Interval = 3000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 4 Timer1.Interval = 4000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 5 Timer1.Interval = 5000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 10 Timer1.Interval = 10000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 15 Timer1.Interval = 15000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 20 Timer1.Interval = 20000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 25 Timer1.Interval = 25000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case 30 Timer1.Interval = 300000 LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" Case Else Timer1.Interval = SureBelirleCmb.Text.ToString LblInterval.Text = (SureBelirleCmb.Text * 1000) & " Interval" End Select DakikaOpBtn.Checked = True SaveSetting(Application.ProductName, ProductName, "Otomatik Süre Belirle", SureBelirleCmb.Text) End Sub #End Region #Region " TIMER OLAYLARI..." Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick Try No = Me.ListBox1.SelectedIndex If No = Me.ListBox1.Items.Count - 1 Then Me.ListBox1.SelectedIndex = 0 No = Me.ListBox1.SelectedIndex Else Call ilerle() End If Catch ex As Exception MessageBox.Show(ex.Message) End Try End Sub Public Sub ilerle() On Error Resume Next If Me.ListBox1.Items.Count - 1 = -1 Then Exit Sub If Me.ListBox1.SelectedIndex < Me.ListBox1.Items.Count - 1 Then Me.ListBox1.SelectedIndex = Me.ListBox1.SelectedIndex + 1 Me.SecilenSatirTS.Text = Me.ListBox1.SelectedIndex If Me.ListBox1.SelectedIndex > Me.ListBox1.Items.Count - 1 Then Me.ListBox1.SelectedIndex = Me.ListBox1.Items.Count - 1 End If Else Me.ListBox1.SelectedIndex = 0 End If No = Me.ListBox1.SelectedIndex No = CStr(Me.ListBox1.Items.Item(No)) Call DuvarKagidiniUygula() S_SıfırlaBtn.PerformClick() End Sub Private Sub Timer2_Tick(sender As System.Object, e As System.EventArgs) Handles Timer2.Tick LblSaat.Text = CStr(TimeOfDay) End Sub #End Region #Region " NOTIFYICON İÇİN ContextMenu OLAYLARI..." #Region " NOTIFYICON İÇİN CLİCK OLAYI.." Private Sub TrayaEkleBtnTs_Click(sender As System.Object, e As System.EventArgs) Handles TrayaEkleBtnTs.Click TraydaGosterTSmn.Enabled = False FormuGosterTSmn.Enabled = True NotifyIcon1.Text = Me.Text NotifyIcon1.Visible = True Me.Visible = False Me.ShowInTaskbar = False Me.Hide() SureTSmn.Text = "Dakika : " & LbDakika.Text & " Saniye : " & LblSaniye.Text SaveSetting(Application.ProductName, ProductName, "NotifyIcon Trayda", NotifyIcon1.Visible) End Sub #End Region Private Sub TraydaGosterTSmn_Click(sender As System.Object, e As System.EventArgs) Handles TraydaGosterTSmn.Click TraydaGosterTSmn.Enabled = False FormuGosterTSmn.Enabled = True NotifyIcon1.Text = Me.Text NotifyIcon1.Visible = True Me.ShowInTaskbar = False Me.Visible = False Me.Hide() SureTSmn.Text = "Dakika : " & LbDakika.Text & " Saniye : " & LblSaniye.Text SaveSetting(Application.ProductName, ProductName, "NotifyIcon Trayda", NotifyIcon1.Visible) End Sub Private Sub FormuGosterTSmn_Click(sender As System.Object, e As System.EventArgs) Handles FormuGosterTSmn.Click TraydaGosterTSmn.Enabled = True FormuGosterTSmn.Enabled = False Me.Show() Me.WindowState = FormWindowState.Normal End Sub Private Sub UygulamadanCikTSmn_Click(sender As System.Object, e As System.EventArgs) Handles UygulamadanCikTSmn.Click Call AyarSakla() NotifyIcon1.Dispose() End End Sub #End Region #Region "BAŞLAT- UYGULA" Public Sub DuvarKagidiniUygula() Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True) If SabitDeskPaper = "Genişlet" Then key.SetValue("WallpaperStyle", "2") key.SetValue("TileWallpaper", "0") Call SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, No, UPDATEINIFILE) ElseIf SabitDeskPaper = "Ortala" Then key.SetValue("WallpaperStyle", "0") key.SetValue("TileWallpaper", "0") Call SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, No, UPDATEINIFILE) ElseIf SabitDeskPaper = "Döşe" Then key.SetValue("WallpaperStyle", "0") key.SetValue("TileWallpaper", "1") Call SesVer() SystemParametersInfo(SETDESKWALLPAPER, 0, No, UPDATEINIFILE) End If End Sub #End Region #Region " SES OLAYLARI..." Public Sub SesVer() On Error Resume Next If ilkSesYok = True Then Exit Sub Dim splayer As New SoundPlayer(My.Resources.notify) splayer.Play() End Sub #End Region #Region " SAYAÇ İŞLEMLERİ.." Private Sub Timer3_Tick(sender As System.Object, e As System.EventArgs) Handles Timer3.Tick LblSaniye.Text = LblSaniye.Text + 1 If LblSaniye.Text = "60" Then LbDakika.Text = LbDakika.Text + 1 LblSaniye.Text = "00" If LbDakika.Text = SureBelirleCmb.Text Then 'And LblSaniye.Text = "00" Then LbDakika.Text = "00" LblSaniye.Text = "00" SureTSmn.Text = "Dakika : 00 Saniye : 00" Call ilerle() End If End If SureTSmn.Text = "Dakika : " & LbDakika.Text & " Saniye : " & LblSaniye.Text End Sub Private Sub S_BaslatBtn_Click(sender As System.Object, e As System.EventArgs) Handles S_BaslatBtn.Click Timer3.Start() Timer3.Enabled = True SureTSmn.Text = "Dakika : " & LbDakika.Text & " Saniye : " & LblSaniye.Text End Sub Private Sub S_DurdurBtn_Click(sender As System.Object, e As System.EventArgs) Handles S_DurdurBtn.Click Timer3.Stop() Timer3.Enabled = False End Sub Private Sub S_SıfırlaBtn_Click(sender As System.Object, e As System.EventArgs) Handles S_SıfırlaBtn.Click LbDakika.Text = "00" LblSaniye.Text = "00" SureTSmn.Text = "Dakika : 00 Saniye : 00" End Sub Private Sub S_BaslatBtn_MouseHover(sender As System.Object, e As System.EventArgs) Handles S_BaslatBtn.MouseHover Dim tooltip As New ToolTip() tooltip.SetToolTip(S_BaslatBtn, " Sağ Fare Tuşu ile Listede satır seç" & vbCrLf & "Süreyi başlat (Dakika)") End Sub Private Sub S_DurdurBtn_MouseHover(sender As System.Object, e As System.EventArgs) Handles S_DurdurBtn.MouseHover Dim tooltip As New ToolTip() tooltip.SetToolTip(S_DurdurBtn, "Süreyi Durdur (Dakika)") End Sub Private Sub S_SıfırlaBtn_MouseHover(sender As System.Object, e As System.EventArgs) Handles S_SıfırlaBtn.MouseHover Dim tooltip As New ToolTip() tooltip.SetToolTip(S_SıfırlaBtn, "Süreyi Sıfıla (00)") End Sub #End Region #Region " SAAT SEKMESİNDEİ İKONA TIKLAMA OLAYI..." Private Sub NotifyIcon1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDown If e.Button = Windows.Forms.MouseButtons.Left Then If Me.Visible = False Then TraydaGosterTSmn.Enabled = True FormuGosterTSmn.Enabled = False Me.Show() Me.Focus() Else TraydaGosterTSmn.Enabled = False FormuGosterTSmn.Enabled = True Me.Hide() End If End If End Sub #End Region End Class Modul :Module Module1 Friend No = Anafrm.ListBox1.SelectedIndex Public ilkSesYok As Boolean = False End Module
