Testing VFP scrollbar container classes .
the vfpscrollbar class is from SPS site(Graig Boyd):
*download the vfpscrollbar.zip and keep only the vfpscrollbar.vcx(+vct)
*from http://www.sweetpotatosoftware.com/spsblog/2005/08/27/VisualFoxProScrollbarClasses.aspx
it can embed a great quantity of controls here tested with an images folder(more 300 big images).
Can set ae start the stretch images as (0 clip,1 Isometric ,2 extension).
Before embedding objects must set the properties to make the container working as expected :
.scrollableHeight
.scrollableWidth
*from the vfpScrollbar class , import only the Sbscrollcontainer on a form like this example code.
After testing quickly , can only blame this class does not take into account the mouse wheel and the
difficulty of scroll by clicks on scrolbars and the navigation by keyUp,keyDown,PgUp,PgDown...(i added a routine in the code *1* below to support the mouseWheel event in scrolling container and on images using bindevent)
-Added on friday 25 december 2015 a code for testing the vfp container scrollbar from http://www.arg.kirov.ru
see in code *2* below
(i added a routine in the code *1* below to support the mouseWheel event in scrolling container(exists) and on images using Bindevent)
Click on code to select [then copy] -click outside to deselect
*1* SPS vfpScrollbar class
set classlib to locfile("vfpScrollbar.vcx") addi
publi yform
yform=newObject("yimg")
release classlib vfpscrollbar
yform.show
read events
retu
*
DEFINE CLASS yimg AS form
Height = 512
Width = 737
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "test vfpScrollbar class"
Name = "Form1"
ADD OBJECT sbscrollcontainer1 AS sbscrollcontainer WITH ;
Anchor = 15, ;
Top = 60, ;
Left = 0, ;
Width = 732, ;
Height = 456, ;
Name = "Sbscrollcontainer1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 1, ;
Left = 275, ;
Height = 37, ;
Width = 109, ;
Anchor = 768, ;
Caption = "Images", ;
Name = "Command1"
ADD OBJECT spinner1 AS spinner WITH ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 2, ;
KeyboardLowValue = 0, ;
Left = 406, ;
SpinnerHighValue = 2.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Stretch", ;
Top = 8, ;
Width = 49, ;
Name = "Spinner1"
ADD OBJECT label1 AS label WITH ;
Anchor=768, ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 18, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 32, ;
Left = 480, ;
MousePointer = 15, ;
Top = 6, ;
Width = 17, ;
ForeColor = RGB(0,255,0), ;
Name = "Label1"
PROCEDURE sbscrollcontainer1.mouseWheel &&i added this to mouseWheel event in scrolling container (mouseWheel out or on images area)
LPARAMETERS nDirection, nShift, nXCoord, nYCoord
dodefault()
local m.n
m.n=10
if nDirection>0
for i=1 to m.n
this.scrollBarVertical1.ScrollEndUp1.SbShape4.click
endfor
else
for i=1 to m.n
this.scrollBarVertical1.ScrollEndDown1.SbShape4.click
endfor
endi
endproc
PROCEDURE command1.Click
xint=2
local m.yrep
m.yrep=getdir()
if empty(m.yrep)
return .f.
endi
m.yrep=addbs(m.yrep)
local gnbre
gnbre=adir(gabase,m.yrep+"*.jpg")
if gnbre=0
return .f.
endi
messagebox(trans(gnbre)+" photos in "+m.yrep,0+32+4096,'',1200)
set defa to addbs(justpath(sys(16,1)))
with thisform.SbScrollContainer1
dodefault()
.scrollableHeight=.width*gnbre
.scrollableWidth=.width
for i=1 to gnbre
.addObject("image"+trans(i),"image")
with eval(".image"+trans(i))
.anchor=0
.stretch=thisform.spinner1.value
.width=thisform.sbScrollContainer1.width-30
.height=.width
.left=1
.picture=m.yrep+gabase(i,1)
.zorder(1)
.tooltiptext=justfname(.picture)+chr(13)+trans(gabase(i,2))+ "octets"+chr(13)+"Date:"+dtoc(gabase(i,3))
if i=1
.top=0
else
.top=eval(".parent.image"+trans(i-1)+".top")+eval(".parent.image"+trans(i-1)+".height")+m.xint
endi
wait window ("image"+trans(i)) nowait
.visible=.t.
endwith
bindevent(Eval(".image"+Trans(i)),"mousewheel",thisform,"my")
endfor
.refresh
endwith
this.enabled=.f.
this.parent.spinner1.enabled=.f.
ENDPROC
procedure my &&I dded this routine to support mouseWheel on images
LPARAMETERS nDirection, nShift, nXCoord, nYCoord
dodefault()
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.mouseWheel(nDirection, nShift, nXCoord, nYCoord)
endproc
PROCEDURE label1.Click
local m.myvar
text to m.myvar noshow
the vfpscrollbar class is from SPS site(Graig Boyd):
*download the vfpscrollbar.zip and keep only the vfpscrollbar.vcx(+vct)
*from http://www.sweetpotatosoftware.com/spsblog/2005/08/27/VisualFoxProScrollbarClasses.aspx
it can embed a great quantity of controls here tested with an images folder(more 300 big images).
Can set the stretch images as (0 clip,1 Isometric ,2 extension).
Before embedding objects must set the properties to make the container working as expected :
.scrollableHeight
.scrollableWidth
*from the vfpScrollbar class , import only the Sbscrollcontainer on a form like this example code.
endtext
messagebox(m.myvar,0+32+4096,"Summary help")
ENDPROC
Procedure destroy
clea events
endproc
ENDDEFINE
*
*-- EndDefine: yimg
Note: this container can scroll any very big image.
Can also download an try this vfp scrolling container from:
http://www.arg.kirov.ru/downloads/Download.aspx?filename=ScrollContainer.zip
this solution is updated in the code below with a great quantity of images controls
i added support to mouseWheel on images in the scrolling container.
Click on code to select [then copy] -click outside to deselect
download the scrolling container class from http://www.arg.kirov.ru/downloads/
keep only the scont class(vcx+vct).
it can embed a great quantity of controls here tested with an images folder(more 300 big images).
Can set the stretch images as (0 clip,1 Isometric ,2 extension).
Before embedding objects must set the properties to make the container working as expected (form.init) and
issue the resize method mandatory to make the scrollbars visibles.
there is 2 containers in the scrolling container(Viewframe & clientArea: here add objects)
this class have the capability to work with mouseWheel (see the property wheelScrolllines to set the
number of lines with mouseWheel)-(dont work with arrows or PGup,PgDown).
Click on code to select [then copy] -click outside to deselect
*2* scroll Container class from http://www.arg.kirov.ru/
Set Classlib To Locfile("sbcont.vcx") AddI &&ask to the class sbcont( (preferablke to put it in same folder as this prg)
Publi yform
yform=Newobject("yimg")
Release Classlib sbcont.vcx
yform.Show
Read Events
Retu
*
Define Class yimg As Form
Height = 512
Width = 737
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Test sbcont scroll container class"
scaleMode=3
xint=2 &&space between 2 images (pixels)
Name = "Form1"
Add Object _scrollcontainer1 As _scrollcontainer With ;
Anchor = 15, ;
Top = 60, ;
Left = 5, ;
Width = 728, ;
Height = 456, ;
specialEffect=2, ;
borderWidth=0, ;
Name = "_scrollcontainer1"
Add Object command1 As CommandButton With ;
Top = 1, ;
Left = 275, ;
Height = 37, ;
Width = 109, ;
Anchor = 768, ;
Caption = "Images", ;
Name = "Command1"
Add Object spinner1 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 2, ;
KeyboardLowValue = 0, ;
Left = 206, ;
SpinnerHighValue = 2.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Stretch", ;
Top = 8, ;
Width = 49, ;
Name = "Spinner1"
Add Object label1 As Label With ;
Anchor=768, ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 18, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 32, ;
Left = 400, ;
MousePointer = 15, ;
Top = 6, ;
Width = 17, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label1"
Procedure Init
DoDefault()
With Thisform._scrollcontainer1
.ScrollBars=3
.SpecialEffect=2
.autoScroll=.T.
.wheelScrollLines=8
.refresh
Endwith
Endproc
Procedure command1.Click
thisform.xint=2
Local m.yrep
m.yrep=Getdir()
If Empty(m.yrep)
Return .F.
Endi
m.yrep=Addbs(m.yrep)
Local gnbre
gnbre=Adir(gabase,m.yrep+"*.jpg")
If gnbre=0
Return .F.
Endi
Messagebox(Trans(gnbre)+" photos in "+m.yrep,0+32+4096,'',1200)
Set Defa To Addbs(Justpath(Sys(16,1)))
With Thisform._scrollcontainer1.viewframe.clientarea
.backcolor=0
.backstyle=1
For i=1 To gnbre
.AddObject("image"+Trans(i),"image")
With Eval(".image"+Trans(i))
.Anchor=0
.borderStyle=1
.Stretch=Thisform.spinner1.Value
if !thisform.spinner1.value=0
.Width=.Parent.Width
.Height=.Width
endi
.Left=1
.Picture=m.yrep+gabase(i,1)
.ToolTipText=Justfname(.Picture)+Chr(13)+Trans(gabase(i,2))+ "octets"+Chr(13)+"Date:"+Dtoc(gabase(i,3))
If i=1
.Top=0
Else
.Top=Eval(".parent.image"+Trans(i-1)+".top")+Eval(".parent.image"+Trans(i-1)+".height")+thisform.xint
Endi
Wait Window ("image"+Trans(i)) Nowait
.Visible=.T.
Endwith
bindevent(Eval(".image"+Trans(i)),"mousewheel",thisform,"my")
Endfor
.Refresh
Endwith
This.Enabled=.F.
This.Parent.spinner1.Enabled=.F.
With Thisform._scrollcontainer1
.ScrollBars=3
.autoScroll=.T.
.calcAutoRange()
.SpecialEffect=2
.resize()
wait clea
Endwith
Endproc
procedure my &&I dded this routine to support mouseWheel on images
LPARAMETERS nDirection, nShift, nXCoord, nYCoord
dodefault()
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.mouseWheel(nDirection, nShift, nXCoord, nYCoord)
endproc
Procedure label1.Click
Local m.myvar
TEXT to m.myvar noshow
*download the scrolling container class from http://www.arg.kirov.ru/downloads/
*keep only the scont class(vcx+vct).
it can embed a great quantity of controls here tested with an images folder(more 300 big images).
Can set the stretch images as (0 clip,1 Isometric ,2 extension).
Before embedding objects must set the properties to make the container working as expected (form.init) and
issue the resize method mandatory to make the scrollbars visibles.
there is 2 containers in the scrolling container(Viewframe & clientArea: here add objects)
this class have the capability to work with mouseWheel (see the property wheelScrolllines to set the
number of lines with mouseWheel)-(dont work with arrows or PGup,PgDown).
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: yimg
Important: a classic vfp form is a scrollable container if initialize its property scrollbars to 2( scroll vertical) or 3 (scroll vertical+horizontal) and then can embed too controls.
can download these 2 free classes from this link (links to the 2 sites pointed are always broken)
/image%2F1435407%2F20150307%2Fob_9cbb93_demo5.png)
Scrolling texts & images in visual foxpro - Visual Foxpro codes
Below 6 codes relative to scrolls text,images,scrollable containers.. *Suggestions and Bug Reports are always Welcome. *1-*A top level form as scrollable container Visual foxpro dont ship any ...
http://yousfi.over-blog.com/2015/03/scrolling-texts-images-in-visual-foxpro.html
A basic vfp richtextbox implementation - Visual Foxpro codes
http://yousfi.over-blog.com/2015/12/a-basic-vfp-richtextbox-implementation.html
see in this link the code *2* where a vfpscrollbar is implemented with adding mousWheel events.