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
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 (http://qb64.org/autobuilds/master/qb64_2018-11-01-14-33-43_2398884-master_win.7z)
Ashish: A few questions:Display resolution : 1366 x 768
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. :)
Hi Steve!
I got "input past end of file on line 30". :'(Code: QB64: [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