Author Topic: Windows Wallpaper Changer  (Read 7038 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #15 on: June 05, 2019, 10:42:05 am »
Minor patch to fix a day missing from the calendar:

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

The only difference is down on line 123, where we change the:

                                IF count < DaysInMonth THEN

to:

                                IF count <= DaysInMonth THEN


(See that little equal sign added to the code?  Such a simple glitch, and I'm amazed it took me so long to notice that a whole day was missing from my makeshift calendar!)
« Last Edit: June 05, 2019, 10:43:10 am 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 #16 on: June 06, 2019, 12:07:32 pm »
Another minor patch to the calendar.  It was only getting the day when the program started, and not updating it as time passed.

Code: [Select]
DECLARE DYNAMIC LIBRARY "user32"
    FUNCTION SystemParametersInfoA& (BYVAL uiAction~&, BYVAL uiParam~&, pvParam$, BYVAL fWinlni~&)
END DECLARE

CONST SPI_SETDESKTOPWALLPAPER = &H0014
CONST SPI_UPDATEINIFILE = &H0001

CONST WaitBetweenChanges = 5 'seconds
CONST PhotoFolder = "C:\Users\Public\Pictures\"
CONST ScaleMode = 1 '0 to center, 1 to stretch while maintaining aspect ratio, 2 to stretch to fill screen
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.
'The following settings are for calendar support, if wanted

CONST DrawCalander = -1 'draw the calender overlay, or not
CONST OffsetW = 10, OffsetH = 50 'Offset from bottom right corner of the screen.
'                                 Change OffsetW to move the calendar further to the left of your screen (W = Width)
'                                 Change OffsetH to move the calendar further up on your screen. (H = Height)
CONST Kolor = _RGBA32(255, 255, 255, 150) 'The color of the calendar and the text
CONST BackKolor = _RGBA32(0, 0, 255, 150) 'The color of the background which we see under the month

IF _FILEEXISTS("C:\ProgramData\PhotoList.txt") = 0 OR AlwaysRefreshListing THEN
    'will create the new listing if your directory doesn't contain one,
    'OR, will create one every time you run the program, if you set the flag to make it do so.
    PhotoList$ = PhotoFolder + "*.bmp " + PhotoFolder + "*.jpg " + PhotoFolder + "*.png " + PhotoFolder + "*.gif "
    SHELL "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
END IF

OPEN "C:\ProgramData\PhotoList.txt" FOR BINARY AS #1
DO UNTIL EOF(1)
    LINE INPUT #1, junk$
    PhotoCount = PhotoCount + 1
LOOP

SEEK #1, 1 'back to the beginning

DIM FileList(PhotoCount) AS STRING
FOR i = 1 TO PhotoCount
    LINE INPUT #1, FileList(i)
    FileList(i) = FileList(i) + CHR$(0)
NEXT

RANDOMIZE TIMER

SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
'SCREEN _NEWIMAGE(640, 480, 32)
_SCREENMOVE _MIDDLE
_SCREENHIDE

_TITLE "Wallpaper Changer"

temp$ = "C:\ProgramData\Wallpaper Changer Image.bmp"

Today$ = DATE$ 'mm-dd-yyyy
Day = VAL(MID$(Today$, 4, 2))
Month = VAL(Today$)
Year = VAL(MID$(Today$, 7))
FirstDay = GetDay(Month, 1, Year)
SELECT CASE Month
    CASE 1, 3, 5, 7, 8, 10, 12
        DaysInMonth = 31
    CASE 2
        DaysInMonth = 28 'need to add leap year later.
    CASE 4, 6, 9, 11
        DaysInMonth = 30
END SELECT
SELECT CASE Month
    CASE 1: Month$ = "January"
    CASE 2: Month$ = "February"
    CASE 3: Month$ = "March"
    CASE 4: Month$ = "April"
    CASE 5: Month$ = "May"
    CASE 6: Month$ = "June"
    CASE 7: Month$ = "July"
    CASE 8: Month$ = "August"
    CASE 9: Month$ = "September"
    CASE 10: Month$ = "October"
    CASE 11: Month$ = "November"
    CASE 12: Month$ = "December"
END SELECT


_FONT 8
COLOR Kolor, 0

DO
    CLS
    loops = 0
    DO
        f = INT(RND * PhotoCount) + 1
        f$ = FileList(f)
        IF _FILEEXISTS(f$) THEN 'try a few times in case invalid files (like TXT files) are in the list.
            'I was lazy and didn't bother to just search for image files after all...
            f = _LOADIMAGE(f$, 32)
            IF f <> -1 THEN
                w = _WIDTH(f): h = _HEIGHT(f)
                scalew = _WIDTH / w: scaleh = _HEIGHT / h
                SELECT CASE ScaleMode
                    CASE 0
                        _PUTIMAGE ((_WIDTH - w) \ 2, (_HEIGHT - h) \ 2)-STEP(w, h), f
                    CASE 1
                        IF scalew < scaleh THEN scale = scalew ELSE scale = scaleh
                        w1 = w * scale: h1 = h * scale
                        _PUTIMAGE ((_WIDTH - w1) \ 2, (_HEIGHT - h1) \ 2)-STEP(w1, h1), f
                    CASE 2
                        _PUTIMAGE , f
                END SELECT

                IF DrawCalander THEN
                    Day = VAL(MID$(DATE$, 4, 2))
                    LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH)-STEP(-175, -140), Kolor, B
                    FOR i = 1 TO 5
                        LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 20 * i)-STEP(-173, 0), Kolor
                    NEXT
                    FOR i = 1 TO 7
                        LINE (_WIDTH - OffsetW - 1 - i * 25, _HEIGHT - OffsetH - 1)-STEP(0, -118), Kolor
                    NEXT
                    LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH - 120)-STEP(-175, 0), Kolor, B
                    LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 121)-STEP(-173, -18), BackKolor, BF
                    count = 0
                    FOR y = 1 TO 6 'weeks
                        FOR x = 1 TO 7 'days
                            IF (y - 1) * 7 + x >= FirstDay THEN
                                count = count + 1
                                IF count <= DaysInMonth THEN
                                    T$ = _TRIM$(STR$(count))
                                    IF count = Day THEN
                                        LINE (_WIDTH - OffsetW - 175 + (x - 1) * 25, _HEIGHT - OffsetH - 120 + (y - 1) * 20)-STEP(23, 18), BackKolor, BF
                                    END IF
                                    _PRINTSTRING (_WIDTH - OffsetW - 163 + (x - 1) * 25 - _PRINTWIDTH(T$) \ 2, _HEIGHT - OffsetH - 116 + (y - 1) * 20), T$
                                END IF
                            END IF
                        NEXT
                    NEXT
                    T$ = Month$ + STR$(Year)
                    _PRINTSTRING (_WIDTH - OffsetW - 87 - _PRINTWIDTH(T$) \ 2, _HEIGHT - OffsetH - 135), T$
                END IF

                SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
                result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
                result = -1
                _FREEIMAGE f
            ELSE
                loops = loops + 1
            END IF
        END IF
    LOOP UNTIL result OR loops > 100
    IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": END
    PRINT "Current Background: "; f$
    _DELAY WaitBetweenChanges
