A simple vfp Images slider in 8 directions.

Published on by Yousfi Benameur

 
This code produces an image slider in the 4 directions.
Point to any folder of images(png,jpg,bmp,gif)+select a music (in option).
This  code : -select a folder+select a music (looping until the form releases)
             -can set titlebar form on/off and the fullscreen.
             -Can adjust the sound of PC from this code.
             -the controls can be hidden with mousemove
*style updated on 22 september 2015 with html one--- for editor provider problems
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro

Click on code to select [then copy] -click outside to deselect

 
*Begin code

Publi yslider
yslider=Newobject("yslider_class")
yslider.Show
Read Events
Return
*
Define Class yslider_class As Form
    Height = 546
    Width = 832
    ShowWindow = 2
    ShowTips = .T.
    AutoCenter = .T.
    Caption = "ySlider"
    Icon = Home(4)+"icons\misc\misc15.ico"
    KeyPreview = .T.
    BackColor = Rgb(0,0,0)
    yc = .F.

    Add Object image1 As Image With ;
        BorderStyle = 1, ;
        Height = 313, ;
        Left = 48, ;
        Top = 24, ;
        Visible = .F., ;
        Width = 156, ;
        BorderColor = Rgb(255,255,255), ;
        Name = "Image1"

    Add Object image2 As Image With ;
        BorderStyle = 1, ;
        Height = 193, ;
        Left = 456, ;
        Top = 204, ;
        Visible = .F., ;
        Width = 204, ;
        BorderColor = Rgb(255,255,255), ;
        Name = "Image2"

    Add Object timer1 As Timer With ;
        Top = 36, ;
        Left = 696, ;
        Height = 23, ;
        Width = 23, ;
        Enabled = .F., ;
        Interval = 5000, ;
        Name = "Timer1"

    Add Object container1 As Container With ;
        Anchor = 768, ;
        Top = 513-10, ;
        Left = 240, ;
        Width = 312, ;
        Height = 37, ;
        BackStyle = 0, ;
        Name = "Container1"

    Procedure ypos
        Lparameters  yobj
        yobj.Visible=.F.
        Local m.xdelta,m.ydelta
        m.xdelta=yobj.Width/7
        m.ydelta=yobj.Height/7
        Sele ycurs
        Try
            Skip
        Catch
            Locate
        Endtry
        Rand(-1)
        Local x
        gnLower = 1
        gnUpper = 8
        m.x= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)


        With yobj
            .Picture=Allt(yimage)
            If Empty(.Picture)
                Return .F.
            Endi
            .ZOrder(0)

            Do Case

                Case m.x=1
                    .Left=-Thisform.Width
                    .Top=0
                    .Visible=.T.
                    Do While .Left<=0
                        .Left=.Left+m.xdelta
                        sleep(100)
                    Enddo

                Case m.x=2
                    .Left=0
                    .Top=Thisform.Height
                    .Visible=.T.
                    Do While .Top>=0
                        .Top=.Top-m.ydelta
                        sleep(100)
                    Enddo

                Case m.x=3
                    .Left=Thisform.Width
                    .Top=0
                    .Visible=.T.
                    Do While .Left>=0
                        .Left=.Left-m.xdelta
                        sleep(100)
                    Enddo


                Case m.x=4
                    .Left=0
                    .Top=-Thisform.Height
                    .Visible=.T.
                    Do While .Top<=0
                        .Top=.Top+m.ydelta
                        sleep(100)
                    Enddo

                Case m.x=5
                    .Left=-Thisform.Width
                    .Top=-Thisform.Height
                    .Visible=.T.
                    Do While .Top<=0 And .Left<=0
                        .Top=.Top+m.ydelta
                        .Left=.Left+m.xdelta
                        sleep(100)
                    Enddo

                Case m.x=6
                    .Left=-Thisform.Width
                    .Top=Thisform.Height
                    .Visible=.T.
                    Do While .Top>=0 And .Left<=0
                        .Top=.Top-m.ydelta
                        .Left=.Left+m.xdelta
                        sleep(100)
                    Enddo

                Case m.x=7
                    .Left=Thisform.Width
                    .Top=Thisform.Height
                    .Visible=.T.
                    Do While .Top>=0 And .Left>=0
                        .Top=.Top-m.ydelta
                        .Left=.Left-m.xdelta
                        sleep(100)
                    Enddo

                Case m.x=8
                    .Left=Thisform.Width
                    .Top=-Thisform.Height
                    .Visible=.T.
                    Do While .Top<=0 And .Left>=0
                        .Top=.Top+m.ydelta
                        .Left=.Left-m.xdelta
                        sleep(100)
                    Enddo

            Endcase

        Endwith

        sleep(50)

        With yobj
            .Left=8
            .Top=8
            .Width=.Parent.Width-16
            .Height=.Parent.Height-16
        Endwith

        Do Case
            Case yobj.Name=[image1]
                Thisform.image2.Visible=.F.
            Case yobj.Name=[image2]
                Thisform.image1.Visible=.F.
        Endcase
        Thisform.container1.ZOrder(0)
    Endproc

    Procedure Destroy
        wmp=Null
        Clea Events
    Endproc

    Procedure Load
        Declare Integer Sleep In kernel32 Integer
    Endproc

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        If nKeyCode=27
            Thisform.Release
        Endi
    Endproc

    Procedure Init
        Set Status Bar  Off
        Set Talk Off
        Thisform.SetAll("mousepointer",15,"commandbutton")

        With Thisform.container1
            .AddObject("optiongroup1","optiongroup")
            With .optiongroup1
                .AutoSize = .T.
                .ButtonCount = 5
                .Anchor = 768
                .BackStyle = 0
                .Value = 1
                .Height = 27
                .Left = 204
                .Top = 5
                .Width = 105
                .TabIndex = 1
                .Name = "Optiongroup1"
                .Option1.Caption = ""
                .Option1.Value = 1
                .Option1.Height = 17
                .Option1.Left = 5
                .Option1.Top = 5
                .Option1.Width = 18
                .Option1.AutoSize = .T.
                .Option1.Name = "Option1"
                .Option2.Caption = ""
                .Option2.Height = 17
                .Option2.Left = 24
                .Option2.Top = 5
                .Option2.Width = 18
                .Option2.AutoSize = .T.
                .Option2.Name = "Option2"
                .Option3.Caption = ""
                .Option3.Height = 17
                .Option3.Left = 45
                .Option3.Top = 5
                .Option3.Width = 18
                .Option3.AutoSize = .T.
                .Option3.Name = "Option3"
                .Option4.Caption = ""
                .Option4.Height = 17
                .Option4.Left = 62
                .Option4.Top = 5
                .Option4.Width = 18
                .Option4.AutoSize = .T.
                .Option4.Name = "Option4"
                .Option5.Caption = ""
                .Option5.Height = 17
                .Option5.Left = 82
                .Option5.Top = 5
                .Option5.Width = 18
                .Option5.AutoSize = .T.
                .Option5.Name = "Option5"
                .Visible=.T.
            Endwith
            .AddObject ("command1","ycommand1")
            .AddObject("command3","ycommand3")
            .AddObject("command2","ycommand2")
            .AddObject("command4","ycommand4")
            .AddObject("label1","ylabel1")
        Endwith

        Publi wmp As WindowsMediaPlayer
        wmp = Createobject("WMPlayer.OCX.7")
        With wmp
            .settings.autoStart = .T.
            .settings.setMode("loop",.T.)  &&loop
        Endwith
    Endproc

    Procedure MouseMove
        Lparameters nButton, nShift, nXCoord, nYCoord

        If (Between(nXCoord,0,Thisform.container1.Left) And Between(nYCoord,Thisform.container1.Top,Thisform.Height) ) Or ;
                (Between(nXCoord,Thisform.container1.Left+Thisform.container1.Width,Thisform.Width) And Between(nYCoord,Thisform.container1.Top,Thisform.Height))
            Thisform.container1.Visible=.F.
        Else
            Thisform.container1.Visible=.T.
            Thisform.container1.ZOrder(0)
        Endi
    Endproc

    Procedure timer1.Timer
        Thisform.yc=Thisform.yc+1
        If Thisform.yc>1
            Thisform.yc=0
        Endi

        Do Case

            Case Thisform.yc=1
                Thisform.ypos(Thisform.image2)

            Case Thisform.yc=0
                Thisform.ypos(Thisform.image1)


        Endcase
        Thisform.container1.optiongroup1.Value=Thisform.container1.optiongroup1.Value+1
        If Thisform.container1.optiongroup1.Value=0 Or Thisform.container1.optiongroup1.Value>Thisform.container1.optiongroup1.ButtonCount
            Thisform.container1.optiongroup1.Value=1
        Endi
    Endproc
