Windows Wallpaper Changer

[SMcNeill]

Code: QB64: [Select]

1. DECLARE DYNAMIC LIBRARY "user32"
2.     FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
3. END DECLARE
4.  
5. CONST SPI_SETDESKTOPWALLPAPER = &H0014
6. CONST SPI_UPDATEINIFILE = &H0001
7.  
8. CONST WaitBetweenChanges = 10 'seconds
9.  
10. IF _FILEEXISTS("PhotoList.txt") = 0 THEN 'no need to shell for a new listing over and over endlessly
11.     'if you want a fresh file listing, delete the old  file before running the wallpaper changer.
12.     SHELL _HIDE "DIR " + CHR$(34) + "C:\Users\Public\Pictures\" + CHR$(34) + " /b /s /a-d >PhotoList.txt"
13. END IF
14.  
15.  
16. OPEN "PhotoList.txt" FOR BINARY AS #1
17. DO UNTIL EOF(1)
18.     LINE INPUT #1, junk$
19.     count = count + 1
20. LOOP
21.  
22. SEEK #1, 1 'back to the beginning
23.  
24. DIM FileList(count) AS STRING
25. FOR i = 1 TO count
26.     LINE INPUT #1, FileList(i)
27.     FileList(i) = FileList(i) + CHR$(0)
28. NEXT
29.  
30. RANDOMIZE TIMER
31.  
32.  
33. SCREEN _NEWIMAGE(640, 480, 32)
34. _SCREENMOVE _MIDDLE
35.  
36. _TITLE "Wallpaper Changer"
37.  
38. DO
39.     CLS
40.     loops = 0
41.     DO
42.         f = INT(RND * count) + 1
43.         f$ = FileList(f)
44.         IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
45.             'I was lazy and didn't bother to just search for image files after all...
46.             loops = loops + 1
47.             result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, f$, SPI_UPDATEINIFILE)
48.         END IF
49.     LOOP UNTIL result OR loops > 100
50.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
51.     PRINT "Current Background: "; f$
52.     _DELAY WaitBetweenChanges
53. LOOP
54.  

This changes your wallpaper every few seconds for you, provided you have photos in your "C:\Users\Public\Pictures\" folder.  If not, change that to a point where you do have suitable image files, before running it.

NOTE:  This *will* change the background on your desktop.  If you don't know how to change it back, then don't run this code.  (Oddly enough, I had someone complain over a similar set of code once over at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there], back in the day...) 

NOTE 2: Change the CONST WaitBetweenChanges = 10 'seconds to whatever delay you like for changing your background.

[Pete]

I'm surprised you didn't hard-code your avatar in that routine. Oh no, I just put an idea into your head.

Pete :D

[_vince]

is the windows version on the qb64.org page download point to a 7z of the linux version? why is it even in 7z? I can't try it, unfortunately, Steve

[SMcNeill]

is the windows version on the qb64.org page download point to a 7z of the linux version? why is it even in 7z? I can't try it, unfortunately, Steve

Wrong topic?  There’s no 7z here, and I doubt a Windows Wallpaper Changer will work in Linux... 

What are you trying to download in 7z format?

[_vince]

Just clicking on this like, trying to get QB64 on my windows computer: http://qb64.org/autobuilds/master/qb64_2018-11-01-14-33-43_2398884-master_win.7z

[SMcNeill]

Just clicking on this like, trying to get QB64 on my windows computer: http://qb64.org/autobuilds/master/qb64_2018-11-01-14-33-43_2398884-master_win.7z

Just clicked it and tested it, and it downloads just fine over here for me.  Are you having a firewall or antivirus issue with it not downloading, or being quarantined?

The reason it's in 7z format is from the size of the file -- 389MB uncompressed.  It's much easier for folks to download a 42MB file and extract it than it is for them to download one over 9 times that size uncompressed.  (Especially for people with limited bandwidth, or low speed internet access.)

I'm not certain what's going on to cause issues for you with downloading QB64 itself, but  the best idea is to pop into the chat channel and ask Fell or Luke about the problem.  They upkeep the site here, not me.  I, unfortunately, honestly can't be any sort of real help with any downloading issues.

[SMcNeill]

Updated version of this little background wallpaper flipper:

Code: QB64: [Select]