LOOP

SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
    'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
    IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
    IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1

    IF _PIXELSIZE(image&) = 0 THEN
        IF SaveTextAs256Color THEN
            tempimage& = TextScreenToImage256&(image&)
        ELSE
            tempimage& = TextScreenToImage32&(image&)
        END IF
        F = _FONT(image&)
        FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
        SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
        _FREEIMAGE tempimage&
        EXIT FUNCTION
    END IF

    TYPE BMPFormat
        ID AS STRING * 2
        Size AS LONG
        Blank AS LONG
        Offset AS LONG
        Hsize AS LONG
        PWidth AS LONG
        PDepth AS LONG
        Planes AS INTEGER
        BPP AS INTEGER
        Compression AS LONG
        ImageBytes AS LONG
        Xres AS LONG
        Yres AS LONG
        NumColors AS LONG
        SigColors AS LONG
    END TYPE


    DIM BMP AS BMPFormat
    DIM x AS LONG, y AS LONG
    DIM temp AS STRING

    DIM n AS _MEM, o AS _OFFSET, m AS _MEM
    m = _MEMIMAGE(image&)

    IF x1% > x2% THEN SWAP x1%, x2%
    IF y1% > y2% THEN SWAP y1%, y2%
    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
    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

    s& = _SOURCE
    _SOURCE image&

    BMP.PWidth = (x2% - x1%) + 1
    BMP.PDepth = (y2% - y1%) + 1
    BMP.ID = "BM"
    BMP.Blank = 0
    BMP.Hsize = 40
    BMP.Planes = 1
    BMP.Compression = 0
    BMP.Xres = 0
    BMP.Yres = 0

    BMP.SigColors = 0

    SELECT CASE _PIXELSIZE(image&)
        CASE 1
            temp = SPACE$(x2% - x1% + 1)
            OffsetBITS& = 54 + 1024 'add palette in 256 color modes
            BMP.BPP = 8
            IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
            ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
            BMP.ImageBytes = ImageSize&
            BMP.NumColors = 256
            BMP.Size = ImageSize& + OffsetBITS&
            BMP.Offset = OffsetBITS&
        CASE 4
            temp = SPACE$(3)
            OffsetBITS& = 54 'no palette in 24/32 bit
            BMP.BPP = 24
            IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
            ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
            BMP.ImageBytes = ImageSize&
            BMP.NumColors = 0
            BMP.Size = ImageSize& * 3 + OffsetBITS&
            BMP.Offset = OffsetBITS&
    END SELECT

    F = FREEFILE
    n = _MEMNEW(BMP.Size)
    _MEMPUT n, n.OFFSET, BMP
    o = n.OFFSET + 54
    zp& = LEN(ZeroPAD$)
    $CHECKING:OFF

    IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
            b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
            _MEMPUT n, o, b$
            o = o + 4
        NEXT
        y = y2% + 1
        w& = _WIDTH(image&)
        x = x2% - x1% + 1
        DO
            y = y - 1
            _MEMGET m, m.OFFSET + (w& * y + x1%), temp
            _MEMPUT n, o, temp
            o = o + x
            _MEMPUT n, o, ZeroPAD$
            o = o + zp&
        LOOP UNTIL y = y1%
    ELSE
        y = y2% + 1
        w& = _WIDTH(image&)
        DO
            y = y - 1: x = x1% - 1
            DO
                x = x + 1
                _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
                _MEMPUT n, o, temp
                o = o + 3
            LOOP UNTIL x = x2%
            _MEMPUT n, o, ZeroPAD$
            o = o + zp&
        LOOP UNTIL y = y1%
    END IF
    $CHECKING:ON
    _MEMFREE m
    OPEN filename$ FOR BINARY AS #F
    t1$ = SPACE$(BMP.Size)
    _MEMGET n, n.OFFSET, t1$
    PUT #F, , t1$
    _MEMFREE n
    CLOSE #F
    _SOURCE s&
