Testing VFP scrollbar container classes .

Published on December 24 2015 by Yousfi Benameur

 
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.

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

Testing VFP scrollbar container classes .

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.

yscroll_containers.rar

https://drive.google.com/file/d/1COtsSWKMmEENFqrdkxX8BMBH-hiAwhpV/view?usp=sharing

can download these 2 free classes from this link (links to the 2 sites pointed are always broken)

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.