Wallpapers slideshow with visual foxpro

Published on by Yousfi Benameur

The wallpaper is a screen backgroung image set by the system with the API SystemParametersInfo Its becomes a system image (a num is affected to it by the system).
This code set a folder of images and play them with a timer as a  wallpaper sequentially or randomly.The pictures of source folder must be at least 800*600 to sho on fullscreen( not distorded).
Can set set at runtime the folder images source , the timer interval,..
Can change the wallpaper by a simple click in the menu.
All these can set in the systray menu.St must enable the application in the contextuel menu (first item).
Make a proj , produce an exe and run (change the application link to copy programmatly in the start menu)
.As the code is made the exe works inside VFP only(_screen.visible=.t.).Must create a top level form hidden and add the systray object to make it working from anywhere.

Suggestions and Bug Reports are always  Welcome



*Begin Code

Clea All
 

Local m.myvar
TEXT to m.myvar noshow
                             Summary help
The wallpaper is a screen backgroung image set by the system with the API SystemParametersInfo
This code set a folder of images and play them with a timer as a  wallpaper sequentially or randomly.
Can set set at runtime the folder images source , the timer interval,..
Can change the wallpaper by a simple click in the menu.
All these can set in the systray menu.St must enable the application in the contextuel menu (first item).
Make an exe and run (change the link to copy in the start menu).
ENDTEXT

With _Screen
    .AddProperty("ystart",.F.)
    .AddProperty("yinterval",60000) 