END SUB

FUNCTION GetDay (mm, dd, yyyy) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
    century = yyyy MOD 100
    zerocentury = yyyy \ 100
    result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
    IF result = 0 THEN
        GetDay = 7
    ELSE
        GetDay = result
    END IF
    'Function changed to return a numeric value instead of a string for this program
    '    SELECT CASE result
    '        CASE 7: GetDay$ = "Saturday"
    '        CASE 1: GetDay$ = "Sunday"
    '        CASE 2: GetDay$ = "Monday"
    '        CASE 3: GetDay$ = "Tuesday"
    '        CASE 4: GetDay$ = "Wednesday"
    '        CASE 5: GetDay$ = "Thursday"
    '        CASE 6: GetDay$ = "Friday"
    '    END SELECT
END FUNCTION
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Windows Wallpaper Changer
« Reply #17 on: June 09, 2019, 11:50:50 am »
Hi Steve
very interesting about tecnique and your SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)

As I have imagined it doesn't work on my PC for different path of resources because my Win10 is a local port to my country

so after trying to run your code as is taken from CodeBox of last previous post of this thread,  I tryed to make a LocalPort pointing on run all program in QB64 folder. So I mod the paths to local QB64folder in which I have copied few jpg files....
but I have done some mistakes because I doesn't work.