1. DECLARE DYNAMIC LIBRARY "user32"
2.     FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
3. END DECLARE
4.  
5. CONST SPI_SETDESKTOPWALLPAPER = &H0014
6. CONST SPI_UPDATEINIFILE = &H0001
7.  
8. CONST WaitBetweenChanges = 5 'seconds
9.  
10.  
11. IF _FILEEXISTS("PhotoList.txt") = 0 THEN 'no need to shell for a new listing over and over endlessly
12.     'if you want a fresh file listing, delete the old  file before running the wallpaper changer.
13.     SHELL "DIR C:\Users\Public\Pictures\*.bmp C:\Users\Public\Pictures\*.jpg C:\Users\Public\Pictures\*.png C:\Users\Public\Pictures\*.gif /b /s /a-d >PhotoList.txt"
14. END IF
15.  
16. OPEN "PhotoList.txt" FOR BINARY AS #1
17. DO UNTIL EOF(1)
18.     LINE INPUT #1, junk$
19.     count = count + 1
20. LOOP
21.  
22. SEEK #1, 1 'back to the beginning
23.  
24. DIM FileList(count) AS STRING
25. FOR i = 1 TO count
26.     LINE INPUT #1, FileList(i)
27.     FileList(i) = FileList(i) + CHR$(0)
28. NEXT
29.  
30. RANDOMIZE TIMER
31.  
32. SCREEN _NEWIMAGE(640, 480, 32)
33. _SCREENMOVE _MIDDLE
34.  
35. _TITLE "Wallpaper Changer"
36.  
37. temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"
38. DO
39.     CLS
40.     loops = 0
41.     DO
42.         f = INT(RND * count) + 1
43.         f$ = FileList(f)
44.         IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
45.             'I was lazy and didn't bother to just search for image files after all...
46.             f = _LOADIMAGE(f$, 32)
47.             IF f <> -1 THEN
48.                 w = _WIDTH(f): h = _HEIGHT(f)
49.                 scalew = _WIDTH / w
50.                 scaleh = _HEIGHT / h
51.                 IF scalew < scaleh THEN scale = scalew ELSE scale = scaleh
52.                 w1 = w * scale: h1 = h * scale
53.                 _PUTIMAGE ((_WIDTH - w1) \ 2, (_HEIGHT - h1) \ 2)-STEP(w1, h1), f
54.  
55.                 SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
56.                 result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
57.                 _FREEIMAGE f
58.             ELSE
59.                 loops = loops + 1
60.             END IF
61.         END IF
62.     LOOP UNTIL result OR loops > 100
63.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
64.     PRINT "Current Background: "; f$
65.     _DELAY WaitBetweenChanges
66. LOOP
67.  
68. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
69.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
70.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
71.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
72.  
73.     IF _PIXELSIZE(image&) = 0 THEN
74.         IF SaveTextAs256Color THEN
75.             tempimage& = TextScreenToImage256&(image&)
76.         ELSE
77.             tempimage& = TextScreenToImage32&(image&)
78.         END IF
79.         F = _FONT(image&)
80.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
81.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
82.         _FREEIMAGE tempimage&
83.         EXIT FUNCTION
84.     END IF
85.  
86.     TYPE BMPFormat
87.         ID AS STRING * 2
88.         Size AS LONG
89.         Blank AS LONG
90.         Offset AS LONG
91.         Hsize AS LONG
92.         PWidth AS LONG
93.         PDepth AS LONG
94.         Planes AS INTEGER
95.         BPP AS INTEGER
96.         Compression AS LONG
97.         ImageBytes AS LONG
98.         Xres AS LONG
99.         Yres AS LONG
100.         NumColors AS LONG
101.         SigColors AS LONG
102.     END TYPE
103.  
104.  
105.     DIM BMP AS BMPFormat
106.     DIM x AS LONG, y AS LONG
107.     DIM temp AS STRING, t AS STRING * 1
108.  
109.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
110.     m = _MEMIMAGE(image&)
111.  
112.     IF x1% > x2% THEN SWAP x1%, x2%
113.     IF y1% > y2% THEN SWAP y1%, y2%
114.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
115.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
116.  
117.     s& = _SOURCE
118.     _SOURCE image&
119.  
120.     BMP.PWidth = (x2% - x1%) + 1
121.     BMP.PDepth = (y2% - y1%) + 1
122.     BMP.ID = "BM"
123.     BMP.Blank = 0
124.     BMP.Hsize = 40
125.     BMP.Planes = 1
126.     BMP.Compression = 0
127.     BMP.Xres = 0
128.     BMP.Yres = 0
129.  
130.     BMP.SigColors = 0
131.  
132.     SELECT CASE _PIXELSIZE(image&)
133.         CASE 1
134.             temp = SPACE$(x2% - x1% + 1)
135.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
136.             BMP.BPP = 8
137.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
138.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
139.             BMP.ImageBytes = ImageSize&
140.             BMP.NumColors = 256
141.             BMP.Size = ImageSize& + OffsetBITS&
142.             BMP.Offset = OffsetBITS&
143.         CASE 4
144.             temp = SPACE$(3)
145.             OffsetBITS& = 54 'no palette in 24/32 bit
146.             BMP.BPP = 24
147.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
148.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
149.             BMP.ImageBytes = ImageSize&
150.             BMP.NumColors = 0
151.             BMP.Size = ImageSize& * 3 + OffsetBITS&
152.             BMP.Offset = OffsetBITS&
153.     END SELECT
154.  
155.     F = FREEFILE
156.     n = _MEMNEW(BMP.Size)
157.     _MEMPUT n, n.OFFSET, BMP
158.     o = n.OFFSET + 54
159.     zp& = LEN(ZeroPAD$)
160.     $CHECKING:OFF
161.  
162.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
163.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
164.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
165.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
166.             _MEMPUT n, o, b$
167.             o = o + 4
168.         NEXT
169.         y = y2% + 1
170.         w& = _WIDTH(image&)
171.         x = x2% - x1% + 1
172.         DO
173.             y = y - 1
174.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
175.             _MEMPUT n, o, temp
176.             o = o + x
177.             _MEMPUT n, o, ZeroPAD$
178.             o = o + zp&
179.         LOOP UNTIL y = y1%
180.     ELSE
181.         y = y2% + 1
182.         w& = _WIDTH(image&)
183.         DO
184.             y = y - 1: x = x1% - 1
185.             DO
186.                 x = x + 1
187.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
188.                 _MEMPUT n, o, temp
189.                 o = o + 3
190.             LOOP UNTIL x = x2%
191.             _MEMPUT n, o, ZeroPAD$
192.             o = o + zp&
193.         LOOP UNTIL y = y1%
194.     END IF
195.     $CHECKING:ON
196.     _MEMFREE m
197.     OPEN filename$ FOR BINARY AS #F
198.     t1$ = SPACE$(BMP.Size)
199.     _MEMGET n, n.OFFSET, t1$
200.     PUT #F, , t1$
201.     _MEMFREE n
202.     CLOSE #F
203.     _SOURCE s&
204. END SUB
205.  

Version here will now scale the image to fit the screen at the best possible resolution possible, without scaling it out of proportion and causing it to stretch or distort.   

[Ashish]

Hi Steve!
Nice program, but here are some issues which I'm having.

1. The photo that have been set up as desktop background have reduced image quality.
2. The photo is slightly shifted downwards. (Please see the screenshot below.

3. The location is actually "C:\Users\Public\Public Pictures\" instead of "C:\Users\Public\Pictures\"

[SMcNeill]

Ashish: A few questions:

What’s your screen’s resolution?  Images scale to a 4:3 ratio; is there any chance you’re running a 16:9 resolution?  It could account for the image discrepancy.

What’s the image resolution?  This “stretches” the image to keep the best resolution, without distorting the image.  If the screen is 1920x1200, and the image is 1920x1080, you’d see the blank section at the top and bottom, as the program would center the image for you, while maintaining the same aspect ratio.

As for the path, that’s something which needs to be edited for your own photo/image folder.  Mine is the one listed, but you might want to use yours with a private folder, or have a slightly varied path (like the Public/Public Pictures you mentioned). 

In the next version I offer, I’ll include options to allow easier folder selections, various resolution ratios, and the choice between “scaling and maintaining aspect ratio” vs “scaling to fill screen”.

Thank you kindly for the feedback.  It’s appreciated.  :)

[SMcNeill]

A new and improved version of the wallpaper changer, with a few more bells and whistles:

Code: QB64: [Select]