Enddefine


Define Class ycommand1 As CommandButton
    Top = 7
    Left = 5
    Height = 25
    Width = 72
    FontBold = .T.
    Anchor = 0
    Caption = "Images..."
    ToolTipText = "Images folder"
    Name = "yCommand1"
    Visible=.T.


    Procedure Click
        Thisform.yc=0
        With Thisform.image2
            .Left=8
            .Top=8
            .Width=.Parent.Width-16
            .Height=.Parent.Height-16
            .Stretch=2
            .Anchor=15
            .BackStyle=1
            .ZOrder(1)
            .Visible=.T.
        Endwith

        With Thisform.image1
            .Left=8
            .Top=8
            .Width=.Parent.Width-16
            .Height=.Parent.Height-16
            .Stretch=2
            .Anchor=15
            .BackStyle=1
            .ZOrder(0)
            .Visible=.T.
        Endwith


        Local m.yrep
        m.yrep=Getdir()
        If Empty(m.yrep)
            Return .F.
        Endi

        gnbre=Adir(gabase,Addbs(m.yrep)+"*.*")
        Create Cursor ycurs (yimage c(200))
        For i=1 To gnbre
            If Inlist(Lower(Justext(gabase(i,1))),"jpg","bmp","png","gif")
                Insert Into ycurs Values(Addbs(m.yrep)+gabase(i,1))
            Endi
        Endfor

        Sele ycurs
        xr=Reccount()
        *brow
        Locate
        Thisform.image1.Picture=yimage
        Thisform.container1.ZOrder(0)

        Thisform.timer1.Enabled=.T.


        Local ysound
        ysound=""
        If Messagebox("Want a music ?",4+64+4096,"")=6
            ysound=Getfile("mp3|wav")

            If !Empty(m.ysound)
                wmp.URL = m.ysound
            Endi
        Endi

    Endproc
