Author Topic: Windows Wallpaper Changer  (Read 7039 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline SMcNeill

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

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.

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Windows Wallpaper Changer
« Reply #1 on: January 27, 2019, 01:07:55 pm »
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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Windows Wallpaper Changer
« Reply #2 on: January 29, 2019, 09:13:57 am »
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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #3 on: January 29, 2019, 10:14:57 am »
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?
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Windows Wallpaper Changer
« Reply #4 on: January 29, 2019, 12:52:06 pm »
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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #5 on: January 29, 2019, 01:09:46 pm »
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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #6 on: April 06, 2019, 07:43:09 pm »
Updated version of this little background wallpaper flipper:

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

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.   
« Last Edit: April 06, 2019, 07:46:32 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Windows Wallpaper Changer
« Reply #7 on: April 08, 2019, 03:46:42 am »
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.
Screenshot_1.png
3. The location is actually "C:\Users\Public\Public Pictures\" instead of "C:\Users\Public\Pictures\"
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #8 on: April 08, 2019, 11:20:10 am »
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.  :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #9 on: April 08, 2019, 02:19:36 pm »
A new and improved version of the wallpaper changer, with a few more bells and whistles:

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

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.  ;)
« Last Edit: April 08, 2019, 02:58:03 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #10 on: April 08, 2019, 05:47:22 pm »
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?)



desktop.jpg
* desktop.jpg (Filesize: 316.83 KB, Dimensions: 1920x1080, Views: 261)
desktop2.jpg
* desktop2.jpg (Filesize: 182.69 KB, Dimensions: 1920x1080, Views: 267)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Ashish

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


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Windows Wallpaper Changer
« Reply #12 on: April 09, 2019, 12:38:43 pm »
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.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline SMcNeill

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

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.  ;)
« Last Edit: April 09, 2019, 01:19:19 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Windows Wallpaper Changer
« Reply #14 on: April 10, 2019, 02:54:59 am »
Cool Steve! It works now.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials