✔ Desktop neu zeichnen?

[wurzelholz]

Hallo Forum,

habe mir heute aus ein paar Programmschnipseln ein Tool gebastelt, welches selbstständig immer das Wallpaper austauscht. Leider wird der Desktophintergrund nicht neu gezeichnet wenn ich z. B. ein Fenster oder Icon verschiebe ---> es kommt blauer Hintergrund zum Vorschein.
Kann mir jemand bei meinem Problem helfen? Hab schon gesucht und paar Tips ausprobiert, leider ohne Erfolg.

Hier der Code des kompletten Projekts:

Option Explicit
Dim ordnerpfad As String
Dim dateinamen As String
Dim dateinamenArray
'------- Deklarationen für Desktophintergrund ---------
Private Declare Function SystemParametersInfo Lib "user32" _
		Alias "SystemParametersInfoA" (ByVal uAction As _
		Long, ByVal uParam As Long, ByVal lpvParam As Any, _
		ByVal fuWinIni As Long) As Long
Const SPIF_SENDWININICHANGE = &H2
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
'----------- Ende Deklarationen für Desktophintergrund-----
'------- Deklarationen für FSO ---------
Dim FSO As New FileSystemObject
'----------- Ende Deklarationen für FSO-----
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_Load()
DoEvents
Form1.Visible = False
ordnerpfad = InputBox("Geben Sie den Ordner mit Wallpapers an: ", "Bitte füttern", "C:\Documents and Settings\p859601\Desktop\wallpaper", 1050, 300)
 
Dim f As Folder
Dim fi As File
Dim fiLen As Long
Dim fiOnly As String
Dim strExt As String
'Verweis auf Ordner erstellen
Set f = FSO.GetFolder(ordnerpfad)
'Alle heruntergeladenen Dateien auflisten
 
For Each fi In f.Files
	 strExt = FSO.GetExtensionName(fi) 'Extension der Datei ermitteln
	 If strExt = "jpg" Or strExt = "gif" Or strExt = "tif" Then
		fiLen = Len(fi)
		fiOnly = Left(fi, fiLen - 3) 'länge des kompletten pfades - 3 Char dateiendung --> kein *.jpeg
		fiOnly = fiOnly & "bmp"
		If fi <> fiOnly Then
			FSO.MoveFile fi, fiOnly
		End If
	 End If
Next
 
For Each fi In f.Files
	 strExt = FSO.GetExtensionName(fi) 'Extension der Datei ermitteln
	 If strExt = "bmp" Then
		 dateinamen = dateinamen & " | " & fi
	 End If
Next
dateinamenArray = Split(dateinamen, " | ") ' Bereitstellung der Dateinamen
Timer1.Enabled = True
Call Timer1_Timer
End Sub
Private Sub Timer1_Timer()
	CommonDialog1.Filter = ("BMP-Grafiken (*.BMP)|*.BMP")
	CommonDialog1.InitDir = ordnerpfad 'Ordner
	Dim i As Integer
 
	For i = 1 To UBound(dateinamenArray)
		CommonDialog1.FileName = dateinamenArray(i) 'Dateiname
 
		DoEvents
		SystemParametersInfo SPI_SETDESKWALLPAPER, 0, CommonDialog1.FileName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
		DoEvents
		UpdateWindow GetDesktopWindow
		If i <> UBound(dateinamenArray) Then
				i = i + 1
		Else
				i = 1
		End If
		DoEvents
	Next i
End Sub

Auf der Forum ist ein Timer und der Common Dialog.
Vergesst nicht, wegen des FSO, die MS Scripting Runtime aus der scrrun.dll zu referenzieren!


Danke für eure Hilfe!

EDIT: Falscher Quellcode + noch ne Frage: Mir wechseln die Bilder zu schnell, wie kann ich den Timer auf 5min (30000ms) einstellen? Den Wert nimmt er mir ned... :[

 

[wincnc]

Hallo, habe nein Beispielcode für Dich.
Du benötigst eine Form, eine FileListBox (File1) und einen Timer (Timer1).

In Form:

Private Nr As Long

Private Sub Form_Load()
  File1.Path = "c:\windows"
  File1.Pattern = "*.bmp"
  Timer1.Interval = 2000
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  If Nr > File1.ListCount Then Nr = 0
  SetDesktopWallpaper File1.List(Nr)
  Nr = Nr + 1
End Sub

In Modul:

' zunächst die benötigten API-Funktionen
Private Declare Function SystemParametersInfo Lib "user32" _
  Alias "SystemParametersInfoA" (ByVal uAction As Long, _
  ByVal uParam As Long, ByVal lpvParam As Any, _
  ByVal fuWinIni As Long) As Long

Private Const SPIF_SENDWININICHANGE = &H2
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_UPDATEINIFILE = &H1

' Bilddatei (sFilename) muß BITMAP enthalten
Public Sub SetDesktopWallpaper(ByVal sFilename As String)
  SystemParametersInfo SPI_SETDESKWALLPAPER, 0, sFilename, _
    SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
End Sub

' kein Desktop-Hintergrund
Public Sub NoDesktopWallpaper()
  SystemParametersInfo SPI_SETDESKWALLPAPER, 0, "", _
    SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
End Sub

Zur Frage - Wie kann ich den Timer auf 5 Minuten einstellen:

Private Zeit As Long

Private Sub Form_Load()
  Timer1.Interval = 60000 ' 1 Minute
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Zeit = Zeit + 1

If Zeit = 5 Then
  ' Mach was
  Zeit = 0
End If

End Sub

 

[wurzelholz]

Der Code zum Ändern des Desktops hats nicht gebracht, den hab ich ja bei mir schon in ähnlicher Form drinnen.
Leider lässt sich Windows nicht durch eine Änderung des Dateityps beeindrucken, auch wenn man eine *.jpg in eine *.bmp umbenennt wird diese nicht als solche erkannt. In Bildbearbeitungsprogrammen wird es als *.bmp angezeigt (deshalb ging ich auch davon aus, dass es funktionieren müsste), aber als Desktophintergrund ist es trotzdem nicht brauchbar, da irgendwo noch zu viel *.jpg drinnsteckt. Nun brauch ich nen Konverter von *.jpg nach *.bmp, mal sehen.

Der Tipp nur bei jeden xTen Durchlauf aktiv zu werden hat mich zu einer ähnlichen Lösung inspiriert.

Merci + Grüße aus Bayern!