'Beispiel: VB .Net - Grafik aus dem Internet downloaden und als Wallpaper verwenden - 1 'Hinweis : Ist die abgerufene Datei auf dem Server nicht vorhanden wird eine leere Datei ( 0 Byte ) 'mit dem uebergebenen Dateinamen wallpaper.jpg gespeichert. 'Stellen Sie sicher das eine Online-Verbindung besteht. ' Option Explicit On Option Strict On Imports System.IO Public Partial Class MainForm Public Sub New() Me.InitializeComponent() End Sub Private tmChange As Integer = -1 Private Sub Button1Click(sender As Object, e As System.EventArgs) Dim sw As SetWallpaper Me.Cursor = Cursors.WaitCursor sw = New SetWallpaper( _ My.Computer.FileSystem.CurrentDirectory + "\images", _ "wallpaper.jpg", comboBox1.Text) Dim k As Integer = comboBox2.Items.Count - 1 Dim s(k) As String For n As Integer = 0 To k s(n) = comboBox2.Items(n).ToString Next sw.InitImages(s) s = Nothing ' Dim Result As Boolean = sw.SetWallpaper() comboBox2.SelectedIndex = sw._current Select Result Case True label1.Text = "Datei wurde heruntergeladen..." button1.Enabled = False Me.Text = "Bilderanzahl: " + sw._max.ToString() + _ " Ausgewaehltes Bild: " + sw._current.ToString() timer1.Enabled = True Case Else label1.Text = "Fehler..." If label1.Text = "Fehler..." Then button1.PerformClick() End If End Select Me.Cursor = Cursors.Default End Sub Private Sub MainFormLoad(sender As Object, e As System.EventArgs) timer1.Interval = 1000 timer1.Enabled = False With numericUpDown1 .Minimum = 30 .Maximum = 3600 .Increment = 10 .Value = 30 label2.Text = "Wechsel einstellen: " + .Value.ToString() End With comboBox1.Items.Add("http://vb4free.vb.funpic.de/") comboBox1.Items.Add("http://antwrp.gsfc.nasa.gov/apod/image/0101/") comboBox1.SelectedIndex = 1 End Sub Private Function FirstImageArray() As String() Dim s() As String = _ {"bild1.jpg", _ "bild2.jpg", _ "bild3.jpg", _ "bild4.jpg", _ "bild5.jpg", _ "bild6.jpg", _ "bild7.jpg", _ "bild8.jpg", _ "bild9.jpg", _ "bild10.jpg", _ "bild11.jpg", _ "bild12.jpg"} Return s End Function Private Function SecondImageArray() As String() Dim s() As String = _ {"JupEuroCall_cassini.jpg", _ "abell39_wiyn.jpg", _ "abell39_wiyn_big.jpg", _ "blackhole_illustration.jpg", _ "catseye_composite.jpg", _ "challenger_apollo17_big.jpg", _ "earthplasma_image.jpg", _ "earthplasma_image_big.jpg", _ "leclipse_espenak.jpg", _ "m8_kitahara.jpg", _ "marscrater_nasa_big.jpg", _ "orion2_vlt.jpg"} Return s End Function Private Sub Timer1Tick(sender As Object, e As System.EventArgs) tmChange += 1 Me.Text = tmChange.ToString() + " von: " + CInt(numericUpDown1.Value).ToString + _ " Sekunden vergangen..." If tmChange = CInt(numericUpDown1.Value) Then label1.Text = "" button1.Enabled = True tmChange = -1 timer1.Enabled = False Me.Text = "" button1.PerformClick() End If End Sub Private Sub NumericUpDown1ValueChanged(sender As Object, e As System.EventArgs) label2.Text = "Wechsel einstellen: " + numericUpDown1.Value.ToString() End Sub Private Sub ComboBox1SelectedIndexChanged(sender As Object, e As System.EventArgs) Dim Index As Integer = comboBox1.SelectedIndex Dim n As Integer = -1 If Index = 0 Then comboBox2.Items.Clear() comboBox2.Text = "" For n = 0 To UBound(FirstImageArray) comboBox2.Items.Add(FirstImageArray(n)) Next comboBox2.SelectedIndex = 0 ElseIf Index = 1 Then comboBox2.Items.Clear() comboBox2.Text = "" For n = 0 To UBound(SecondImageArray) comboBox2.Items.Add(SecondImageArray(n)) Next comboBox2.SelectedIndex = 0 ElseIf Index = 2 Then comboBox2.Items.Clear() comboBox2.Text = "" Call AddMyFilenamesToComboBox(comboBox2) comboBox2.SelectedIndex = 0 End If End Sub Private Sub EndeToolStripMenuItemClick(sender As Object, e As System.EventArgs) Application.Exit() End Sub Private Sub BilderlisteAusDateiladenToolStripMenuItemClick(sender As Object, e As System.EventArgs) Dim Filename As String = _ My.Computer.FileSystem.CurrentDirectory + "\myurl1.ini" If System.IO.File.Exists(Filename) Then Dim mif As New MyIniFile(Filename) Dim Result As String = "" Dim Success As Boolean = mif.GetIniValue("BaseUrl", "MyUrl", Result) If Success And Result.Length > 0 Then 'Ergebnis in comboBox1 einfuegen comboBox1.Items.Add(Result) comboBox1.SelectedIndex = 2 ' 'ComboBox mit den erforderlichen Dateinamen fuellen Call AddMyFilenamesToComboBox(comboBox2) 'Der Eintrag ist nach der ersten Aktivierung nicht mehr aktiv BilderlisteAusDateiladenToolStripMenuItem.Enabled = False ' ' Else MessageBox.Show("Error...", "Info") End If Else MessageBox.Show("Datei wurde nicht gefunden...", "Info") End If End Sub 'Bildernamen in die ComboBox laden 'Hier koennen in die Datei myimagelist.txt zusaetzliche Bildernamen eingetragen 'werden. Es ist zu beachten das sollten die Dateinamen aus einer anderen Basis-Url 'wie in der ini Datei myurl1.ini angegeben die ini Datei myurl1.ini geaendert werden 'muss. Die Basis-Url in myurl1.ini muss mit einem Slash enden. Private Sub AddMyFilenamesToComboBox(ByVal cb As System.Windows.Forms.ComboBox) Try If cb.Items.Count > 0 Then cb.Items.Clear cb.Text = "" Dim MyPath As String = Application.StartupPath If (Not MyPath.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString())) Then MyPath &= System.IO.Path.DirectorySeparatorChar End If MyPath &= "myimagelist.txt" If File.Exists(MyPath) Then Dim fs As FileStream = New FileStream(MyPath, FileMode.Open) Dim sr As New IO.StreamReader(fs) Do Until sr.Peek() = -1 cb.Items.Add(sr.ReadLine) Loop sr.Close() If cb.Items.Count > 0 Then cb.SelectedIndex = 0 End If Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Sub End Class Public Class SetWallpaper Implements IDisposable Private _directory As String Private _filename As String Private _url As String Public _max As Integer Public _current As Integer Public Sub New(ByVal directory As String, ByVal filename As String, ByVal url As String) _directory = directory _filename = filename _url = url End Sub #Region "Win32Api" Private Const SPI_SETDESKWALLPAPER As Integer = 20 Private Const SPIF_SENDWININICHANGE As Integer= &H2 Private Const SPIF_UPDATEINIFILE As Integer = &H1 Private Declare Auto Function SystemParametersInfo Lib "user32.dll" ( _ ByVal uAction As Integer, _ ByVal uParam As Integer, _ ByVal lpvParam As String, _ ByVal fuWinIni As Integer) As Integer #End Region #Region "Requiered Functions" Dim _images() As String Public Sub InitImages(ByVal ParamArray images() As String) Try _images = images Catch End Try End Sub Public Function SetWallpaper() As Boolean Try 'Pruefen ob der Downloadordner fuer das Wallpaper vorhanden ist. 'Ist es nicht vorhanden wird es angelegt. If System.IO.Directory.Exists(_directory) = False Then System.IO.Directory.CreateDirectory(_directory) End If Try 'Versuch Datei aus dem Internet laden 'Unten angegebene Dateinamen liegen auf der uebergebenen URL Dim s() As String = _images Dim max As Integer = UBound(s) Randomize() Dim n As Integer = MyRandomNumbers.Next(0, max) _max = max _current = n 'Ist der uebergebene Dateiname schon vorhanden wird diese Datei geloescht If System.IO.File.Exists(_directory + "\" + _filename) Then System.IO.File.Delete(_directory + "\" + _filename) End If 'Downlaod-Initialisierung Dim wc As New System.Net.WebClient 'Datei ueber angegebene Url plus dem Dateinamen herunterladen und in dem 'uebergebenen Verzeichnis mit dem uebergebenen Standardnamen speichern. wc.DownloadFileAsync(New Uri(_url + s(n)), _directory + "\" + _filename) 'Pruefen ob die heruntergeladene Datei sich tatsaechlich in dem uebergebenen 'Verzeichnisnamen befindet. If System.IO.File.Exists(_directory + "\" + _filename) Then System.Threading.Thread.Sleep(2000) 'Pruefen ob die gespeicherte Datei eine Dateigroesse von mehr als '0 Byte besitzt. Dim fi As New System.IO.FileInfo(_directory + "\" + _filename) Dim MySize As Long = fi.Length If MySize = 0 Then 'Hat die gespeicherte Datei eine Groesse von 0 Byte wird die 'Funktion verlassen. Return Nothing Else 'Ist die Datei vorhanden und hat eine Dateigroesse von mehr als '0 Byte dann wird die Datei als Wallpaper gesetzt. '? Sleep 'Dateiendung der heruntergeladenen Datei ermitteln Dim di As New System.IO.DirectoryInfo(_directory + "\" + _filename) Dim extension As String = di.Extension.ToString() Debug.WriteLine(extension) 'Neuen Dateinamen mit der Endung .bmp zusammensetzen Dim newfilename As String = _ _directory & "\" & _filename.Replace(extension, ".bmp") 'Neue Datei zum speichern vorbereiten Dim img As System.Drawing.Image = _ Image.FromFile(_directory + "\" + _filename) 'Werbetext in die heruntergeladene Grafik einfuegen Dim g As Graphics g = Graphics.FromImage(img) Dim hBrush As New SolidBrush(Color.Yellow) Dim hFont As New Font("Times New Roman", 20) g.DrawString("www.visual-basic5.de", hFont, hBrush, 10, 10) ' 'Eventuell vorhandene Zieldatei loeschen Debug.WriteLine(newfilename) If System.IO.File.Exists(newfilename) Then System.IO.File.Delete(newfilename) End If 'Neue Datei unter .bmp speichern img.Save(newfilename, System.Drawing.Imaging.ImageFormat.Bmp) 'Beanspruchte Resourcen freigeben hBrush.Dispose() hFont.Dispose() g.Dispose() ' 'Pruefen ob die neue Datei vorhanden ist If System.IO.File.Exists(newfilename) Then 'Neue Datei als Desktophintergrund setzen SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _ newfilename, _ SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) Return True End If End If End If ' Catch ex As System.Net.WebException Return Nothing Catch ex As System.Exception Return Nothing End Try ' Catch Return Nothing End Try Return Nothing End Function #End Region #Region "Dispose" Public Sub Dispose() Implements System.IDisposable.Dispose _directory = "" _filename = "" _url = "" End Sub #End Region End Class Public Class MyRandomNumbers Private Shared [rnd] As New Random Public Shared Function [Next]() As Integer Return [rnd].Next() End Function Public Shared Function [Next](ByVal Min As Integer, ByVal Max As Integer) As Integer Try Return [rnd].Next(Min, Max) Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Function Public Shared Function [Next](ByVal Max As Integer) As Integer Try Return [rnd].Next(Max) Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Function End Class Public Class MyIniFile Private _filename As String Public Sub New(ByVal Filename As String) _filename = Filename End Sub #Region "Win32Api" Private Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" _ Alias "GetPrivateProfileStringA" _ (ByVal lpApplicationName As String, _ ByVal lpKeyName As String, _ ByVal lpDefault As String, _ ByVal lpReturnedString As System.Text.StringBuilder, _ ByVal nSize As Integer, _ ByVal lpFileName As String) _ As Integer #End Region #Region "Requiered Functions" Public Function GetIniValue(ByVal Section As String, _ ByVal KeyName As String, _ ByRef Result As String) As Boolean GetIniValue = False Dim sb As System.Text.StringBuilder = New System.Text.StringBuilder(256) Try Dim DefaultReturnedString As String = "" Dim NumberOfCharacters As Integer = _ GetPrivateProfileString(Section, KeyName, DefaultReturnedString, _ sb, sb.Capacity, _filename) If NumberOfCharacters > 0 Then Result = sb.ToString() Dim Index As Integer = Result.IndexOf(Result) sb.Remove(Index, Result.Length) GetIniValue = True End if Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Error...") End Try End Function #End Region End Class