A simple vfp Images slider in 8 directions.
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
*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
command line can be with these options /a /3 s/c /s
*begin code
if ! file( &&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