Enddefine


Define Class ycommand3 As CommandButton
    Top = 7
    Left = 103
    Height = 25
    Width = 25
    FontBold = .T.
    Anchor = 0
    Caption = "FS"
    ToolTipText = "Fullscreen"
    Name = "Command3"
    Visible=.T.

    Procedure Click
        With Thisform
            .TitleBar=0
            .Left=-10
            .Top=-10
            .Width=Sysmetric(1)+5
            .Height=Sysmetric(2)+5
        Endwith
    Endproc
Enddefine



Define Class ycommand2 As CommandButton
    Top = 7
    Left = 78
    Height = 25
    Width = 25
    FontBold = .T.
    Anchor = 0
    Caption = "T"
    ToolTipText = "Titlebar on/off"
    Name = "yCommand2"
    Visible=.T.

    Procedure Click
        Thisform.TitleBar=Iif(Thisform.TitleBar=0,1,0)
        If Thisform.TitleBar=0
            Thisform.Height=Thisform.Height+29
        Else
            Thisform.Height=Thisform.Height-29
        Endi
        Thisform.AutoCenter=.T.
    Endproc
Enddefine

Define Class ycommand4 As CommandButton
    Top = 7
    Left = 128
    Height = 25
    Width = 25
    FontBold = .T.
    FontSize = 10
    Anchor = 0
    Caption = "X"
    ToolTipText = "Close"
    ForeColor = Rgb(255,0,0)
    Name = "yCommand4"
    Visible=.T.

    Procedure  Click
        Thisform.Release
    Endproc