1. DECLARE DYNAMIC LIBRARY "user32"
2.     FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
3. END DECLARE
4.  
5. CONST SPI_SETDESKTOPWALLPAPER = &H0014
6. CONST SPI_UPDATEINIFILE = &H0001
7.  
8. CONST WaitBetweenChanges = 5 'seconds
9. CONST PhotoFolder = "C:\Users\Public\Pictures\"
10. CONST ScaleMode = 1 '0 to center, 1 to stretch while maintaining aspect ratio, 2 to stretch to fill screen
11. CONST 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.
12. 'The following settings are for calendar support, if wanted
13.  
14. CONST DrawCalander = -1 'draw the calender overlay, or not
15. CONST OffsetW = 10, OffsetH = 50 'Offset from bottom right corner of the screen.
16. '                                 Change OffsetW to move the calendar further to the left of your screen (W = Width)
17. '                                 Change OffsetH to move the calendar further up on your screen. (H = Height)
18. CONST Kolor = _RGBA32(255, 255, 255, 150) 'The color of the calendar and the text
19. CONST BackKolor = _RGBA32(0, 0, 255, 150) 'The color of the background which we see under the month
20.  
21. IF _FILEEXISTS("C:\ProgramData\PhotoList.txt") = 0 OR AlwaysRefreshListing THEN
22.     'will create the new listing if your directory doesn't contain one,
23.     'OR, will create one every time you run the program, if you set the flag to make it do so.
24.     PhotoList$ = PhotoFolder + "*.bmp " + PhotoFolder + "*.jpg " + PhotoFolder + "*.png " + PhotoFolder + "*.gif "
25.     SHELL "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
26. END IF
27.  
28. OPEN "C:\ProgramData\PhotoList.txt" FOR BINARY AS #1
29. DO UNTIL EOF(1)
30.     LINE INPUT #1, junk$
31.     PhotoCount = PhotoCount + 1
32. LOOP
33.  
34. SEEK #1, 1 'back to the beginning
35.  
36. DIM FileList(PhotoCount) AS STRING
37. FOR i = 1 TO PhotoCount
38.     LINE INPUT #1, FileList(i)
39.     FileList(i) = FileList(i) + CHR$(0)
40. NEXT
41.  
42. RANDOMIZE TIMER
43.  
44. SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
45. 'SCREEN _NEWIMAGE(640, 480, 32)
46. _SCREENMOVE _MIDDLE
47. _SCREENHIDE
48.  
49. _TITLE "Wallpaper Changer"
50.  
51. temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"
52.  
53. Today$ = DATE$ 'mm-dd-yyyy
54. Day = VAL(MID$(Today$, 4, 2))
55. Month = VAL(Today$)
56. Year = VAL(MID$(Today$, 7))
57. FirstDay = GetDay(Month, 1, Year)
58. SELECT CASE Month
59.     CASE 1, 3, 5, 7, 8, 10, 12
60.         DaysInMonth = 31
61.     CASE 2
62.         DaysInMonth = 28 'need to add leap year later.
63.     CASE 4, 6, 9, 11
64.         DaysInMonth = 30
65. END SELECT
66. SELECT CASE Month
67.     CASE 1: Month$ = "January"
68.     CASE 2: Month$ = "February"
69.     CASE 3: Month$ = "March"
70.     CASE 4: Month$ = "April"
71.     CASE 5: Month$ = "May"
72.     CASE 6: Month$ = "June"
73.     CASE 7: Month$ = "July"
74.     CASE 8: Month$ = "August"
75.     CASE 9: Month$ = "September"
76.     CASE 10: Month$ = "October"
77.     CASE 11: Month$ = "November"
78.     CASE 12: Month$ = "December"
79. END SELECT
80.  
81.  
82. _FONT 8
83. COLOR Kolor, 0
84.  
85. DO
86.     CLS
87.     loops = 0
88.     DO
89.         f = INT(RND * PhotoCount) + 1
90.         f$ = FileList(f)
91.         IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
92.             'I was lazy and didn't bother to just search for image files after all...
93.             f = _LOADIMAGE(f$, 32)
94.             IF f <> -1 THEN
95.                 w = _WIDTH(f): h = _HEIGHT(f)
96.                 scalew = _WIDTH / w: scaleh = _HEIGHT / h
97.                 SELECT CASE ScaleMode
98.                     CASE 0
99.                         _PUTIMAGE ((_WIDTH - w) \ 2, (_HEIGHT - h) \ 2)-STEP(w, h), f
100.                     CASE 1
101.                         IF scalew < scaleh THEN scale = scalew ELSE scale = scaleh
102.                         w1 = w * scale: h1 = h * scale
103.                         _PUTIMAGE ((_WIDTH - w1) \ 2, (_HEIGHT - h1) \ 2)-STEP(w1, h1), f
104.                     CASE 2
105.                         _PUTIMAGE , f
106.                 END SELECT
107.  
108.                 IF DrawCalander THEN
109.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH)-STEP(-175, -140), Kolor, B
110.                     FOR i = 1 TO 5
111.                         LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 20 * i)-STEP(-173, 0), Kolor
112.                     NEXT
113.                     FOR i = 1 TO 7
114.                         LINE (_WIDTH - OffsetW - 1 - i * 25, _HEIGHT - OffsetH - 1)-STEP(0, -118), Kolor
115.                     NEXT
116.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH - 120)-STEP(-175, 0), Kolor, B
117.                     LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 121)-STEP(-173, -18), BackKolor, BF
118.                     count = 0
119.                     FOR y = 1 TO 6 'weeks
120.                         FOR x = 1 TO 7 'days
121.                             IF (y - 1) * 7 + x >= FirstDay THEN
122.                                 count = count + 1
123.                                 IF count < DaysInMonth THEN
124.                                     t$ = _TRIM$(STR$(count))
125.                                     IF count = Day THEN
126.                                         LINE (_WIDTH - OffsetW - 175 + (x - 1) * 25, _HEIGHT - OffsetH - 120 + (y - 1) * 20)-STEP(23, 18), BackKolor, BF
127.                                     END IF
128.                                     _PRINTSTRING (_WIDTH - OffsetW - 163 + (x - 1) * 25 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 116 + (y - 1) * 20), t$
129.                                 END IF
130.                             END IF
131.                         NEXT
132.                     NEXT
133.                     t$ = Month$ + STR$(Year)
134.                     _PRINTSTRING (_WIDTH - OffsetW - 87 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 135), t$
135.                 END IF
136.  
137.                 SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
138.                 result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
139.                 result = -1
140.                 _FREEIMAGE f
141.             ELSE
142.                 loops = loops + 1
143.             END IF
144.         END IF
145.     LOOP UNTIL result OR loops > 100
146.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
147.     PRINT "Current Background: "; f$
148.     _DELAY WaitBetweenChanges
149. LOOP
150.  
151. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
152.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
153.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
154.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
155.  
156.     IF _PIXELSIZE(image&) = 0 THEN
157.         IF SaveTextAs256Color THEN
158.             tempimage& = TextScreenToImage256&(image&)
159.         ELSE
160.             tempimage& = TextScreenToImage32&(image&)
161.         END IF
162.         F = _FONT(image&)
163.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
164.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
165.         _FREEIMAGE tempimage&
166.         EXIT FUNCTION
167.     END IF
168.  
169.     TYPE BMPFormat
170.         ID AS STRING * 2
171.         Size AS LONG
172.         Blank AS LONG
173.         Offset AS LONG
174.         Hsize AS LONG
175.         PWidth AS LONG
176.         PDepth AS LONG
177.         Planes AS INTEGER
178.         BPP AS INTEGER
179.         Compression AS LONG
180.         ImageBytes AS LONG
181.         Xres AS LONG
182.         Yres AS LONG
183.         NumColors AS LONG
184.         SigColors AS LONG
185.     END TYPE
186.  
187.  
188.     DIM BMP AS BMPFormat
189.     DIM x AS LONG, y AS LONG
190.     DIM temp AS STRING
191.  
192.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
193.     m = _MEMIMAGE(image&)
194.  
195.     IF x1% > x2% THEN SWAP x1%, x2%
196.     IF y1% > y2% THEN SWAP y1%, y2%
197.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
198.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
199.  
200.     s& = _SOURCE
201.     _SOURCE image&
202.  
203.     BMP.PWidth = (x2% - x1%) + 1
204.     BMP.PDepth = (y2% - y1%) + 1
205.     BMP.ID = "BM"
206.     BMP.Blank = 0
207.     BMP.Hsize = 40
208.     BMP.Planes = 1
209.     BMP.Compression = 0
210.     BMP.Xres = 0
211.     BMP.Yres = 0
212.  
213.     BMP.SigColors = 0
214.  
215.     SELECT CASE _PIXELSIZE(image&)
216.         CASE 1
217.             temp = SPACE$(x2% - x1% + 1)
218.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
219.             BMP.BPP = 8
220.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
221.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
222.             BMP.ImageBytes = ImageSize&
223.             BMP.NumColors = 256
224.             BMP.Size = ImageSize& + OffsetBITS&
225.             BMP.Offset = OffsetBITS&
226.         CASE 4
227.             temp = SPACE$(3)
228.             OffsetBITS& = 54 'no palette in 24/32 bit
229.             BMP.BPP = 24
230.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
231.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
232.             BMP.ImageBytes = ImageSize&
233.             BMP.NumColors = 0
234.             BMP.Size = ImageSize& * 3 + OffsetBITS&
235.             BMP.Offset = OffsetBITS&
236.     END SELECT
237.  
238.     F = FREEFILE
239.     n = _MEMNEW(BMP.Size)
240.     _MEMPUT n, n.OFFSET, BMP
241.     o = n.OFFSET + 54
242.     zp& = LEN(ZeroPAD$)
243.     $CHECKING:OFF
244.  
245.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
246.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
247.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
248.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
249.             _MEMPUT n, o, b$
250.             o = o + 4
251.         NEXT
252.         y = y2% + 1
253.         w& = _WIDTH(image&)
254.         x = x2% - x1% + 1
255.         DO
256.             y = y - 1
257.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
258.             _MEMPUT n, o, temp
259.             o = o + x
260.             _MEMPUT n, o, ZeroPAD$
261.             o = o + zp&
262.         LOOP UNTIL y = y1%
263.     ELSE
264.         y = y2% + 1
265.         w& = _WIDTH(image&)
266.         DO
267.             y = y - 1: x = x1% - 1
268.             DO
269.                 x = x + 1
270.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
271.                 _MEMPUT n, o, temp
272.                 o = o + 3
273.             LOOP UNTIL x = x2%
274.             _MEMPUT n, o, ZeroPAD$
275.             o = o + zp&
276.         LOOP UNTIL y = y1%
277.     END IF
278.     $CHECKING:ON
279.     _MEMFREE m
280.     OPEN filename$ FOR BINARY AS #F
281.     t1$ = SPACE$(BMP.Size)
282.     _MEMGET n, n.OFFSET, t1$
283.     PUT #F, , t1$
284.     _MEMFREE n
285.     CLOSE #F
286.     _SOURCE s&
287. END SUB
288.  
289. FUNCTION GetDay (mm, dd, yyyy) 'use 4 digit year
290.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
291.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
292.     century = yyyy MOD 100
293.     zerocentury = yyyy \ 100
294.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
295.     IF result = 0 THEN
296.         GetDay = 7
297.     ELSE
298.         GetDay = result
299.     END IF
300.     'Function changed to return a numeric value instead of a string for this program
301.     '    SELECT CASE result
302.     '        CASE 7: GetDay$ = "Saturday"
303.     '        CASE 1: GetDay$ = "Sunday"
304.     '        CASE 2: GetDay$ = "Monday"
305.     '        CASE 3: GetDay$ = "Tuesday"
306.     '        CASE 4: GetDay$ = "Wednesday"
307.     '        CASE 5: GetDay$ = "Thursday"
308.     '        CASE 6: GetDay$ = "Friday"
309.     '    END SELECT
310. END FUNCTION
311.  
312.  