Here my broken mod....
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 = ".\"
  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(".\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 > .\PhotoList.txt"
  24.  
  25. OPEN ".\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$ = ".\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.                     Day = VAL(MID$(DATE$, 4, 2))
  96.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH)-STEP(-175, -140), Kolor, B
  97.                     FOR i = 1 TO 5
  98.                         LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 20 * i)-STEP(-173, 0), Kolor
  99.                     NEXT
  100.                     FOR i = 1 TO 7
  101.                         LINE (_WIDTH - OffsetW - 1 - i * 25, _HEIGHT - OffsetH - 1)-STEP(0, -118), Kolor
  102.                     NEXT
  103.                     LINE (_WIDTH - OffsetW, _HEIGHT - OffsetH - 120)-STEP(-175, 0), Kolor, B
  104.                     LINE (_WIDTH - OffsetW - 1, _HEIGHT - OffsetH - 121)-STEP(-173, -18), BackKolor, BF
  105.                     count = 0
  106.                     FOR y = 1 TO 6 'weeks
  107.                         FOR x = 1 TO 7 'days
  108.                             IF (y - 1) * 7 + x >= FirstDay THEN
  109.                                 count = count + 1
  110.                                 IF count <= DaysInMonth THEN
  111.                                     T$ = _TRIM$(STR$(count))
  112.                                     IF count = Day THEN
  113.                                         LINE (_WIDTH - OffsetW - 175 + (x - 1) * 25, _HEIGHT - OffsetH - 120 + (y - 1) * 20)-STEP(23, 18), BackKolor, BF
  114.                                     END IF
  115.                                     _PRINTSTRING (_WIDTH - OffsetW - 163 + (x - 1) * 25 - _PRINTWIDTH(T$) \ 2, _HEIGHT - OffsetH - 116 + (y - 1) * 20), T$
  116.                                 END IF
  117.                             END IF
  118.                         NEXT
  119.                     NEXT
  120.                     T$ = Month$ + STR$(Year)
  121.                     _PRINTSTRING (_WIDTH - OffsetW - 87 - _PRINTWIDTH(T$) \ 2, _HEIGHT - OffsetH - 135), T$
  122.                 END IF
  123.  
  124.                 SaveBMP temp$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
  125.                 result = SystemParametersInfoA&(SPI_SETDESKTOPWALLPAPER, 0, temp$ + CHR$(0), SPI_UPDATEINIFILE)
  126.                 result = -1
  127.                 _FREEIMAGE f
  128.             ELSE
  129.                 loops = loops + 1
  130.             END IF
  131.         END IF
  132.     LOOP UNTIL result OR loops > 100
  133.     IF loops > 100 THEN PRINT "ERROR: Over 100 failures and no success... Terminating.": SLEEP: END
  134.     PRINT "Current Background: "; f$
  135.     _DELAY WaitBetweenChanges
  136.  
  137. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
  138.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
  139.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
  140.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
  141.  
  142.     IF _PIXELSIZE(image&) = 0 THEN
  143.         IF SaveTextAs256Color THEN
  144.             tempimage& = TextScreenToImage256&(image&)
  145.         ELSE
  146.             tempimage& = TextScreenToImage32&(image&)
  147.         END IF
  148.         F = _FONT(image&)
  149.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
  150.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
  151.         _FREEIMAGE tempimage&
  152.         EXIT FUNCTION
  153.     END IF
  154.  
  155.     TYPE BMPFormat
  156.         ID AS STRING * 2
  157.         Size AS LONG
  158.         Blank AS LONG
  159.         Offset AS LONG
  160.         Hsize AS LONG
  161.         PWidth AS LONG
  162.         PDepth AS LONG
  163.         Planes AS INTEGER
  164.         BPP AS INTEGER
  165.         Compression AS LONG
  166.         ImageBytes AS LONG
  167.         Xres AS LONG
  168.         Yres AS LONG
  169.         NumColors AS LONG
  170.         SigColors AS LONG
  171.     END TYPE
  172.  
  173.  
  174.     DIM BMP AS BMPFormat
  175.     DIM x AS LONG, y AS LONG
  176.     DIM temp AS STRING
  177.  
  178.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
  179.     m = _MEMIMAGE(image&)
  180.  
  181.     IF x1% > x2% THEN SWAP x1%, x2%
  182.     IF y1% > y2% THEN SWAP y1%, y2%
  183.     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
  184.     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
  185.  
  186.     s& = _SOURCE
  187.     _SOURCE image&
  188.  
  189.     BMP.PWidth = (x2% - x1%) + 1
  190.     BMP.PDepth = (y2% - y1%) + 1
  191.     BMP.ID = "BM"
  192.     BMP.Blank = 0
  193.     BMP.Hsize = 40
  194.     BMP.Planes = 1
  195.     BMP.Compression = 0
  196.     BMP.Xres = 0
  197.     BMP.Yres = 0
  198.  
  199.     BMP.SigColors = 0
  200.  
  201.     SELECT CASE _PIXELSIZE(image&)
  202.         CASE 1
  203.             temp = SPACE$(x2% - x1% + 1)
  204.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
  205.             BMP.BPP = 8
  206.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
  207.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
  208.             BMP.ImageBytes = ImageSize&
  209.             BMP.NumColors = 256
  210.             BMP.Size = ImageSize& + OffsetBITS&
  211.             BMP.Offset = OffsetBITS&
  212.         CASE 4
  213.             temp = SPACE$(3)
  214.             OffsetBITS& = 54 'no palette in 24/32 bit
  215.             BMP.BPP = 24
  216.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
  217.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
  218.             BMP.ImageBytes = ImageSize&
  219.             BMP.NumColors = 0
  220.             BMP.Size = ImageSize& * 3 + OffsetBITS&
  221.             BMP.Offset = OffsetBITS&
  222.     END SELECT
  223.  
  224.     F = FREEFILE
  225.     n = _MEMNEW(BMP.Size)
  226.     _MEMPUT n, n.OFFSET, BMP
  227.     o = n.OFFSET + 54
  228.     zp& = LEN(ZeroPAD$)
  229.  
  230.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
  231.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  232.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
  233.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  234.             _MEMPUT n, o, b$
  235.             o = o + 4
  236.         NEXT
  237.         y = y2% + 1
  238.         w& = _WIDTH(image&)
  239.         x = x2% - x1% + 1
  240.         DO
  241.             y = y - 1
  242.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
  243.             _MEMPUT n, o, temp
  244.             o = o + x
  245.             _MEMPUT n, o, ZeroPAD$
  246.             o = o + zp&
  247.         LOOP UNTIL y = y1%
  248.     ELSE
  249.         y = y2% + 1
  250.         w& = _WIDTH(image&)
  251.         DO
  252.             y = y - 1: x = x1% - 1
  253.             DO
  254.                 x = x + 1
  255.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
  256.                 _MEMPUT n, o, temp
  257.                 o = o + 3
  258.             LOOP UNTIL x = x2%
  259.             _MEMPUT n, o, ZeroPAD$
  260.             o = o + zp&
  261.         LOOP UNTIL y = y1%
  262.     END IF
  263.     _MEMFREE m
  264.     OPEN filename$ FOR BINARY AS #F
  265.     t1$ = SPACE$(BMP.Size)
  266.     _MEMGET n, n.OFFSET, t1$
  267.     PUT #F, , t1$
  268.     _MEMFREE n
  269.     CLOSE #F
  270.     _SOURCE s&
  271.  
  272. FUNCTION GetDay (mm, dd, yyyy) 'use 4 digit year
  273.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  274.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  275.     century = yyyy MOD 100
  276.     zerocentury = yyyy \ 100
  277.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  278.     IF result = 0 THEN
  279.         GetDay = 7
  280.     ELSE
  281.         GetDay = result
  282.     END IF
  283.     'Function changed to return a numeric value instead of a string for this program
  284.     '    SELECT CASE result
  285.     '        CASE 7: GetDay$ = "Saturday"
  286.     '        CASE 1: GetDay$ = "Sunday"
  287.     '        CASE 2: GetDay$ = "Monday"
  288.     '        CASE 3: GetDay$ = "Tuesday"
  289.     '        CASE 4: GetDay$ = "Wednesday"
  290.     '        CASE 5: GetDay$ = "Thursday"
  291.     '        CASE 6: GetDay$ = "Friday"
  292.     '    END SELECT
  293.  
  294.  

as you can see only paths have been modified to ".\" local folder.
But your program goes hidden and takes away the original background and it puts no other background also if I try to change manually background of desktop from into Control Panel.
:-(
I'll have to reset PC.

 
WallpaperChanger Issue.jpg



PS in the folder of QB64 there are both Photolist.txt both Wallpaper changer imager. bmp.



Programming isn't difficult, only it's  consuming time and coffee

Marked as best answer by SMcNeill on January 01, 2020, 01:15:53 am

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Windows Wallpaper Changer
« Reply #18 on: January 01, 2020, 06:15:33 am »
Update to v2.2 to correct a minor glitch with the calendar not updating/refreshing after New Years.

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