MODE 21 :REM 800 x 600
xpos%=0
ypos%=0
xsize%=@vdu%!208
ysize%=@vdu%!212
REM We make a "spare" device context and bitmap the same size as the display
PROCMakeSpareBitmap(xsize%,ysize%)
REM AlphaBlend isn't one of the functions we can get by name, so need to find and load it
SYS "LoadLibrary", "Msimg32.DLL" TO msim%
SYS "GetProcAddress", msim%, "AlphaBlend" TO alphablend%
IF alphablend%=0 ERROR 100, "Could not get address of AlphaBlend"
REM Choose the first jpeg in a folder manually
picture$=FNGetFileName
IF picture$<>"" THEN
REPEAT
REM We load the chosen picture into our "spare" DC and bitmap
PROCLoadPictoNewDC(picture$,xpos%,ypos%,xsize%,ysize%)
FOR x%=1 TO 8
REM Now we are going to blend it into the screen, at ever increasing densities (range 0-255)
density%=((2^x%)-1)<<16
SYS alphablend%,@memhdc%,0,0,xsize%,ysize%,newdc%,0,0,xsize%,ysize%,density%
REM Tell windows to update the picture
SYS "InvalidateRect", @hwnd%, 0, 0
SYS "UpdateWindow", @hwnd%
WAIT 5 :REM Adjust to give the speed of fade you want
NEXT x%
ENDIF
WAIT 20
REM Now we'll look automatically for the next jpeg in that folder, and start the whole thing again
picture$=FNlistdirectory
UNTIL picture$=""
ENDIF
END
:
DEFPROCMakeSpareBitmap(xsize%,ysize%)
SYS "CreateCompatibleDC",@memhdc% TO newdc%
IF newdc%=0 THEN PRINT "Failed to make DC":END
SYS "CreateCompatibleBitmap",@memhdc%,xsize%,ysize% TO newbmp%
IF newbmp%=0 THEN PRINT "Failed to make bmp":END
SYS "SelectObject",newdc%,newbmp%
ENDPROC
:
DEF PROCLoadPictoNewDC(picture$,xpos%,ypos%,xsize%,ysize%)
REM This is just PROCdisplay from the manual, adapted to load the image into the spare device context/bitmap
LOCAL oleaut32%, olpp%, iid%, gpp%, hmw%, hmh%, picture%, res%
SYS "LoadLibrary", "OLEAUT32.DLL" TO oleaut32%
SYS "GetProcAddress", oleaut32%, "OleLoadPicturePath" TO olpp%
IF olpp%=0 ERROR 100, "Could not get address of OleLoadPicturePath"
DIM iid% LOCAL 15, picture% LOCAL 513
SYS "MultiByteToWideChar", 0, 0, picture$, -1, picture%, 256
iid%!0 = &7BF80980
iid%!4 = &101ABF32
iid%!8 = &AA00BB8B
iid%!12 = &AB0C3000
SYS olpp%, picture%, 0, 0, 0, iid%, ^gpp%
IF gpp% = 0 ERROR 100, "OleLoadPicturePath failed"
SYS !(!gpp%+24), gpp%, ^hmw% : REM. IPicture::get_Width
SYS !(!gpp%+28), gpp%, ^hmh% : REM. IPicture::get_Height
SYS !(!gpp%+32), gpp%, newdc%, xpos%, ypos%, xsize%, ysize%, 0, \
\ hmh%, hmw%, -hmh%, 0 TO res%
IF res% ERROR 100, "IPicture::Render failed"
SYS !(!gpp%+8), gpp% : REM. IPicture::Release
ENDPROC
:
DEFFNGetFileName
REM Basically the routine from the manual made into a function returning the filename
LOCAL fs{},fp,ff$,filename$
DIM fs{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
\ lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
\ lpstrFile%, nMaxFile%, lpstrFileTitle%, \
\ nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
\ flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
\ lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
DIM fp{t&(260)}
REM ff$ = "BMP files"+CHR$0+"*.BMP"+CHR$0+CHR$0
fs.lStructSize% = DIM(fs{})
fs.hwndOwner% = @hwnd%
fs.lpstrFilter% = !^ff$
fs.lpstrFile% = fp{}
fs.nMaxFile% = 260
fs.flags% = 6
SYS "GetOpenFileName", fs{} TO result%
IF result% filename$ = $$fp{} ELSE filename$=""
=filename$
:
DEF FNlistdirectory
REM Basically the routine in the manual, adapted to give the next jpeg in the directory
PRIVATE dir%, res%,cdir$,cdirbuff%
PRIVATE sh%
IF sh%=0 THEN
DIM dir% LOCAL 317
DIM cdirbuff% LOCAL 300
SYS "GetCurrentDirectory",300,cdirbuff%
cdir$=$$cdirbuff%+"\"
SYS "FindFirstFile", "*.jpg", dir% TO sh%
= cdir$+$$(dir%+44)
ELSE
SYS "FindNextFile", sh%, dir% TO res%
IF res%=0 THEN =""
= cdir$+$$(dir%+44)
ENDIF
=""