&&time interval  1 mn
    .AddProperty("ySource",Iif(Directory("E:\ywallpapers\wallpapers\")=.T.,"E:\ywallpapers\wallpapers\",Getdir() ))
    .AddProperty("yhelp",m.myvar)
    .AddProperty("yrandom",.F.)
    .AddProperty("ystartW",.F.)  
&&lauch with windows start
    .Addproperty("yenabled",.f.)
Endwith

Publi ytimer1
ytimer1=Newobject("ytimer")
ytimer1.Enabled=.f.


Publi m.yrepi
=ystart()

Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)

Set Safe Off
Set Date Long
_Screen.WindowState=1
Do ydeclare

*Create the external  contextuel systray menu  ymenu.mpr
Local m.myMPR
TEXT to m.myMPR noshow

DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "Enable wallpapers" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR  ;
        PICTURE home(1)+"graphics\icons\misc\CHECKMRK.ico"
DEFINE BAR 2 OF raccourci PROMPT "Stop Wallpaper" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
    PICTURE  home(1)+"graphics\icons\misc\camera.ico"
DEFINE BAR 3 OF raccourci PROMPT "Set images source" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
    PICTURE home(1)+"graphics\icons\misc\misc15.ico"
DEFINE BAR 4 OF raccourci PROMPT "New Wallpaper" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
    PICTURE home(1)+"graphics\icons\misc\volume01.ico"
DEFINE BAR 5 OF raccourci PROMPT "Set new interval" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
     PICTURE home(1)+"graphics\icons\misc\misc18.ico"
DEFINE BAR 6 OF raccourci PROMPT "Summary help" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
     PICTURE home(1)+"graphics\icons\misc\binoculR.ico"
DEFINE BAR 7 OF raccourci PROMPT "Start with windows" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
     PICTURE home(1)+"graphics\icons\misc\lighton.ico"
 DEFINE BAR 8 OF raccourci PROMPT "random wallpapers" ;
    FONT "Courier New", 8 style "BI"  COLOR G/W*, B/W*,,,,W+/GR ;
    PICTURE home(1)+"graphics\icons\misc\clock02.ico"
DEFINE BAR 9 OF raccourci PROMPT "Exit"


ON SELECTION BAR 1 OF raccourci ;
  DO _4al16sn4n
ON SELECTION BAR 2 OF raccourci  ;
do _4al16sn4ro
ON SELECTION BAR 3 OF raccourci ;
do _4al16sn52
ON SELECTION BAR 4 OF raccourci ;
do _4al16sn53
ON SELECTION BAR 5 OF raccourci ;
    DO _4al16sn4j
ON SELECTION BAR 6 OF raccourci ;
do _4al16sn4o
ON SELECTION BAR 7 OF raccourci ;
do _ylaunchW

ON SELECTION BAR 8 OF raccourci ;
do _yrandom

ON SELECTION BAR 9 OF raccourci oSystray.destroy()


ACTIVATE POPUP raccourci
*
PROCEDURE _4al16sn4n 
&&1-Enable wallpaper
if _screen.yenabled=.f.
_screen.yenabled=.t.
=ywallp()  &&starting
messagebox("Wallpaper app enabled!",0+32+4096,'',1000)
else
Messagebox("Wallpaper already enabled and active!",0+32+4096,1000)
endi

PROCEDURE _4al16sn4ro &&2-Stop wallpaper
ytimer1.enabled=.f.

messagebox("Wallpapers stopped!",0+32+4096,'',1000)

*
PROCEDURE _4al16sn52 
&&3-Set images source
local xsource
m.xsource=getdir()
if ! empty(m.xsource)
_screen.ysource=m.xsource
=ystart()
endi
*
PROCEDURE _4al16sn53 
&&4-New wallpaper
=ywallp()
*
PROCEDURE _4al16sn4j &&5-Set new interval
local xinterval,y
y=trans(_screen.yinterval)
m.xinterval=int(val(inputbox("new interval in Mseconds","",m.y)))
if !m.xinterval>0
m.xinterval=60000
endi
_screen.yinterval=m.xinterval  &&ms
*

PROCEDURE _4al16sn4o  &&6-Summary help
messagebox(_screen.yhelp,0+32+4096,"Summary help")

procedure _ylaunchW   &&set a start link or no in windows start For a Single User on a Specific Computer:

if file(m.yrep+"ywallpaper.lnk")

_screen.ystartW= ! _screen.ystartW
if _screen.ystartW=.f.
erase (getenv('APPDATA')+"\Microsoft\Windows\Start Menu\Programs\Startup\ywallpaper.lnk")
messagebox("start link erased!",0+32+4096,'',1000)
else
copy file (m.yrep+"ywallpaper.lnk") to (getenv('APPDATA')+"\Microsoft\Windows\Start Menu\Programs\Startup")
messagebox("start link set !",0+32+4096,'',1000)
endi

else
messagebox("create the app shortcut  first(rightclick on..)",0+32+4096,'',1000)

endi

procedure _yrandom    &&random wallpapers
_screen.yrandom = !_screen.yrandom
messagebox("Random Wallpapers = "+trans(_screen.yrandom),0+32+4096,'',1000)

procedure ydestroy   &&9-exit
try
ytimer1.enabled=.f.
catch
endtry
oSystray.destroy()
clea events
endproc
ENDTEXT

Strtofile(m.myMPR,m.yrep+"ymenu.mpr")


Set Path To Home(1)+"samples\solution\toledo\"
Publi m.osystray
m.osystray = Createobject("ysystray")
m.osystray.AddIconToSystray()
Read Events && Wait for user input.  it supposes mandatory the e command "clea events" is located on contextuel MPR menu
_Screen.WindowState=0
Set Safe On

Define Class ysystray As Systray Of "systray.vcx"
    IconFile = Home() + "Graphics\Icons\Misc\misc15.ico"
    TipText = "Ywallpaper"
    MenuText = "ymenu.mpr"
    MenuTextIsMPR = .T.  && All work should done in the menu code, so  no further code is needed here.

    Procedure IconClickEvent
        DoDefault()  &&execute the ymenu.mpr as definded in menuText
    Endproc

    Procedure IconRightClickEvent  &&code it the same with iconClickEvent() event
        This.IconClickEvent
    Endproc

    Procedure Destroy   && remove icon from systray,Exit Application
        This.RemoveIconFromSystray()
        Try
            ytimer1.Enabled=.F.
        Catch
        Endtry
        Clear Events
    Endproc
Enddefine

Define Class ytimer As Timer
    Enabled=.F.
    Name="ytimer"

    Procedure Init
        This.Interval=_Screen.yinterval
    Endproc

    Procedure Timer
        =ywallp()
    Endproc
Enddefine

Procedure ystart
    m.yrepi=_Screen.ysource
    gnbre=Adir(gabase,m.yrepi+"*.*")
    If gnbre=0
        Messagebox ("no images in" +m.yrepi,16+4096,'Error')
        Return .F.
    Endi

    Create Cursor ycurs (yimage c(250))
    For i=1 To gnbre
        If Inlist( Lower(Justext(m.yrepi+gabase(i,1) )),"png","jpg","bmp","gif")
            Insert Into ycurs Values( m.yrepi+gabase(i,1))
        Endi
    Endfor
    Sele ycurs
    *brow
    Locate
Endproc

Procedure ywallp
    #Define SPI_SETDESKWALLPAPER    20
    #Define SPIF_SENDWININICHANGE 1
    #Define SPIF_UPDATEINIFILE 2

    Local lcWallpaper, nFlag
    nFlag = SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE
    Sele ycurs
    If Recno()>1
        Clea Resources(yimage)
    Endi
    Local gnlower,gnUpper
    If _Screen.yrandom=.F.
        Try
            Skip
        Catch
            Locate
        Endtry

    Else
        gnlower = 1
        gnUpper = Reccount()
        Go  Int((gnUpper - gnlower + 1) * Rand( ) + gnlower)
    Endi

    lcWallpaper=yimage  &&set wallpaper
    =yconvert(lcWallpaper)  &&lcWallpaper is output
    sleep(500)
    = SystemParametersInfo (SPI_SETDESKWALLPAPER,;
        0, @lcWallpaper, nFlag)
    DoEvents
    ytimer1.Interval=_Screen.yinterval
    If _Screen.ystart=.F.
        _Screen.ystart=.T.
        ytimer1.Enabled=.T.
    Endi
Endproc

Procedure yconvert   &&convert any image to fullscreen bmp as wallpaper
    Lparameters yimage
    #Define CF_BITMAP 2
    #Define IMAGE_BITMAP 0

    Local m.lnWidth,m.lnHeight  &&fullscreen
    m.lnWidth=Sysmetric(1)
    m.lnHeight=Sysmetric(2)

    Local m.ext
    m.ext="BMP"
    lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat

    *Save the graphic file to the clipboard
    nBitmap=0
    hbm=0
    GdipCreateBitmapFromFile(Strconv(Allt(yimage)+0h00,5),@nBitmap)
    GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
    lhbmp=CopyImage(hbm, 0, lnWidth, lnHeight,0) &&resize
    If OpenClipboard(0)!= 0
        EmptyClipboard()
        SetClipboardData(CF_BITMAP, lhbmp)
        CloseClipboard()
    Endif

    *get the graphics from the local clipboard
    OpenClipboard(0)
    hBitmap = GetClipboardData(CF_BITMAP)
    CloseClipboard()

    *export as image file
    Local lcoutputfile,lcoutputfile0,ubitmap
    lcoutputfile0=Addbs(Sys(2023))+Juststem(yimage)+"."+m.ext

    Erase Addbs(Sys(2023))+"*.bmp"

    ubitmap=0
    GdipCreateBitmapFromHBITMAP(hBitmap,2,@ubitmap)
    lcoutputfile=Strconv(m.lcoutputfile0+Chr(0),5)
    GdipSaveImageToFile(ubitmap,lcoutputfile,Eval("lqEncoderClsID_"+ext),Null)
    sleep(100)

Procedure ydeclare
    Declare Integer Sleep In kernel32 Integer
    Declare Integer OpenClipboard In User32 Integer
    Declare Integer CloseClipboard In User32
    Declare Integer EmptyClipboard In User32
    Declare Integer SetClipboardData In User32 Integer,Integer
    Declare Integer GetClipboardData In User32 Integer
    Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
    Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
    Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
    Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
    Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
    Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
        STRING cOperation,;
        STRING cFileName,;
        STRING cParameters,;
        STRING cDirectory,;
        INTEGER nShowWindow
    Declare Integer SystemParametersInfo In user32;
        INTEGER uiAction, Integer uiParam,;
        STRING @pvParam, Integer fWinIni

Endproc

*End Code


Wallpapers slideshow with visual foxpro

Published on Visual foxpro, wallpaper, API

To be informed of the latest articles, subscribe:
Comment on this post