Enddefine


Define Class ylabel1 As Label
    AutoSize = .T.
    FontBold = .F.
    FontSize = 16
    BackStyle = 0
    Caption = "A"
    Height = 27
    Left = 168
    MousePointer = 15
    Top = 7
    Width = 15
    ForeColor = Rgb(255,0,0)
    ToolTipText = "Audio control"
    Name = "yLabel1"
    Visible=.T.

    Procedure Click
        #Define  APPCOMMAND_VOLUME_MUTE  0x80000
        #Define  APPCOMMAND_VOLUME_UP  0xA0000
        #Define  APPCOMMAND_VOLUME_DOWN  0x90000
        #Define  WM_APPCOMMAND 0x319

        Declare Integer SendMessage In user32;
            INTEGER HWnd,;
            INTEGER Msg,;
            INTEGER wParam,;
            INTEGER Lparam

        SendMessage(_vfp.HWnd, WM_APPCOMMAND, _vfp.HWnd, APPCOMMAND_VOLUME_UP)

        *also available
        *SendMessage(_vfp.hwnd, WM_APPCOMMAND, _vfp.hwnd,  APPCOMMAND_VOLUME_MUTE)
        *SendMessageW(_vfp.hwnd, WM_APPCOMMAND, _vfp.hwnd,APPCOMMAND_VOLUME_DOWN)
    Endproc

Enddefine

*END CODE


A simple vfp Images slider  in 8 directions.
A simple vfp Images slider  in 8 directions.
A simple vfp Images slider  in 8 directions.

*In the section tips,this is a code  to lauch programmatly the windows image viewer in fullscreen mode and play a folder of images.

*http://msdn.microsoft.com/en-us/library/windows/desktop/ee719901%28v=vs.85%29.aspx
*rundll32 "%ProgramFiles%\Windows Photo Viewer\PhotoViewer.dll", ImageView_Fullscreen path_to_image

*make a smal proj and generate an exe as utility.

 

*Begin Code

If !_vfp.StartMode=0
    On Shutdown Quit
Endi

Local m.cmdline,yrep
m.yrep=Getdir()
If Empty(m.yrep)
    Return .F.
Endi

Set Defa To (yrep)
TEXT to m.cmdline textmerge noshow
%SystemRoot%\System32\rundll32.exe "%ProgramFiles%\Windows Photo Viewer\PhotoViewer.dll", ImageView_Fullscreen <<m.yrep>>
ENDTEXT
*messagebox(m.cmdline)
Local oshell
oshell=Newobject("wscript.shell")
oshell.Run(m.cmdline,0,.F.)
Inkey(1)
oshell.sendkeys("{F11}")

If !_vfp.StartMode=0
    Quit
Endi

*End code

*tested on win8.1

*verify the windows photo viewer dll location in :ProgramFiles%\Windows Photo Viewer\PhotoViewer.dll"

*in win8.1 there is a fullscreen photo viewer application also to view any photo or even a folder of photo (with manual previous,next button)

run in start button "c:\PROGRAM FILES\FullScreen Photo Viewer\fullscreen photo viewer.exe"

and see the capabilities

command line can be with these options   /a  /3  s/c  /s

*begin code

if ! file("c:\PROGRAM FILES\FullScreen Photo Viewer\fullscreen photo viewer.exe")  &&make sure exe exists on disc

return .f.

endi

local m.yrep
m.yrep=getdir()
run/n "c:\PROGRAM FILES\FullScreen Photo Viewer\fullscreen photo viewer.exe" &yrep

*endcode

Published on Visual foxpro, slider, VIEWER

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