It now has an option to use the Scale Mode you like -- Center the image, Scale with aspect ratio, Scale to fill screen.

It now uses your native display settings to determine what size images to use, so it doesn't reduce quality as much.

You can now display a calendar on the screen, if you want to do that sort of thing.  (Without one, I have no idea what day of the week/month it currently is.)

You can now set it to always refresh the image file list on program start, if you want.

And it now hides itself (and Windows 10 also hides its icon for us), letting it run as a background process inside Task Manager.  This is really useful, if you want to add this to your list of startup programs and don't want to have it on your taskbar to have it taking up real estate there.  ;)

[SMcNeill]

A few screenshots of my desktop with the little calendar positioned in the bottom right of the wallpaper.

(The second screenshot also illustrates why we'd want to stretch to fit the screen, rather than just stretching to fill the screen completely.  Can you imagine the distortion of we blew that image up to go from side to side and fill the whole screen?)

[Ashish]

Hi Steve!
I got "input past end of file on line 30". :'(

Code: QB64: [Select]

1. DECLARE DYNAMIC LIBRARY "user32"
2.     FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
3. END DECLARE
4.  
5. CONST SPI_SETDESKTOPWALLPAPER = &H0014
6. CONST SPI_UPDATEINIFILE = &H0001
7.  
8. CONST WaitBetweenChanges = 5 'seconds
9. CONST PhotoFolder = "C:\Users\Ayush\Pictures\Screenshots"
10. CONST ScaleMode = 1 '0 to center, 1 to stretch while maintaining aspect ratio, 2 to stretch to fill screen
11. CONST AlwaysRefreshListing = -1 '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.
12. 'The following settings are for calendar support, if wanted
13.  
14. CONST DrawCalander = -1 'draw the calender overlay, or not
15. CONST OffsetW = 10, OffsetH = 50 'Offset from bottom right corner of the screen.
16. '                                 Change OffsetW to move the calendar further to the left of your screen (W = Width)
17. '                                 Change OffsetH to move the calendar further up on your screen. (H = Height)
18. CONST Kolor = _RGBA32(255, 255, 255, 150) 'The color of the calendar and the text
19. CONST BackKolor = _RGBA32(0, 0, 255, 150) 'The color of the background which we see under the month
20. KILL "C:\ProgramData\PhotoList.txt"
21. IF _FILEEXISTS("C:\ProgramData\PhotoList.txt") = 0 OR AlwaysRefreshListing THEN
22.     'will create the new listing if your directory doesn't contain one,
23.     'OR, will create one every time you run the program, if you set the flag to make it do so.
24.     PhotoList$ = PhotoFolder + "*.png "
25.     SHELL "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
26. END IF
27.  
28. OPEN "C:\ProgramData\PhotoList.txt" FOR BINARY AS #1
29. DO UNTIL EOF(1)
30.     LINE INPUT #1, junk$
31.     PhotoCount = PhotoCount + 1
32. LOOP
33.  
34. SEEK #1, 1 'back to the beginning
35.  
36. DIM FileList(PhotoCount) AS STRING
37. FOR i = 1 TO PhotoCount
38.     LINE INPUT #1, FileList(i)
39.     FileList(i) = FileList(i) + CHR$(0)
40. NEXT
41.  
42. RANDOMIZE TIMER
43.  
44. SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
45. 'SCREEN _NEWIMAGE(640, 480, 32)
46. _SCREENMOVE _MIDDLE
47. _SCREENHIDE
48.  
49. _TITLE "Wallpaper Changer"
50.  
51. temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"
52.  
53. Today$ = DATE$ 'mm-dd-yyyy
54. Day = VAL(MID$(Today$, 4, 2))
55. Month = VAL(Today$)
56. Year = VAL(MID$(Today$, 7))
57. FirstDay = GetDay(Month, 1, Year)
58. SELECT CASE Month
59.     CASE 1, 3, 5, 7, 8, 10, 12
60.         DaysInMonth = 31
61.     CASE 2
62.         DaysInMonth = 28 'need to add leap year later.
63.     CASE 4, 6, 9, 11
64.         DaysInMonth = 30
65. END SELECT
66. SELECT CASE Month
67.     CASE 1: Month$ = "January"
68.     CASE 2: Month$ = "February"
69.     CASE 3: Month$ = "March"
70.     CASE 4: Month$ = "April"
71.     CASE 5: Month$ = "May"
72.     CASE 6: Month$ = "June"
73.     CASE 7: Month$ = "July"
74.     CASE 8: Month$ = "August"
75.     CASE 9: Month$ = "September"
76.     CASE 10: Month$ = "October"
77.     CASE 11: Month$ = "November"
78.     CASE 12: Month$ = "December"
79. END SELECT
80.  
81.  
82. _FONT 8
83. COLOR Kolor, 0
84.  
85. DO
86.     CLS
87.     loops = 0
88.     DO
89.         f = INT(RND * PhotoCount) + 1
90.         f$ = FileList(f)
91.         IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
92.             'I was lazy and didn't bother to just search for image files after all...
93.             f = _LOADIMAGE(f$, 32)
94.             IF f <> -1 THEN
95.                 w = _WIDTH(f): h = _HEIGHT(f)
96.                 scalew = _WIDTH / w: scaleh = _HEIGHT / h
97.                 SELECT CASE ScaleMode
98.                     CASE 0
99.                         _PUTIMAGE ((_WIDTH - w) \ 2, (_HEIGHT - h) \ 2)-STEP(w, h), f
100.                     CASE 1
101.                         IF scalew < scaleh THEN scale = scalew ELSE scale = scaleh
102.                         w1 = w * scale: h1 = h * scale
103.                         _PUTIMAGE ((_WIDTH - w1) \ 2, (_HEIGHT - h1) \ 2)-STEP(w1, h1), f
104.                     CASE 2
105.                         _PUTIMAGE , f
106.                 END SELECT
107.  
108.                 IF DrawCalander THEN
109.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH)-STEP(-175, -140), Kolor, B
110.                     FOR i = 1 TO 5
111.                         LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 20 * i)-STEP(-173, 0), Kolor
112.                     NEXT
113.                     FOR i = 1 TO 7
114.                         LINE (_WIDTH - OffsetW - 1 - i * 25, _HEIGHT - OffsetH - 1)-STEP(0, -118), Kolor
115.                     NEXT
116.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH - 120)-STEP(-175, 0), Kolor, B
117.                     LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 121)-STEP(-173, -18), BackKolor, BF
118.                     count = 0
119.                     FOR y = 1 TO 6 'weeks
120.                         FOR x = 1 TO 7 'days
121.                             IF (y - 1) * 7 + x >= FirstDay THEN
122.                                 count = count + 1
123.                                 IF count < DaysInMonth THEN
124.                                     t$ = _TRIM$(STR$(count))
125.                                     IF count = Day THEN
126.                                         LINE (_WIDTH - OffsetW - 175 + (x - 1) * 25, _HEIGHT - OffsetH - 120 + (y - 1) * 20)-STEP(23, 18), BackKolor, BF
127.                                     END IF
128.                                     _PRINTSTRING (_WIDTH - OffsetW - 163 + (x - 1) * 25 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 116 + (y - 1) * 20), t$
129.                                 END IF
130.                             END IF
131.                         NEXT
132.                     NEXT
133.                     t$ = Month$ + STR$(Year)
134.                     _PRINTSTRING (_WIDTH - OffsetW - 87 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 135), t$
135.                 END IF
136.  
137.                 SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
138.                 result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
139.                 result = -1
140.                 _FREEIMAGE f
141.             ELSE
142.                 loops = loops + 1
143.             END IF
144.         END IF
145.     LOOP UNTIL result OR loops > 100
146.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
147.     PRINT "Current Background: "; f$
148.     _DELAY WaitBetweenChanges
149. LOOP
150.  
151. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
152.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
153.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
154.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
155.  
156.     IF _PIXELSIZE(image&) = 0 THEN
157.         IF SaveTextAs256Color THEN
158.             tempimage& = TextScreenToImage256&(image&)
159.         ELSE
160.             tempimage& = TextScreenToImage32&(image&)
161.         END IF
162.         F = _FONT(image&)
163.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
164.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
165.         _FREEIMAGE tempimage&
166.         EXIT FUNCTION
167.     END IF
168.  
169.     TYPE BMPFormat
170.         ID AS STRING * 2
171.         Size AS LONG
172.         Blank AS LONG
173.         Offset AS LONG
174.         Hsize AS LONG
175.         PWidth AS LONG
176.         PDepth AS LONG
177.         Planes AS INTEGER
178.         BPP AS INTEGER
179.         Compression AS LONG
180.         ImageBytes AS LONG
181.         Xres AS LONG
182.         Yres AS LONG
183.         NumColors AS LONG
184.         SigColors AS LONG
185.     END TYPE
186.  
187.  
188.     DIM BMP AS BMPFormat
189.     DIM x AS LONG, y AS LONG
190.     DIM temp AS STRING
191.  
192.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
193.     m = _MEMIMAGE(image&)
194.  
195.     IF x1% > x2% THEN SWAP x1%, x2%
196.     IF y1% > y2% THEN SWAP y1%, y2%
197.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
198.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
199.  
200.     s& = _SOURCE
201.     _SOURCE image&
202.  
203.     BMP.PWidth = (x2% - x1%) + 1
204.     BMP.PDepth = (y2% - y1%) + 1
205.     BMP.ID = "BM"
206.     BMP.Blank = 0
207.     BMP.Hsize = 40
208.     BMP.Planes = 1
209.     BMP.Compression = 0
210.     BMP.Xres = 0
211.     BMP.Yres = 0
212.  
213.     BMP.SigColors = 0
214.  
215.     SELECT CASE _PIXELSIZE(image&)
216.         CASE 1
217.             temp = SPACE$(x2% - x1% + 1)
218.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
219.             BMP.BPP = 8
220.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
221.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
222.             BMP.ImageBytes = ImageSize&
223.             BMP.NumColors = 256
224.             BMP.Size = ImageSize& + OffsetBITS&
225.             BMP.Offset = OffsetBITS&
226.         CASE 4
227.             temp = SPACE$(3)
228.             OffsetBITS& = 54 'no palette in 24/32 bit
229.             BMP.BPP = 24
230.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
231.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
232.             BMP.ImageBytes = ImageSize&
233.             BMP.NumColors = 0
234.             BMP.Size = ImageSize& * 3 + OffsetBITS&
235.             BMP.Offset = OffsetBITS&
236.     END SELECT
237.  
238.     F = FREEFILE
239.     n = _MEMNEW(BMP.Size)
240.     _MEMPUT n, n.OFFSET, BMP
241.     o = n.OFFSET + 54
242.     zp& = LEN(ZeroPAD$)
243.     $CHECKING:OFF
244.  
245.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
246.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
247.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
248.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
249.             _MEMPUT n, o, b$
250.             o = o + 4
251.         NEXT
252.         y = y2% + 1
253.         w& = _WIDTH(image&)
254.         x = x2% - x1% + 1
255.         DO
256.             y = y - 1
257.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
258.             _MEMPUT n, o, temp
259.             o = o + x
260.             _MEMPUT n, o, ZeroPAD$
261.             o = o + zp&
262.         LOOP UNTIL y = y1%
263.     ELSE
264.         y = y2% + 1
265.         w& = _WIDTH(image&)
266.         DO
267.             y = y - 1: x = x1% - 1
268.             DO
269.                 x = x + 1
270.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
271.                 _MEMPUT n, o, temp
272.                 o = o + 3
273.             LOOP UNTIL x = x2%
274.             _MEMPUT n, o, ZeroPAD$
275.             o = o + zp&
276.         LOOP UNTIL y = y1%
277.     END IF
278.     $CHECKING:ON
279.     _MEMFREE m
280.     OPEN filename$ FOR BINARY AS #F
281.     t1$ = SPACE$(BMP.Size)
282.     _MEMGET n, n.OFFSET, t1$
283.     PUT #F, , t1$
284.     _MEMFREE n
285.     CLOSE #F
286.     _SOURCE s&
287. END SUB
288.  
289. FUNCTION GetDay (mm, dd, yyyy) 'use 4 digit year
290.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
291.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
292.     century = yyyy MOD 100
293.     zerocentury = yyyy \ 100
294.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
295.     IF result = 0 THEN
296.         GetDay = 7
297.     ELSE
298.         GetDay = result
299.     END IF
300.     'Function changed to return a numeric value instead of a string for this program
301.     '    SELECT CASE result
302.     '        CASE 7: GetDay$ = "Saturday"
303.     '        CASE 1: GetDay$ = "Sunday"
304.     '        CASE 2: GetDay$ = "Monday"
305.     '        CASE 3: GetDay$ = "Tuesday"
306.     '        CASE 4: GetDay$ = "Wednesday"
307.     '        CASE 5: GetDay$ = "Thursday"
308.     '        CASE 6: GetDay$ = "Friday"
309.     '    END SELECT
310. END FUNCTION
311.  
312.  

