04-15-2025, 06:12 AM
For this to work properly for you, change line 11 to point to your own Photo library: Const PhotoFolder = "C:\Users\the_r\Pictures\"
Some of you might remember this from back in the day (v2.1 and prior). Others are saying, "What the heck is this garbage that Steve is tossing out upon us now?"
Well, those others (mainly Pete) can just go away and give me a +1 because this isn't a SCREEN 0 app for you!
As for everyone else, this is:
A simple desktop wallpaper changer for Windows. Before running this, there are a few things of note:
1) This will change your wallpaper. It does NOT preserve your wallpaper or restore it. It changes it and keeps changing it, like a slideshow, every few seconds. If your wallpaper is something important (like your dead wife and kids) and you don't have a back up of that photo to restore manually yourself later, then DON'T run this!! For heaven's sake, go back up that image and preserve it, before you grab some random wallpaper changer from the net and ruin your life forevermore!
2) This runs in the background, with no termination. It's a wallpaper changer. It's supposed to work in the background. It's not supposed to terminate. You can do whatever the heck else you want with your PC, while this thing is happily changing your wallpaper in the background. IF you want to terminate this process, go into taskmanager, find the file as... whatever you saved it and ran it as... and END PROCESS. If you don't know how to do that, then REBOOT your computer and pick up a new hobby besides programming.
3) As the title says, this is a WINDOWS wallpaper changer. This won't work on Linux or Mac. Tough for you guys, but that's the way the cookie crumbles some days. I'm certain somebody out there is writing Linux-only or Mac-only programs. This one just happens to be Windows-only as... it changes the Windows Desktop Wallpaper.
(If I seem snippy over these points, it's because the last time I shared this, there were multiple folks who complained over both things. Warnings in advance have been issued this time, so if you don't heed them, I will giggle at you!)
That said, this is an updated version to work better with Windows 11, as from my latest install, Windows has apparently decided to change the internal structure of folders and crap. /sigh
Up until... I dunno when... We had "C:\Users\Public\Photos" as a folder.
I just reinstalled Windows 11 (I do a fresh install every year or three just for stability and clean-up), and that structure has now changed to "C:\Users\Public\Public Photos". It's a minor change, but one which is a PITA if you hardcoded the old path into stuff. Stupic frigging Windows!!
For this to work properly for you, change line 11 to point to your own Photo library: Const PhotoFolder = "C:\Users\the_r\Pictures\"
You should now know basically what you're dealing with here, what minor change you need to make for it to work on your system, what it does (Gosh, it changes your desktop wallpaper in Windows, Pete!), and how to terminate it.
Tested and runs in QB64PE v4.1. Should work in older versions as well, as long as _SaveImage is in the version you have and it can create BMP files.
Code: (Select All)
Declare Dynamic Library "user32"
Function SystemParametersInfoA& (ByVal uiAction~&, ByVal uiParam~&, pvParam$, ByVal fWinlni~&)
End Declare
_ScreenHide
Const SPI_SETDESKTOPWALLPAPER = &H0014
Const SPI_UPDATEINIFILE = &H0001
Const WaitBetweenChanges = 3 'seconds
Const PhotoFolder = "C:\Users\the_r\Pictures\"
Const ScaleMode = 1 '0 to center, 1 to stretch while maintaining aspect ratio, 2 to stretch to fill screen
Dim Shared AlwaysRefreshListing As Long: AlwaysRefreshListing = 0 'If -1 then we'll always update the photo listing each time we run the program. If 0, we use the existing list and save needing to create a new one each run.
'The following settings are for calendar support, if wanted
Const DrawCalander = -1 'draw the calender overlay, or not
Const OffsetW = 10, OffsetH = 50 'Offset from bottom right corner of the screen.
' Change OffsetW to move the calendar further to the left of your screen (W = Width)
' Change OffsetH to move the calendar further up on your screen. (H = Height)
Const Kolor = _RGBA32(255, 255, 255, 150) 'The color of the calendar and the text
Const BackKolor = _RGBA32(0, 0, 255, 150) 'The color of the background which we see under the month
recreate:
If _FileExists("C:\ProgramData\PhotoList.txt") = 0 Or AlwaysRefreshListing Then
'will create the new listing if your directory doesn't contain one,
'OR, will create one every time you run the program, if you set the flag to make it do so.
PhotoList$ = PhotoFolder + "*.bmp " + PhotoFolder + "*.jpg " + PhotoFolder + "*.png " + PhotoFolder + "*.gif "
Shell "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
End If
Open "C:\ProgramData\PhotoList.txt" For Binary As #1
If LOF(1) = 0 Then ' the file existsm but was blank
If AlwaysRefreshListing = 0 Then 'try to recreate it
Close
AlwaysRefreshListing = -1
GoTo recreate
Else
System ' the file list was blank. We can't do anything with that.
End If
End If
Do Until EOF(1)
Line Input #1, junk$
PhotoCount = PhotoCount + 1
Loop
Seek #1, 1 'back to the beginning
Dim FileList(PhotoCount) As String
For i = 1 To PhotoCount
Line Input #1, FileList(i)
FileList(i) = FileList(i) + Chr$(0)
Next
Randomize Timer
Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)
_ScreenMove _Middle
_Title "Wallpaper Changer"
temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"
Today$ = Date$ 'mm-dd-yyyy
Day = Val(Mid$(Today$, 4, 2))
Month = Val(Today$)
Year = Val(Mid$(Today$, 7))
FirstDay = GetDay(Month, 1, Year)
Select Case Month
Case 1, 3, 5, 7, 8, 10, 12
DaysInMonth = 31
Case 2
DaysInMonth = 28 'need to add leap year later.
Case 4, 6, 9, 11
DaysInMonth = 30
End Select
Select Case Month
Case 1: Month$ = "January"
Case 2: Month$ = "February"
Case 3: Month$ = "March"
Case 4: Month$ = "April"
Case 5: Month$ = "May"
Case 6: Month$ = "June"
Case 7: Month$ = "July"
Case 8: Month$ = "August"
Case 9: Month$ = "September"
Case 10: Month$ = "October"
Case 11: Month$ = "November"
Case 12: Month$ = "December"
End Select
_Font 8
Color Kolor, 0
Do
Cls
loops = 0
Do
f = Int(Rnd * PhotoCount) + 1
f$ = FileList(f)
If _FileExists(f$) Then 'try a few times in case invalid files (like TXT files) are in the list.
'I was lazy and didn't bother to just search for image files after all...
f = _LoadImage(f$, 32)
If f <> -1 Then
w = _Width(f): h = _Height(f)
scalew = _Width / w: scaleh = _Height / h
Select Case ScaleMode
Case 0
_PutImage ((_Width - w) \ 2, (_Height - h) \ 2)-Step(w, h), f
Case 1
If scalew < scaleh Then scale = scalew Else scale = scaleh
w1 = w * scale: h1 = h * scale
_PutImage ((_Width - w1) \ 2, (_Height - h1) \ 2)-Step(w1, h1), f
Case 2
_PutImage , f
End Select
If DrawCalander Then
Day = Val(Mid$(Date$, 4, 2))
Line (_Width - OffsetW, _Height - OffsetH)-Step(-175, -140), Kolor, B
For i = 1 To 5
Line (_Width - OffsetW - 1, _Height - OffsetH - 20 * i)-Step(-173, 0), Kolor
Next
For i = 1 To 7
Line (_Width - OffsetW - 1 - i * 25, _Height - OffsetH - 1)-Step(0, -118), Kolor
Next
Line (_Width - OffsetW, _Height - OffsetH - 120)-Step(-175, 0), Kolor, B
Line (_Width - OffsetW - 1, _Height - OffsetH - 121)-Step(-173, -18), BackKolor, BF
count = 0
For y = 1 To 6 'weeks
For x = 1 To 7 'days
If (y - 1) * 7 + x >= FirstDay Then
count = count + 1
If count <= DaysInMonth Then
T$ = _Trim$(Str$(count))
If count = Day Then
Line (_Width - OffsetW - 175 + (x - 1) * 25, _Height - OffsetH - 120 + (y - 1) * 20)-Step(23, 18), BackKolor, BF
End If
_PrintString (_Width - OffsetW - 163 + (x - 1) * 25 - _PrintWidth(T$) \ 2, _Height - OffsetH - 116 + (y - 1) * 20), T$
End If
End If
Next
Next
T$ = Month$ + Str$(Year)
_PrintString (_Width - OffsetW - 87 - _PrintWidth(T$) \ 2, _Height - OffsetH - 135), T$
End If
_SaveImage temp$
result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + Chr$(0), SPI_UPDATEINIFILE)
result = -1
_FreeImage f
Else
loops = loops + 1
End If
End If
Loop Until result Or loops > 100
If loops > 100 Then Print "ERROR: Over 100 failures and no success... Terminating.": End
Print "Current Background: "; f$
_Delay WaitBetweenChanges
Loop
Function GetDay (mm, dd, yyyy) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then mm = mm + 12: yyyy = yyyy - 1
century = yyyy Mod 100: zerocentury = yyyy \ 100
result = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
If result = 0 Then GetDay = 7 Else GetDay = result
End Function
Some of you might remember this from back in the day (v2.1 and prior). Others are saying, "What the heck is this garbage that Steve is tossing out upon us now?"
Well, those others (mainly Pete) can just go away and give me a +1 because this isn't a SCREEN 0 app for you!
As for everyone else, this is:
A simple desktop wallpaper changer for Windows. Before running this, there are a few things of note:
1) This will change your wallpaper. It does NOT preserve your wallpaper or restore it. It changes it and keeps changing it, like a slideshow, every few seconds. If your wallpaper is something important (like your dead wife and kids) and you don't have a back up of that photo to restore manually yourself later, then DON'T run this!! For heaven's sake, go back up that image and preserve it, before you grab some random wallpaper changer from the net and ruin your life forevermore!
2) This runs in the background, with no termination. It's a wallpaper changer. It's supposed to work in the background. It's not supposed to terminate. You can do whatever the heck else you want with your PC, while this thing is happily changing your wallpaper in the background. IF you want to terminate this process, go into taskmanager, find the file as... whatever you saved it and ran it as... and END PROCESS. If you don't know how to do that, then REBOOT your computer and pick up a new hobby besides programming.
3) As the title says, this is a WINDOWS wallpaper changer. This won't work on Linux or Mac. Tough for you guys, but that's the way the cookie crumbles some days. I'm certain somebody out there is writing Linux-only or Mac-only programs. This one just happens to be Windows-only as... it changes the Windows Desktop Wallpaper.
(If I seem snippy over these points, it's because the last time I shared this, there were multiple folks who complained over both things. Warnings in advance have been issued this time, so if you don't heed them, I will giggle at you!)
That said, this is an updated version to work better with Windows 11, as from my latest install, Windows has apparently decided to change the internal structure of folders and crap. /sigh
Up until... I dunno when... We had "C:\Users\Public\Photos" as a folder.
I just reinstalled Windows 11 (I do a fresh install every year or three just for stability and clean-up), and that structure has now changed to "C:\Users\Public\Public Photos". It's a minor change, but one which is a PITA if you hardcoded the old path into stuff. Stupic frigging Windows!!
For this to work properly for you, change line 11 to point to your own Photo library: Const PhotoFolder = "C:\Users\the_r\Pictures\"
You should now know basically what you're dealing with here, what minor change you need to make for it to work on your system, what it does (Gosh, it changes your desktop wallpaper in Windows, Pete!), and how to terminate it.
Tested and runs in QB64PE v4.1. Should work in older versions as well, as long as _SaveImage is in the version you have and it can create BMP files.