[Ashish]

Ashish: A few questions:

What’s your screen’s resolution?  Images scale to a 4:3 ratio; is there any chance you’re running a 16:9 resolution?  It could account for the image discrepancy.

What’s the image resolution?  This “stretches” the image to keep the best resolution, without distorting the image.  If the screen is 1920x1200, and the image is 1920x1080, you’d see the blank section at the top and bottom, as the program would center the image for you, while maintaining the same aspect ratio.

As for the path, that’s something which needs to be edited for your own photo/image folder.  Mine is the one listed, but you might want to use yours with a private folder, or have a slightly varied path (like the Public/Public Pictures you mentioned). 

In the next version I offer, I’ll include options to allow easier folder selections, various resolution ratios, and the choice between “scaling and maintaining aspect ratio” vs “scaling to fill screen”.

Thank you kindly for the feedback.  It’s appreciated.  :)

Display resolution : 1366 x 768
Image resolution : 1366 x 768
Yes, I'm running 16:9 ratio display.

Thanks.

[SMcNeill]

Hi Steve!
I got "input past end of file on line 30". :'(

Code: QB64: [Select]

1. DECLARE DYNAMIC LIBRARY "user32"
2.     FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
3. END DECLARE
4.  
5. CONST SPI_SETDESKTOPWALLPAPER = &H0014
6. CONST SPI_UPDATEINIFILE = &H0001
7.  
8. CONST WaitBetweenChanges = 5 'seconds
9. CONST PhotoFolder = "C:\Users\Ayush\Pictures\Screenshots"
10. CONST ScaleMode = 1 '0 to center, 1 to stretch while maintaining aspect ratio, 2 to stretch to fill screen
11. CONST AlwaysRefreshListing = -1 '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.
12. 'The following settings are for calendar support, if wanted
13.  
14. CONST DrawCalander = -1 'draw the calender overlay, or not
15. CONST OffsetW = 10, OffsetH = 50 'Offset from bottom right corner of the screen.
16. '                                 Change OffsetW to move the calendar further to the left of your screen (W = Width)
17. '                                 Change OffsetH to move the calendar further up on your screen. (H = Height)
18. CONST Kolor = _RGBA32(255, 255, 255, 150) 'The color of the calendar and the text
19. CONST BackKolor = _RGBA32(0, 0, 255, 150) 'The color of the background which we see under the month
20. KILL "C:\ProgramData\PhotoList.txt"
21. IF _FILEEXISTS("C:\ProgramData\PhotoList.txt") = 0 OR AlwaysRefreshListing THEN
22.     'will create the new listing if your directory doesn't contain one,
23.     'OR, will create one every time you run the program, if you set the flag to make it do so.
24.     PhotoList$ = PhotoFolder + "*.png "
25.     SHELL "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
26. END IF
27.  
28. OPEN "C:\ProgramData\PhotoList.txt" FOR BINARY AS #1
29. DO UNTIL EOF(1)
30.     LINE INPUT #1, junk$
31.     PhotoCount = PhotoCount + 1
32. LOOP
33.  
34. SEEK #1, 1 'back to the beginning
35.  
36. DIM FileList(PhotoCount) AS STRING
37. FOR i = 1 TO PhotoCount
38.     LINE INPUT #1, FileList(i)
39.     FileList(i) = FileList(i) + CHR$(0)
40. NEXT
41.  
42. RANDOMIZE TIMER
43.  
44. SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
45. 'SCREEN _NEWIMAGE(640, 480, 32)
46. _SCREENMOVE _MIDDLE
47. _SCREENHIDE
48.  
49. _TITLE "Wallpaper Changer"
50.  
51. temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"
52.  
53. Today$ = DATE$ 'mm-dd-yyyy
54. Day = VAL(MID$(Today$, 4, 2))
55. Month = VAL(Today$)
56. Year = VAL(MID$(Today$, 7))
57. FirstDay = GetDay(Month, 1, Year)
58. SELECT CASE Month
59.     CASE 1, 3, 5, 7, 8, 10, 12
60.         DaysInMonth = 31
61.     CASE 2
62.         DaysInMonth = 28 'need to add leap year later.
63.     CASE 4, 6, 9, 11
64.         DaysInMonth = 30
65. END SELECT
66. SELECT CASE Month
67.     CASE 1: Month$ = "January"
68.     CASE 2: Month$ = "February"
69.     CASE 3: Month$ = "March"
70.     CASE 4: Month$ = "April"
71.     CASE 5: Month$ = "May"
72.     CASE 6: Month$ = "June"
73.     CASE 7: Month$ = "July"
74.     CASE 8: Month$ = "August"
75.     CASE 9: Month$ = "September"
76.     CASE 10: Month$ = "October"
77.     CASE 11: Month$ = "November"
78.     CASE 12: Month$ = "December"
79. END SELECT
80.  
81.  
82. _FONT 8
83. COLOR Kolor, 0
84.  
85. DO
86.     CLS
87.     loops = 0
88.     DO
89.         f = INT(RND * PhotoCount) + 1
90.         f$ = FileList(f)
91.         IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
92.             'I was lazy and didn't bother to just search for image files after all...
93.             f = _LOADIMAGE(f$, 32)
94.             IF f <> -1 THEN
95.                 w = _WIDTH(f): h = _HEIGHT(f)
96.                 scalew = _WIDTH / w: scaleh = _HEIGHT / h
97.                 SELECT CASE ScaleMode
98.                     CASE 0
99.                         _PUTIMAGE ((_WIDTH - w) \ 2, (_HEIGHT - h) \ 2)-STEP(w, h), f
100.                     CASE 1
101.                         IF scalew < scaleh THEN scale = scalew ELSE scale = scaleh
102.                         w1 = w * scale: h1 = h * scale
103.                         _PUTIMAGE ((_WIDTH - w1) \ 2, (_HEIGHT - h1) \ 2)-STEP(w1, h1), f
104.                     CASE 2
105.                         _PUTIMAGE , f
106.                 END SELECT
107.  
108.                 IF DrawCalander THEN
109.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH)-STEP(-175, -140), Kolor, B
110.                     FOR i = 1 TO 5
111.                         LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 20 * i)-STEP(-173, 0), Kolor
112.                     NEXT
113.                     FOR i = 1 TO 7
114.                         LINE (_WIDTH - OffsetW - 1 - i * 25, _HEIGHT - OffsetH - 1)-STEP(0, -118), Kolor
115.                     NEXT
116.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH - 120)-STEP(-175, 0), Kolor, B
117.                     LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 121)-STEP(-173, -18), BackKolor, BF
118.                     count = 0
119.                     FOR y = 1 TO 6 'weeks
120.                         FOR x = 1 TO 7 'days
121.                             IF (y - 1) * 7 + x >= FirstDay THEN
122.                                 count = count + 1
123.                                 IF count < DaysInMonth THEN
124.                                     t$ = _TRIM$(STR$(count))
125.                                     IF count = Day THEN
126.                                         LINE (_WIDTH - OffsetW - 175 + (x - 1) * 25, _HEIGHT - OffsetH - 120 + (y - 1) * 20)-STEP(23, 18), BackKolor, BF
127.                                     END IF
128.                                     _PRINTSTRING (_WIDTH - OffsetW - 163 + (x - 1) * 25 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 116 + (y - 1) * 20), t$
129.                                 END IF
130.                             END IF
131.                         NEXT
132.                     NEXT
133.                     t$ = Month$ + STR$(Year)
134.                     _PRINTSTRING (_WIDTH - OffsetW - 87 - _PRINTWIDTH(t$) \ 2, _HEIGHT - OffsetH - 135), t$
135.                 END IF
136.  
137.                 SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
138.                 result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
139.                 result = -1
140.                 _FREEIMAGE f
141.             ELSE
142.                 loops = loops + 1
143.             END IF
144.         END IF
145.     LOOP UNTIL result OR loops > 100
146.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
147.     PRINT "Current Background: "; f$
148.     _DELAY WaitBetweenChanges
149. LOOP
150.  
151. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
152.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
153.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
154.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
155.  
156.     IF _PIXELSIZE(image&) = 0 THEN
157.         IF SaveTextAs256Color THEN
158.             tempimage& = TextScreenToImage256&(image&)
159.         ELSE
160.             tempimage& = TextScreenToImage32&(image&)
161.         END IF
162.         F = _FONT(image&)
163.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
164.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
165.         _FREEIMAGE tempimage&
166.         EXIT FUNCTION
167.     END IF
168.  
169.     TYPE BMPFormat
170.         ID AS STRING * 2
171.         Size AS LONG
172.         Blank AS LONG
173.         Offset AS LONG
174.         Hsize AS LONG
175.         PWidth AS LONG
176.         PDepth AS LONG
177.         Planes AS INTEGER
178.         BPP AS INTEGER
179.         Compression AS LONG
180.         ImageBytes AS LONG
181.         Xres AS LONG
182.         Yres AS LONG
183.         NumColors AS LONG
184.         SigColors AS LONG
185.     END TYPE
186.  
187.  
188.     DIM BMP AS BMPFormat
189.     DIM x AS LONG, y AS LONG
190.     DIM temp AS STRING
191.  
192.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
193.     m = _MEMIMAGE(image&)
194.  
195.     IF x1% > x2% THEN SWAP x1%, x2%
196.     IF y1% > y2% THEN SWAP y1%, y2%
197.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
198.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
199.  
200.     s& = _SOURCE
201.     _SOURCE image&
202.  
203.     BMP.PWidth = (x2% - x1%) + 1
204.     BMP.PDepth = (y2% - y1%) + 1
205.     BMP.ID = "BM"
206.     BMP.Blank = 0
207.     BMP.Hsize = 40
208.     BMP.Planes = 1
209.     BMP.Compression = 0
210.     BMP.Xres = 0
211.     BMP.Yres = 0
212.  
213.     BMP.SigColors = 0
214.  
215.     SELECT CASE _PIXELSIZE(image&)
216.         CASE 1
217.             temp = SPACE$(x2% - x1% + 1)
218.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
219.             BMP.BPP = 8
220.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
221.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
222.             BMP.ImageBytes = ImageSize&
223.             BMP.NumColors = 256
224.             BMP.Size = ImageSize& + OffsetBITS&
225.             BMP.Offset = OffsetBITS&
226.         CASE 4
227.             temp = SPACE$(3)
228.             OffsetBITS& = 54 'no palette in 24/32 bit
229.             BMP.BPP = 24
230.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
231.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
232.             BMP.ImageBytes = ImageSize&
233.             BMP.NumColors = 0
234.             BMP.Size = ImageSize& * 3 + OffsetBITS&
235.             BMP.Offset = OffsetBITS&
236.     END SELECT
237.  
238.     F = FREEFILE
239.     n = _MEMNEW(BMP.Size)
240.     _MEMPUT n, n.OFFSET, BMP
241.     o = n.OFFSET + 54
242.     zp& = LEN(ZeroPAD$)
243.     $CHECKING:OFF
244.  
245.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
246.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
247.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
248.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
249.             _MEMPUT n, o, b$
250.             o = o + 4
251.         NEXT
252.         y = y2% + 1
253.         w& = _WIDTH(image&)
254.         x = x2% - x1% + 1
255.         DO
256.             y = y - 1
257.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
258.             _MEMPUT n, o, temp
259.             o = o + x
260.             _MEMPUT n, o, ZeroPAD$
261.             o = o + zp&
262.         LOOP UNTIL y = y1%
263.     ELSE
264.         y = y2% + 1
265.         w& = _WIDTH(image&)
266.         DO
267.             y = y - 1: x = x1% - 1
268.             DO
269.                 x = x + 1
270.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
271.                 _MEMPUT n, o, temp
272.                 o = o + 3
273.             LOOP UNTIL x = x2%
274.             _MEMPUT n, o, ZeroPAD$
275.             o = o + zp&
276.         LOOP UNTIL y = y1%
277.     END IF
278.     $CHECKING:ON
279.     _MEMFREE m
280.     OPEN filename$ FOR BINARY AS #F
281.     t1$ = SPACE$(BMP.Size)
282.     _MEMGET n, n.OFFSET, t1$
283.     PUT #F, , t1$
284.     _MEMFREE n
285.     CLOSE #F
286.     _SOURCE s&
287. END SUB
288.  
289. FUNCTION GetDay (mm, dd, yyyy) 'use 4 digit year
290.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
291.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
292.     century = yyyy MOD 100
293.     zerocentury = yyyy \ 100
294.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
295.     IF result = 0 THEN
296.         GetDay = 7
297.     ELSE
298.         GetDay = result
299.     END IF
300.     'Function changed to return a numeric value instead of a string for this program
301.     '    SELECT CASE result
302.     '        CASE 7: GetDay$ = "Saturday"
303.     '        CASE 1: GetDay$ = "Sunday"
304.     '        CASE 2: GetDay$ = "Monday"
305.     '        CASE 3: GetDay$ = "Tuesday"
306.     '        CASE 4: GetDay$ = "Wednesday"
307.     '        CASE 5: GetDay$ = "Thursday"
308.     '        CASE 6: GetDay$ = "Friday"
309.     '    END SELECT
310. END FUNCTION
311.  
312.  

I’m betting if you look at the file it created, it’s size is zero bytes...

Why?? 

Good question!  Take a look at where you changed this one line of code:

Code: QB64: [Select]

1. CONST PhotoFolder = "C:\Users\Ayush\Pictures\Screenshots"

Then compare it to the original:

Code: QB64: [Select]

1. CONST PhotoFolder = “C:\Users\Public\Photos\”

What’s the big difference?  Look close...

The \ at the end!  ;D

You’re getting a listing of basically:  DIR C:\Users\Ayushi\Pictures\Screenshots*.png, and I’d be surprised if that’s what you intended.  I imagine a missing slash at the end of that line is all you’d need to fix the problem.  ;)

[Ashish]

Cool Steve! It works now.