The vfpscrollbar containers classes as prg code

Published on by Yousfi Benameur 


The container  vfpscrollbar class is a scrollable container and usefull to embed any kind of vfp controls.it can embed a great quantity of controls as shown in my preview post.
http://yousfi.over-blog.com/2015/12/testing-a-vfp-scrollbar-container-class-application.html

it can be very usefull if it can be translated as a prg class, that what i do in this post.

What i can note: nor the vfp9 class browser , and nor the vfpX browserX class solve safely the conversion of a  multi containersclass .the user must re work the prg delivred manually to make it working.
At this time  there is no  vfp9 application to solve entirely and finely this problem.
here i take the same working example (embedding more than 300 big photos in the container).
i added (this once in the prg class the support for mousewheel event to facilite the scrolling)

how to use this class:
1-as it putting like this code after the main prg caller.
2-with createObject, newobject refering to class saved in a prg file
3-with set proc to this class...additive  (saved in a prg file)


Important: this code is tested on Window10 & Vfp9SP2.
the vfpscrollbar is from SPS site:http://www.sweetpotatosoftware.com/spsblog/2005/08/27/VisualFoxProScrollbarClasses.aspx


update on thirsday 07 january 2015
i added two codes to scroll a form with scrollbars" property>=2.(with APi and with setViewport form method)

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


*1* SPS vfpScrollbar class as prg class  added to code(to make one standalone code).

Publi yform
yform=Newobject("yimg")
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 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 command1 As CommandButton With ;
Top = 1, ;
Left = 275, ;
Height = 37, ;
Width = 109, ;
Anchor = 768, ;
Caption = "Images", ;
Name = "Command1"

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 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 container  vfpscrollbar class is a scrollable container and usefull to embed any kind of vfp controls.
it can embed a great quantity of controls as shown in my preview post.
http://yousfi.over-blog.com/2015/12/testing-a-vfp-scrollbar-container-class-application.html
it can be very usefull as translated as a prg class, that what i do in this post.What i can note: nor the vfp9 class browser , and nor the vfpX browserX class solve safely the conversion of a  multi containersclass .the user must re work the prg delivred manually to make it working.
At this time  there is no  vfp9 application to solve entirely and finely this problem.
here i take same working example (container embedding more than 300 big photos).
i added (this once in the prg class the support for mousewheel event to facilite the scrolling)
*how to use this class:
1-as it putting like this code after the main prg caller.
2-with createObject, newobject refering to class saved as a prg file
3-"set proc to this prg class...additive"
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc

Procedure Destroy
Clea Events
Endproc

Enddefine
*
*-- EndDefine: yimg

*************************************
*vfpscrollclass converted as prg class
*it can replace the vfpscrollbar.vcx in flat code text and avoid to carry the physical visual class (vcx+vct)
*make it at the end of a calling prg,use it with createObject,newObject or set procedure to...(if saved as prg).

Define Class sbcontainer As Container
Width = 200
Height = 200
Name = "sbcontainer"

Enddefine

Define Class sbscrollcontainer As Container
Width = 212
Height = 211
BorderWidth = 0
*-- 0 = None 1 = Horizontal 2 = Vertical 3 = Both
ScrollBars = 3
scrollablewidth = 400
scrollableheight = 400
baselinetop = 0
baselineleft = 0
Name = "sbscrollcontainer"

Add Object scrollbarvertical1 As scrollbarvertical With ;
Tag = "SkipScrollbar", ;
Top = 1, ;
Left = 194, ;
Name = "Scrollbarvertical1", ;
Sbshape1.Name = "Sbshape1", ;
Scrollendup1.Sbshape2.Name = "Sbshape2", ;
Scrollendup1.Sbshape1.Name = "Sbshape1", ;
Scrollendup1.Sbshape3.Name = "Sbshape3", ;
Scrollendup1.Splabel1.Name = "Splabel1", ;
Scrollendup1.Spline9.Name = "Spline9", ;
Scrollendup1.Spline10.Name = "Spline10", ;
Scrollendup1.Spline12.Name = "Spline12", ;
Scrollendup1.Spline11.Name = "Spline11", ;
Scrollendup1.Spline13.Name = "Spline13", ;
Scrollendup1.Spline14.Name = "Spline14", ;
Scrollendup1.Sbshape4.Name = "Sbshape4", ;
Scrollendup1.Name = "Scrollendup1", ;
Scrollenddown1.Sbshape2.Name = "Sbshape2", ;
Scrollenddown1.Sbshape1.Name = "Sbshape1", ;
Scrollenddown1.Sbshape3.Name = "Sbshape3", ;
Scrollenddown1.Splabel1.Name = "Splabel1", ;
Scrollenddown1.Spline9.Name = "Spline9", ;
Scrollenddown1.Spline10.Name = "Spline10", ;
Scrollenddown1.Spline12.Name = "Spline12", ;
Scrollenddown1.Spline11.Name = "Spline11", ;
Scrollenddown1.Spline13.Name = "Spline13", ;
Scrollenddown1.Spline14.Name = "Spline14", ;
Scrollenddown1.Sbshape4.Name = "Sbshape4", ;
Scrollenddown1.Name = "Scrollenddown1", ;
Scrollthumbvertical1.Sbshape2.Name = "Sbshape2", ;
Scrollthumbvertical1.Sbshape1.Name = "Sbshape1", ;
Scrollthumbvertical1.Sbshape3.Name = "Sbshape3", ;
Scrollthumbvertical1.Spline9.Name = "Spline9", ;
Scrollthumbvertical1.Spline10.Name = "Spline10", ;
Scrollthumbvertical1.Spline11.Name = "Spline11", ;
Scrollthumbvertical1.Spline12.Name = "Spline12", ;
Scrollthumbvertical1.Spline13.Name = "Spline13", ;
Scrollthumbvertical1.Spline14.Name = "Spline14", ;
Scrollthumbvertical1.Sbshape4.Name = "Sbshape4", ;
Scrollthumbvertical1.Name = "Scrollthumbvertical1"

Add Object scrollbarhorizontal1 As scrollbarhorizontal With ;
Tag = "SkipScrollbar", ;
Top = 193, ;
Left = 1, ;
Name = "Scrollbarhorizontal1", ;
Sbshape1.Name = "Sbshape1", ;
Scrollendleft1.Sbshape2.Name = "Sbshape2", ;
Scrollendleft1.Sbshape1.Name = "Sbshape1", ;
Scrollendleft1.Sbshape3.Name = "Sbshape3", ;
Scrollendleft1.Splabel1.Name = "Splabel1", ;
Scrollendleft1.Spline12.Name = "Spline12", ;
Scrollendleft1.Spline11.Name = "Spline11", ;
Scrollendleft1.Spline13.Name = "Spline13", ;
Scrollendleft1.Spline14.Name = "Spline14", ;
Scrollendleft1.Spline10.Name = "Spline10", ;
Scrollendleft1.Sbshape4.Name = "Sbshape4", ;
Scrollendleft1.Spline9.Name = "Spline9", ;
Scrollendleft1.Name = "Scrollendleft1", ;
Scrollendright1.Sbshape2.Name = "Sbshape2", ;
Scrollendright1.Sbshape1.Name = "Sbshape1", ;
Scrollendright1.Sbshape3.Name = "Sbshape3", ;
Scrollendright1.Splabel1.Name = "Splabel1", ;
Scrollendright1.Spline9.Name = "Spline9", ;
Scrollendright1.Spline12.Name = "Spline12", ;
Scrollendright1.Spline11.Name = "Spline11", ;
Scrollendright1.Spline13.Name = "Spline13", ;
Scrollendright1.Spline14.Name = "Spline14", ;
Scrollendright1.Sbshape4.Name = "Sbshape4", ;
Scrollendright1.Spline10.Name = "Spline10", ;
Scrollendright1.Name = "Scrollendright1", ;
Scrollthumbhorizontal1.Sbshape2.Name = "Sbshape2", ;
Scrollthumbhorizontal1.Sbshape1.Name = "Sbshape1", ;
Scrollthumbhorizontal1.Sbshape3.Name = "Sbshape3", ;
Scrollthumbhorizontal1.Spline9.Name = "Spline9", ;
Scrollthumbhorizontal1.Spline11.Name = "Spline11", ;
Scrollthumbhorizontal1.Spline12.Name = "Spline12", ;
Scrollthumbhorizontal1.Spline13.Name = "Spline13", ;
Scrollthumbhorizontal1.Spline14.Name = "Spline14", ;
Scrollthumbhorizontal1.Spline10.Name = "Spline10", ;
Scrollthumbhorizontal1.Sbshape4.Name = "Sbshape4", ;
Scrollthumbhorizontal1.Name = "Scrollthumbhorizontal1"

Procedure  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 Setup
This.positionscrollbars()
This.ScrollBars = This.ScrollBars
This.scrollableheight = This.scrollableheight
This.scrollablewidth = This.scrollablewidth

Endproc

Procedure positionscrollbars
This.scrollbarhorizontal1.Left = 0
This.scrollbarhorizontal1.Width = This.Width - This.scrollbarvertical1.Width
This.scrollbarhorizontal1.Top = This.Height - This.scrollbarhorizontal1.Height

This.scrollbarvertical1.Top = 0
This.scrollbarvertical1.Height = This.Height - This.scrollbarhorizontal1.Height
This.scrollbarvertical1.Left = This.Width - This.scrollbarvertical1.Width

This.scrollbarhorizontal1.Anchor = 14
This.scrollbarvertical1.Anchor = 13

This.scrollbarhorizontal1.ZOrder(0)
This.scrollbarvertical1.ZOrder(0)
Endproc

Procedure scrollbars_assign
Lparameters vNewVal
This.ScrollBars = m.vNewVal
Do Case
	Case m.vNewVal = 1
		This.scrollbarhorizontal1.Visible = .T.
		This.scrollbarvertical1.Visible = .F.
	Case m.vNewVal = 2
		This.scrollbarhorizontal1.Visible = .F.
		This.scrollbarvertical1.Visible = .T.
	Case m.vNewVal = 3
		This.scrollbarhorizontal1.Visible = .T.
		This.scrollbarvertical1.Visible = .T.
	Otherwise && None
		This.scrollbarhorizontal1.Visible = .F.
		This.scrollbarvertical1.Visible = .F.
Endcase
Endproc

Procedure scrollablewidth_assign
Lparameters vNewVal
This.scrollablewidth = m.vNewVal
This.scrollbarhorizontal1.Max = m.vNewVal
Endproc

Procedure scrollableheight_assign
Lparameters vNewVal
This.scrollableheight = m.vNewVal
This.scrollbarvertical1.Max = m.vNewVal
Endproc


Procedure Init
This.Setup()
Endproc


Procedure scrollbarvertical1.Change
Local loControl, lnChange, lnAnchorWas
lnChange = This.Parent.baselinetop - Int(This.Value)
If lnChange != 0
	loControl = .Null.
	For Each loControl In This.Parent.Controls
		lnAnchorWas = 0
		If loControl.Tag != "SkipScrollbar"
			If Pemstatus(loControl, "Anchor", 5)
				lnAnchorWas = loControl.Anchor
				loControl.Anchor = 0
			Endif
			loControl.Top = loControl.Top + lnChange
			If lnAnchorWas > 0
				loControl.Anchor = lnAnchorWas
			Endif
		Endif
	Next
	This.Parent.baselinetop = Int(This.Value)
Endif
Endproc

Procedure scrollbarhorizontal1.Change
Local loControl, lnChange, lnAnchorWas
lnChange = This.Parent.baselineleft - Int(This.Value)
If lnChange != 0
	loControl = .Null.
	For Each loControl In This.Parent.Controls
		lnAnchorWas = 0
		If loControl.Tag != "SkipScrollbar"
			If Pemstatus(loControl, "Anchor", 5)
				lnAnchorWas = loControl.Anchor
				loControl.Anchor = 0
			Endif
			loControl.Left = loControl.Left + lnChange
			If lnAnchorWas > 0
				loControl.Anchor = lnAnchorWas
			Endif
		Endif
	Next
	This.Parent.baselineleft = Int(This.Value)
Endif
Endproc

Enddefine

Define Class sbshape As Shape
Height = 17
Width = 100
Name = "sbshape"
Enddefine

Define Class ScrollBar As Container
Width = 17
Height = 195
BackStyle = 0
BorderWidth = 0
BackColor = Rgb(255,255,255)
*-- 1 = Vertical 2 = Horizontal
direction = 1
Min = 0
Max = 500
largechange = 100
smallchange = 25
*-- Specifies the current state of a control.
Value = 0
valueworth = 0
Name = "scrollbar"

Add Object Sbshape1 As sbshape With ;
Top = 1, ;
Left = 1, ;
Height = 192, ;
Width = 16, ;
Anchor = 0, ;
BorderStyle = 1, ;
BorderWidth = 1, ;
Curvature = 4, ;
BackColor = Rgb(247,247,243), ;
BorderColor = Rgb(239,239,236), ;
Name = "Sbshape1"

Procedure max_assign
Lparameters vNewVal
m.vNewVal = Max(This.Min, m.vNewVal)
This.Max = m.vNewVal
If m.vNewVal > This.Min
	This.changethumbsize(.T.)
Else
	This.changethumbsize(.F.)
Endif
Endproc

Procedure min_assign
Lparameters vNewVal
m.vNewVal = Min(This.Max, m.vNewVal)
This.Min = m.vNewVal
If m.vNewVal < This.Max
	This.changethumbsize(.T.)
Else
	This.changethumbsize(.F.)
Endif
Endproc

Procedure value_assign
Lparameters vNewVal
Local lnChange
m.vNewVal = Min(This.Max, Max(This.Min, m.vNewVal))
lnChange = m.vNewVal - This.Value
This.Value = m.vNewVal
If lnChange != 0
	If This.direction = 1
		This.Scrollthumbvertical1.Top = Min(This.Scrollenddown1.Top - This.Scrollthumbvertical1.Height, Max(This.Scrollthumbvertical1.Top + (lnChange * Max(0, This.valueworth)), This.Scrollendup1.Height + 1))
	Else
		This.Scrollthumbhorizontal1.Left = Min(This.Scrollendright1.Left - This.Scrollthumbhorizontal1.Width, Max(This.Scrollthumbhorizontal1.Left + (lnChange * Max(0, This.valueworth)), This.Scrollendleft1.Width))
	Endif
	This.Change()
Endif
Endproc

Procedure changethumbsize
Lparameters tlVisible
Local lnMinSize, lnMaxSize, lnUnusedSpace
lnMinSize = 24 && minimum thumb size

If This.direction = 1
	lnUnusedSpace = This.Scrollenddown1.Top - (This.Scrollendup1.Top + This.Scrollendup1.Height)
	lnMinSize = Max(lnMinSize, 100 * (lnUnusedSpace/(This.Max - This.Min)))
	lnMaxSize = Min(lnMinSize, lnUnusedSpace)
	This.Scrollthumbvertical1.Height = lnMaxSize
	This.Scrollthumbvertical1.Visible = tlVisible
Else
	lnUnusedSpace = This.Scrollendright1.Left - (This.Scrollendleft1.Left + This.Scrollendleft1.Width)
	lnMinSize = Max(lnMinSize, 100 * (lnUnusedSpace/(This.Max - This.Min)))
	lnMaxSize = Min(lnMinSize, lnUnusedSpace)
	This.Scrollthumbhorizontal1.Width = lnMaxSize
	This.Scrollthumbhorizontal1.Visible = tlVisible
Endif
Endproc

Procedure valueworth_access
Local lnValueWorth, lnTotalBetween
lnTotalBetween = This.Max - This.Min
*!*	IF this.direction = 1
*!*		lnValueWorth = (this.Height - (this.scrollendup1.height + this.scrollthumbvertical1.height)) / lnTotalBetween
*!*	ELSE
*!*		lnValueWorth = (this.width - (this.scrollendleft1.width + this.scrollthumbhorizontal1.width)) / lnTotalBetween && + this.scrollendright1.width
*!*	ENDIF
If This.direction = 1
	lnValueWorth = (This.Scrollenddown1.Top - ;
		(This.Scrollendup1.Top + This.Scrollendup1.Height) - ;
		this.Scrollthumbvertical1.Height) / lnTotalBetween
Else
	lnValueWorth = (This.Scrollendright1.Left - ;
		(This.Scrollendleft1.Left + This.Scrollendleft1.Width) - ;
		this.Scrollthumbhorizontal1.Width) / lnTotalBetween
Endif
Return lnValueWorth
Endproc

Procedure Init
Local loControl
loControl = .Null.
If This.direction = 1
	This.Sbshape1.Left = 1
	This.Sbshape1.Top = 1
	This.Sbshape1.Width = This.Width - 1
	This.Sbshape1.Height = This.Height - 2
Else
	This.Sbshape1.Left = 1
	This.Sbshape1.Top = 1
	This.Sbshape1.Width = This.Width - 2
	This.Sbshape1.Height = This.Height - 1
Endif
This.Sbshape1.Anchor = 15

For Each m.loControl In This.Controls
	If Inlist(m.loControl.Class, "Scrollendup", "Scrollenddown", "Scrollendleft", "Scrollendright", ;
			"Scrollthumbvertical", "Scrollthumbhorizontal")
		m.loControl.Setup()
	Endif
Next
*!*	this.max = this.max
*!*	this.min = this.min
*!*	this.value = this.value
Endproc

*-- Occurs when the user is dragging the scrollbar thumb (elevator).
Procedure Scroll
Endproc

*-- Occurs when the user has caused the value to of the scrollbar to change.
Procedure Change
Endproc

Procedure Sbshape1.DblClick
This.Click()
Endproc

Procedure Sbshape1.Click
If Amouseobj(aryTemp) > 0
	If This.Parent.direction = 1
		This.Parent.Value = This.Parent.Value + Iif(aryTemp(4) <= This.Parent.Scrollthumbvertical1.Top, -(This.Parent.largechange), This.Parent.largechange)
	Else
		This.Parent.Value = This.Parent.Value + Iif(aryTemp(3) <= This.Parent.Scrollthumbhorizontal1.Left, -(This.Parent.largechange), This.Parent.largechange)
	Endif
Endif
Endproc

Enddefine

Define Class scrollbarhorizontal As ScrollBar
Width = 195
Height = 17
direction = 2
Name = "scrollbarhorizontal"
Sbshape1.Top = 0
Sbshape1.Left = 1
Sbshape1.Height = 16
Sbshape1.Width = 193
Sbshape1.Name = "Sbshape1"

Add Object Scrollendleft1 As scrollendleft With ;
Top = 0, ;
Left = 1, ;
Name = "Scrollendleft1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Splabel1.Name = "Splabel1", ;
Spline12.Name = "Spline12", ;
Spline11.Name = "Spline11", ;
Spline13.Name = "Spline13", ;
Spline14.Name = "Spline14", ;
Spline10.Name = "Spline10", ;
Sbshape4.Name = "Sbshape4", ;
Spline9.Name = "Spline9"

Add Object Scrollendright1 As scrollendright With ;
Top = 0, ;
Left = 178, ;
position = 2, ;
Name = "Scrollendright1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Splabel1.Name = "Splabel1", ;
Spline9.Name = "Spline9", ;
Spline12.Name = "Spline12", ;
Spline11.Name = "Spline11", ;
Spline13.Name = "Spline13", ;
Spline14.Name = "Spline14", ;
Sbshape4.Name = "Sbshape4", ;
Spline10.Name = "Spline10"

Add Object Scrollthumbhorizontal1 As scrollthumbhorizontal With ;
Top = 1, ;
Left = 17, ;
Name = "Scrollthumbhorizontal1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Sbshape4.Name = "Sbshape4"

Enddefine

Define Class scrollbarvertical As ScrollBar
Width = 16
Height = 195
Name = "scrollbarvertical"
Sbshape1.Top = 1
Sbshape1.Left = 1
Sbshape1.Name = "Sbshape1"

Add Object Scrollendup1 As scrollendup With ;
Top = 1, ;
Left = 0, ;
Name = "Scrollendup1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Splabel1.Name = "Splabel1", ;
Spline9.Name = "Spline9", ;
Spline10.Name = "Spline10", ;
Spline12.Name = "Spline12", ;
Spline11.Name = "Spline11", ;
Spline13.Name = "Spline13", ;
Spline14.Name = "Spline14", ;
Sbshape4.Name = "Sbshape4"

Add Object Scrollenddown1 As scrollenddown With ;
Top = 177, ;
Left = 0, ;
position = 2, ;
Name = "Scrollenddown1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Splabel1.Name = "Splabel1", ;
Spline9.Name = "Spline9", ;
Spline10.Name = "Spline10", ;
Spline12.Name = "Spline12", ;
Spline11.Name = "Spline11", ;
Spline13.Name = "Spline13", ;
Spline14.Name = "Spline14", ;
Sbshape4.Name = "Sbshape4"

Add Object Scrollthumbvertical1 As scrollthumbvertical With ;
Top = 18, ;
Left = 0, ;
Name = "Scrollthumbvertical1", ;
Sbshape2.Name = "Sbshape2", ;
Sbshape1.Name = "Sbshape1", ;
Sbshape3.Name = "Sbshape3", ;
Spline9.Name = "Spline9", ;
Spline10.Name = "Spline10", ;
Spline11.Name = "Spline11", ;
Spline12.Name = "Spline12", ;
Spline13.Name = "Spline13", ;
Spline14.Name = "Spline14", ;
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollend As Container
Width = 16
Height = 17
BackStyle = 0
BorderWidth = 0
SpecialEffect = 0
Style = 3
*-- 1 = Up/Left 2 = Down/Right
position = 1
Name = "scrollend"

Add Object Sbshape2 As sbshape With ;
Top = 1, ;
Left = 1, ;
Height = 16, ;
Width = 15, ;
Curvature = 4, ;
BackColor = Rgb(184,203,246), ;
BorderColor = Rgb(159,181,210), ;
Name = "Sbshape2"

Add Object Sbshape1 As sbshape With ;
Top = 0, ;
Left = 1, ;
Height = 16, ;
Width = 14, ;
Curvature = 4, ;
BackColor = Rgb(255,255,255), ;
BorderColor = Rgb(255,255,255), ;
Name = "Sbshape1"

Add Object Sbshape3 As sbshape With ;
Top = 1, ;
Left = 2, ;
Height = 14, ;
Width = 12, ;
Curvature = 4, ;
BackColor = Rgb(200,219,253), ;
BorderColor = Rgb(184,203,246), ;
Name = "Sbshape3"

Add Object Splabel1 As splabel With ;
FontBold = .F., ;
FontName = "Comic Sans MS", ;
FontSize = 15, ;
BackStyle = 0, ;
Height = 17, ;
Left = 3, ;
Top = 0, ;
Width = 9, ;
ForeColor = Rgb(77,97,133), ;
Name = "Splabel1"

Add Object Spline9 As spline With ;
BorderWidth = 1, ;
DrawMode = 12, ;
Height = 0, ;
Left = 3, ;
Top = 2, ;
Width = 9, ;
BorderColor = Rgb(214,231,255), ;
Name = "Spline9"

Add Object Spline10 As spline With ;
BorderWidth = 1, ;
DrawMode = 12, ;
Height = 1, ;
Left = 2, ;
Top = 3, ;
Width = 0, ;
BorderColor = Rgb(214,231,255), ;
Name = "Spline10"

Add Object Spline12 As spline With ;
Height = 0, ;
Left = 3, ;
Top = 1, ;
Visible = .F., ;
Width = 9, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline12"

Add Object Spline11 As spline With ;
Height = 11, ;
Left = 1, ;
Top = 2, ;
Visible = .F., ;
Width = 0, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline11"

Add Object Spline13 As spline With ;
Height = 0, ;
Left = 3, ;
Top = 2, ;
Visible = .F., ;
Width = 10, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline13"

Add Object Spline14 As spline With ;
Height = 0, ;
Left = 2, ;
Top = 3, ;
Visible = .F., ;
Width = 1, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline14"

Add Object Sbshape4 As sbshape With ;
Top = -1, ;
Left = 0, ;
Height = 19, ;
Width = 17, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Name = "Sbshape4"

Procedure Setup
With This
	.Sbshape1.Anchor = 15
	.Sbshape2.Anchor = 15
	.Sbshape3.Anchor = 15
	.Sbshape4.Anchor = 15
	.Splabel1.Anchor = 768
	.Spline14.Anchor = 3
	If This.Parent.direction = 1
		.Left = 0
		If .position = 1
			.Top = 1
			.Anchor = 11
		Else
			.Top = .Parent.Height - .Height - 1
			.Anchor = 14
		Endif
		.Spline9.Anchor = 11
		.Spline10.Anchor = 3
		.Spline11.Anchor = 7
		.Spline12.Anchor = 11
		.Spline13.Anchor = 11
		.Width = This.Parent.Width - 1
	Else
		.Top = 0
		If .position = 1
			.Left = 1
			.Anchor = 7
		Else
			.Left = .Parent.Width - .Width
			.Anchor = 13
		Endif
		.Spline9.Anchor = 7
		.Spline10.Anchor = 6
		.Spline11.Anchor = 11
		.Spline12.Anchor = 7
		.Spline13.Anchor = 7
		.Height = This.Parent.Height - 1
	Endif
Endwith
Endproc

Procedure Sbshape4.Click
If This.Parent.position = 1
	This.Parent.Parent.Value = This.Parent.Parent.Value - This.Parent.Parent.smallchange
Else
	This.Parent.Parent.Value = This.Parent.Parent.Value + This.Parent.Parent.smallchange
Endif
Endproc

Procedure Sbshape4.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	This.Parent.Sbshape3.BackColor = Rgb(214, 231, 255)
	This.Parent.Spline11.Visible = .F.
	This.Parent.Spline12.Visible = .F.
	This.Parent.Spline13.Visible = .F.
	This.Parent.Spline14.Visible = .F.
Endif
Endproc

Procedure Sbshape4.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	This.Parent.Sbshape3.BackColor = Rgb(165, 191, 251)
	This.Parent.Spline11.Visible = .T.
	This.Parent.Spline12.Visible = .T.
	This.Parent.Spline13.Visible = .T.
	This.Parent.Spline14.Visible = .T.
Endif
Endproc

Procedure Sbshape4.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.Sbshape3.BackColor = Rgb(184,203,246)
Endproc

Procedure Sbshape4.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.Sbshape3.BackColor = Rgb(214, 231, 255)
Endproc

Procedure Sbshape4.DblClick
This.Click()
Endproc

Enddefine
*
Define Class scrollenddown As scrollend
Name = "scrollenddown"
Sbshape2.Name = "Sbshape2"
Sbshape1.Name = "Sbshape1"
Sbshape3.Name = "Sbshape3"
Splabel1.Height = 23
Splabel1.Left = 4
Splabel1.Top = -8
Splabel1.Width = 9
Splabel1.Rotation = 180
Splabel1.Name = "Splabel1"
Spline9.Name = "Spline9"
Spline10.Name = "Spline10"
Spline12.Name = "Spline12"
Spline11.Left = 2
Spline11.Top = 2
Spline11.Name = "Spline11"
Spline13.Name = "Spline13"
Spline14.Left = 3
Spline14.Top = 3
Spline14.Name = "Spline14"
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollendleft As scrollend
Width = 18
Height = 16
Name = "scrollendleft"
Sbshape2.Top = 1
Sbshape2.Left = 1
Sbshape2.Height = 15
Sbshape2.Width = 16
Sbshape2.ZOrderSet = 0
Sbshape2.Name = "Sbshape2"
Sbshape1.Top = 1
Sbshape1.Left = 0
Sbshape1.Height = 14
Sbshape1.Width = 16
Sbshape1.ZOrderSet = 1
Sbshape1.Name = "Sbshape1"
Sbshape3.Top = 2
Sbshape3.Left = 1
Sbshape3.Height = 12
Sbshape3.Width = 14
Sbshape3.ZOrderSet = 2
Sbshape3.Name = "Sbshape3"
Splabel1.Height = 17
Splabel1.Left = 3
Splabel1.Top = 0
Splabel1.Width = 22
Splabel1.ZOrderSet = 3
Splabel1.Rotation = 90
Splabel1.Name = "Splabel1"
Spline9.Height = 9
Spline9.Left = 2
Spline9.Top = 4
Spline9.Width = 0
Spline9.ZOrderSet = 9
Spline9.Name = "Spline9"
Spline10.Left = 3
Spline10.Top = 12
Spline10.ZOrderSet = 8
Spline10.Name = "Spline10"
Spline12.Height = 9
Spline12.Left = 1
Spline12.Top = 4
Spline12.Width = 0
Spline12.ZOrderSet = 4
Spline12.Name = "Spline12"
Spline11.Height = 0
Spline11.Left = 2
Spline11.Top = 2
Spline11.Width = 11
Spline11.ZOrderSet = 5
Spline11.Name = "Spline11"
Spline13.Height = 10
Spline13.Left = 2
Spline13.Top = 3
Spline13.Width = 0
Spline13.ZOrderSet = 6
Spline13.Name = "Spline13"
Spline14.Left = 3
Spline14.Top = 3
Spline14.ZOrderSet = 7
Spline14.Name = "Spline14"
Sbshape4.Top = -1
Sbshape4.Left = -1
Sbshape4.Height = 17
Sbshape4.Width = 19
Sbshape4.ZOrderSet = 10
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollendright As scrollend
Width = 18
Height = 16
Name = "scrollendright"
Sbshape2.Left = 1
Sbshape2.Height = 15
Sbshape2.Width = 16
Sbshape2.ZOrderSet = 0
Sbshape2.Name = "Sbshape2"
Sbshape1.Top = 1
Sbshape1.Left = 0
Sbshape1.Height = 14
Sbshape1.Width = 16
Sbshape1.ZOrderSet = 1
Sbshape1.Name = "Sbshape1"
Sbshape3.Top = 2
Sbshape3.Left = 1
Sbshape3.Height = 12
Sbshape3.Width = 14
Sbshape3.ZOrderSet = 2
Sbshape3.Name = "Sbshape3"
Splabel1.Height = 16
Splabel1.Left = -9
Splabel1.Top = 1
Splabel1.Width = 23
Splabel1.ZOrderSet = 3
Splabel1.Rotation = 270
Splabel1.Name = "Splabel1"
Spline9.Height = 9
Spline9.Left = 2
Spline9.Top = 4
Spline9.Width = 0
Spline9.ZOrderSet = 4
Spline9.Name = "Spline9"
Spline10.Left = 3
Spline10.Top = 12
Spline10.ZOrderSet = 9
Spline10.Name = "Spline10"
Spline12.Height = 9
Spline12.Left = 1
Spline12.Top = 4
Spline12.Width = 0
Spline12.ZOrderSet = 5
Spline12.Name = "Spline12"
Spline11.Height = 0
Spline11.Left = 2
Spline11.Top = 2
Spline11.Width = 11
Spline11.ZOrderSet = 6
Spline11.Name = "Spline11"
Spline13.Height = 10
Spline13.Left = 2
Spline13.Top = 3
Spline13.Width = 0
Spline13.ZOrderSet = 7
Spline13.Name = "Spline13"
Spline14.Left = 3
Spline14.Top = 3
Spline14.ZOrderSet = 8
Spline14.Name = "Spline14"
Sbshape4.Left = -1
Sbshape4.Height = 17
Sbshape4.Width = 19
Sbshape4.ZOrderSet = 10
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollendup As scrollend
Name = "scrollendup"
Sbshape2.Name = "Sbshape2"
Sbshape1.Name = "Sbshape1"
Sbshape3.Name = "Sbshape3"
Splabel1.Name = "Splabel1"
Spline9.Name = "Spline9"
Spline10.Name = "Spline10"
Spline12.Name = "Spline12"
Spline11.Left = 2
Spline11.Top = 2
Spline11.Name = "Spline11"
Spline13.Name = "Spline13"
Spline14.Left = 3
Spline14.Top = 3
Spline14.Name = "Spline14"
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollthumb As Container
Width = 16
Height = 61
BorderWidth = 0
Style = 3
mousedownat = 0
Name = "scrollthumb"

Add Object Sbshape2 As sbshape With ;
Top = 1, ;
Left = 1, ;
Height = 60, ;
Width = 15, ;
Curvature = 4, ;
BackColor = Rgb(184,203,246), ;
BorderColor = Rgb(159,181,210), ;
Name = "Sbshape2"

Add Object Sbshape1 As sbshape With ;
Top = 0, ;
Left = 1, ;
Height = 60, ;
Width = 14, ;
BorderWidth = 1, ;
Curvature = 4, ;
BackColor = Rgb(255,255,255), ;
BorderColor = Rgb(255,255,255), ;
Name = "Sbshape1"

Add Object Sbshape3 As sbshape With ;
Top = 1, ;
Left = 2, ;
Height = 58, ;
Width = 12, ;
BorderWidth = 1, ;
Curvature = 4, ;
BackColor = Rgb(200,219,253), ;
BorderColor = Rgb(184,203,246), ;
Name = "Sbshape3"

Add Object Spline9 As spline With ;
BorderWidth = 1, ;
DrawMode = 12, ;
Height = 0, ;
Left = 3, ;
Top = 2, ;
Width = 9, ;
BorderColor = Rgb(214,231,255), ;
Name = "Spline9"

Add Object Spline10 As spline With ;
BorderWidth = 1, ;
DrawMode = 12, ;
Height = 1, ;
Left = 2, ;
Top = 3, ;
Width = 0, ;
BorderColor = Rgb(214,231,255), ;
Name = "Spline10"


Add Object Spline11 As spline With ;
Height = 55, ;
Left = 1, ;
Top = 2, ;
Visible = .F., ;
Width = 0, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline11"

Add Object Spline12 As spline With ;
Height = 0, ;
Left = 3, ;
Top = 1, ;
Visible = .F., ;
Width = 9, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline12"

Add Object Spline13 As spline With ;
Height = 0, ;
Left = 3, ;
Top = 2, ;
Visible = .F., ;
Width = 10, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline13"

Add Object Spline14 As spline With ;
Height = 0, ;
Left = 2, ;
Top = 3, ;
Visible = .F., ;
Width = 1, ;
BorderColor = Rgb(147,167,219), ;
Name = "Spline14"

Add Object Sbshape4 As sbshape With ;
Top = -1, ;
Left = 0, ;
Height = 63, ;
Width = 17, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Name = "Sbshape4"

Add Object sbcontainer1 As sbcontainer With ;
Top = 21, ;
Left = 2, ;
Width = 13, ;
Height = 18, ;
BackStyle = 0, ;
BorderWidth = 0, ;
Name = "Sbcontainer1"

Procedure Setup
With This
	.Sbshape1.Anchor = 15
	.Sbshape2.Anchor = 15
	.Sbshape3.Anchor = 15
	.Sbshape4.Anchor = 15

	.sbcontainer1.Anchor = 768

	.Spline10.Anchor = 3
	.Spline14.Anchor = 3
	If This.Parent.direction = 1
		.Top = 18
		.Left = 0
		.Spline9.Anchor = 11
		.Spline10.Anchor = 3
		.Spline11.Anchor = 7
		.Spline12.Anchor = 11
		.Spline13.Anchor = 11
		.Width = This.Parent.Width
	Else
		.Top = 1
		.Left = 18
		.Spline9.Anchor = 7
		.Spline10.Anchor = 6
		.Spline11.Anchor = 11
		.Spline12.Anchor = 7
		.Spline13.Anchor = 7
		.Height = This.Parent.Height - 1
	Endif
Endwith
Endproc

Procedure Sbshape4.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.Sbshape3.BackColor = Rgb(214, 231, 255)
Endproc

Procedure Sbshape4.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.Sbshape3.BackColor = Rgb(184,203,246)
This.Parent.mousedownat = 0
Endproc


Procedure Sbshape4.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	If This.Parent.Parent.direction = 1
		This.Parent.mousedownat = nYCoord
	Else
		This.Parent.mousedownat = nXCoord
	Endif
	This.Parent.Sbshape3.BackColor = Rgb(165, 191, 251)
	This.Parent.Spline11.Visible = .T.
	This.Parent.Spline12.Visible = .T.
	This.Parent.Spline13.Visible = .T.
	This.Parent.Spline14.Visible = .T.
Endif
Endproc

Procedure Sbshape4.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	This.Parent.mousedownat = 0
	This.Parent.Sbshape3.BackColor = Rgb(214, 231, 255)
	This.Parent.Spline11.Visible = .F.
	This.Parent.Spline12.Visible = .F.
	This.Parent.Spline13.Visible = .F.
	This.Parent.Spline14.Visible = .F.
Endif
Endproc

Procedure Sbshape4.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
Local lnMovement, llMax, llMin, lnLimit

If This.Parent.mousedownat != 0 And m.nButton = 1
	llMax = .F.
	llMin = .F.
	If This.Parent.Parent.direction = 1 && Vertical
		If m.nYCoord != This.Parent.mousedownat
			m.lnMovement = This.Parent.Top + (m.nYCoord - This.Parent.mousedownat)
			If m.lnMovement < 18
				m.lnMovement = 18
				llMin = .T.
			Else
				lnLimit = This.Parent.Parent.Scrollenddown1.Top - This.Parent.Height
				If m.lnMovement > lnLimit
					m.lnMovement = lnLimit
					llMax = .T.
				Endif
			Endif
			Do Case
				Case llMin
					This.Parent.Parent.Value = This.Parent.Parent.Min
				Case llMax
					This.Parent.Parent.Value = This.Parent.Parent.Max
				Otherwise
					This.Parent.Parent.Value = This.Parent.Parent.Value + ((m.lnMovement - This.Parent.Top) / This.Parent.Parent.valueworth)
			Endcase
			This.Parent.mousedownat = m.nYCoord
			This.Parent.Parent.Scroll
		Endif
	Else && Horizontal
		If m.nXCoord != This.Parent.mousedownat
			m.lnMovement = This.Parent.Left + (m.nXCoord - This.Parent.mousedownat)
			If m.lnMovement < 18
				m.lnMovement = 18
				llMin = .T.
			Else
				lnLimit = This.Parent.Parent.Scrollendright1.Left - This.Parent.Width
				If m.lnMovement > lnLimit
					m.lnMovement = lnLimit
					llMax = .T.
				Endif
			Endif
			Do Case
				Case llMin
					This.Parent.Parent.Value = This.Parent.Parent.Min
				Case llMax
					This.Parent.Parent.Value = This.Parent.Parent.Max
				Otherwise
					This.Parent.Parent.Value = This.Parent.Parent.Value + ((m.lnMovement - This.Parent.Left) / This.Parent.Parent.valueworth)
			Endcase
			This.Parent.mousedownat = m.nXCoord
			This.Parent.Parent.Scroll
		Endif
	Endif
Endif
Endproc

Enddefine

Define Class scrollthumbhorizontal As scrollthumb
Width = 62
Height = 16
Name = "scrollthumbhorizontal"
Sbshape2.Top = 0
Sbshape2.Left = 1
Sbshape2.Height = 15
Sbshape2.Width = 61
Sbshape2.Visible = .T.
Sbshape2.ZOrderSet = 0
Sbshape2.Name = "Sbshape2"
Sbshape1.Top = 0
Sbshape1.Left = 1
Sbshape1.Height = 14
Sbshape1.Width = 60
Sbshape1.Visible = .T.
Sbshape1.ZOrderSet = 1
Sbshape1.Name = "Sbshape1"
Sbshape3.Top = 1
Sbshape3.Left = 2
Sbshape3.Height = 12
Sbshape3.Width = 58
Sbshape3.Visible = .T.
Sbshape3.ZOrderSet = 2
Sbshape3.Name = "Sbshape3"
Spline9.Height = 9
Spline9.Left = 3
Spline9.Top = 3
Spline9.Visible = .T.
Spline9.Width = 0
Spline9.ZOrderSet = 3
Spline9.Name = "Spline9"
Spline10.Height = 0
Spline10.Left = 4
Spline10.Top = 11
Spline10.Width = 1
Spline10.ZOrderSet = 8
Spline10.Name = "Spline10"
Spline11.Height = 0
Spline11.Left = 3
Spline11.Top = 1
Spline11.Width = 55
Spline11.ZOrderSet = 4
Spline11.Name = "Spline11"
Spline12.Height = 9
Spline12.Left = 2
Spline12.Top = 3
Spline12.Width = 0
Spline12.ZOrderSet = 5
Spline12.Name = "Spline12"
Spline13.Height = 10
Spline13.Left = 3
Spline13.Top = 2
Spline13.Width = 0
Spline13.ZOrderSet = 6
Spline13.Name = "Spline13"
Spline14.Left = 4
Spline14.Top = 2
Spline14.ZOrderSet = 7
Spline14.Name = "Spline14"
Sbshape4.Top = -1
Sbshape4.Left = -1
Sbshape4.Height = 17
Sbshape4.Width = 63
Sbshape4.Visible = .T.
Sbshape4.ZOrderSet = 10
Sbshape4.Name = "Sbshape4"
Enddefine

Define Class scrollthumbvertical As scrollthumb
Name = "scrollthumbvertical"
Sbshape2.ZOrderSet = 0
Sbshape2.Name = "Sbshape2"
Sbshape1.ZOrderSet = 1
Sbshape1.Name = "Sbshape1"
Sbshape3.ZOrderSet = 2
Sbshape3.Name = "Sbshape3"
Spline9.ZOrderSet = 3
Spline9.Name = "Spline9"
Spline10.ZOrderSet = 4
Spline10.Name = "Spline10"
Spline11.Height = 54
Spline11.Left = 2
Spline11.Top = 3
Spline11.Width = 0
Spline11.ZOrderSet = 5
Spline11.Name = "Spline11"
Spline12.ZOrderSet = 6
Spline12.Name = "Spline12"
Spline13.ZOrderSet = 7
Spline13.Name = "Spline13"
Spline14.Left = 3
Spline14.Top = 3
Spline14.ZOrderSet = 8
Spline14.Name = "Spline14"
Sbshape4.ZOrderSet = 10
Sbshape4.Name = "Sbshape4"
sbcontainer1.ZOrderSet = 9
Enddefine

Define Class splabel As Label
FontBold = .T.
FontName = "Courier New"
FontSize = 16
Alignment = 2
Caption = "^"
Height = 17
Width = 40
ForeColor = Rgb(0,0,160)
Name = "splabel"
Enddefine

Define Class spline As Line
Height = 17
Width = 100
Name = "spline"
Enddefine

The vfpscrollbar containers classes as prg code
The vfpscrollbar containers classes as prg code

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

                  
 

The original scrolling container class from  http://www.arg.kirov.ru/downloads/
its now working as converted prg file and can work as standalone with any code.
I added a routine to mouseWheel on objects contained to scroll with mouse easily.

the scroll container class  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 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* original scroll Container class from  http://www.arg.kirov.ru/
*dont omit vfpsbcnt.h in same folder (its created here)
local m.my
text to m.my noshow
#IFNDEF    __VFP_SBCONTAINER_H_INCLUDED
#DEFINE	__VFP_SBCONTAINER_H_INCLUDED
#DEFINE	SBC_HORS			1
#DEFINE	SBC_VERT			2
#DEFINE	SB_LINEUP			0
#DEFINE	SB_LINELEFT			0
#DEFINE	SB_LINEDOWN			1
#DEFINE	SB_LINERIGHT		1
#DEFINE	SB_PAGEUP			2
#DEFINE	SB_PAGELEFT			2
#DEFINE	SB_PAGEDOWN			3
#DEFINE	SB_PAGERIGHT		3
#DEFINE	SB_THUMBPOSITION	4
#DEFINE	SB_THUMBTRACK		5
#DEFINE	SB_TOP				6
#DEFINE	SB_LEFT				6
#DEFINE	SB_BOTTOM			7
#DEFINE	SB_RIGHT			7
#define COLOR_SCROLLBAR			0
#define COLOR_BACKGROUND		1
#define COLOR_ACTIVECAPTION		2
#define COLOR_INACTIVECAPTION		3
#define COLOR_MENU			4
#define COLOR_WINDOW			5
#define COLOR_WINDOWFRAME		6
#define COLOR_MENUTEXT			7
#define COLOR_WINDOWTEXT		8
#define COLOR_CAPTIONTEXT		9
#define COLOR_ACTIVEBORDER		10
#define COLOR_INACTIVEBORDER		11
#define COLOR_APPWORKSPACE		12
#define COLOR_HIGHLIGHT			13
#define COLOR_HIGHLIGHTTEXT		14
#define COLOR_BTNFACE			15
#define COLOR_BTNSHADOW			16
#define COLOR_GRAYTEXT			17
#define COLOR_BTNTEXT			18
#define COLOR_INACTIVECAPTIONTEXT	19
#define COLOR_BTNHIGHLIGHT		20
*-- #if(WINVER >= 0x0400)
#define COLOR_3DDKSHADOW        21
#define COLOR_3DLIGHT           22
#define COLOR_INFOTEXT          23
#define COLOR_INFOBK            24
*-- #endif /* WINVER >= 0x0400 */
*-- #if(WINVER >= 0x0500)
#define COLOR_HOTLIGHT                  26
#define COLOR_GRADIENTACTIVECAPTION     27
#define COLOR_GRADIENTINACTIVECAPTION   28
*-- #endif /* WINVER >= 0x0500 */
*-- #if(WINVER >= 0x0400)
#define COLOR_DESKTOP           COLOR_BACKGROUND
#define COLOR_3DFACE            COLOR_BTNFACE
#define COLOR_3DSHADOW          COLOR_BTNSHADOW
#define COLOR_3DHIGHLIGHT       COLOR_BTNHIGHLIGHT
#define COLOR_3DHILIGHT         COLOR_BTNHIGHLIGHT
#define COLOR_BTNHILIGHT        COLOR_BTNHIGHLIGHT
*-- #endif /* WINVER >= 0x0400 */
#ENDIF		&&	__VFP_SBCONTAINER_H_INCLUDED
endtext
set safe off
strtofile(m.my,"vfpsbcnt.h")

Publi yform
yform=Newobject("yimg")
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 added 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 original scrolling container class from  http://www.arg.kirov.ru/downloads/
its now working as converted prg file and can be work as standalone with any code.
I added a routine to mouseWheel on objects contained to scroll with mouse easily.

the scroll container class  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 wheelScrolllines to set the
number of lines with mouseWheel)-(dont work with arrows or PGup,PgDown).

 use:
-with a prg main file caller this class
-saved with as a prg class and called
                   -set proc to ....additive
	 -createObject...,newObject....	
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc

Procedure Destroy
Clea Events
Endproc

Enddefine
*
*-- EndDefine: yimg
************************************
*here the scrolling class as text
#INCLUDE "vfpsbcnt.h"
*
Define Class __cntsbbutton As Container
Width = 16
Height = 16
SpecialEffect = 0
BorderColor = Rgb(128,128,128)
Protected m_nbuttonsize
m_nbuttonsize = 16
Delay = 0.02
Name = "__cntsbbutton"
ldown = .F.
Protected ldragging

Add Object lbldirection As Label With ;
AutoSize = .T., ;
FontName = "Marlett", ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 14, ;
Left = 1, ;
Top = 1, ;
Width = 14, ;
Name = "lblDirection"


Procedure buttondown
If !This.ldown
	This.ldown = .T.
	This.SpecialEffect = 2		&& 1
	This.lbldirection.Move( This.lbldirection.Left + 1, This.lbldirection.Top + 1)
	This.Move( This.Left)
Endif
Endproc


Procedure buttonup
If This.ldown
	This.ldown = .F.
	This.SpecialEffect = 0		&& 1
	This.lbldirection.Move( This.lbldirection.Left - 1, This.lbldirection.Top - 1)
	This.Move( This.Left)
Endif
Endproc


Protected Procedure enabled_assign
Lparameters tlEnabled

This.Enabled = m.tlEnabled
This.lbldirection.Enabled = m.tlEnabled
Endproc


Procedure Resize
With This
	.lbldirection.Move( (.Width - .lbldirection.Width) / 2 + 1, (.Height - .lbldirection.Height) / 2 + 1)
Endwith
Endproc

Procedure Init
This.m_nbuttonsize = Sysmetric( 5)
Declare Integer GetSysColor In Win32API Integer
This.BorderColor = GetSysColor( COLOR_BTNSHADOW)
This.Resize()
DoDefault()
Endproc


Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	Local lnTop, lnLeft, lnSec, lnDelay, loCurObject
	lnTop = Objtoclient( This, 1)
	lnLeft = Objtoclient( This, 2)
	With This
		If .ldragging And Between( m.nXCoord, m.lnLeft, m.lnLeft + .Width) And ;
				Between( m.nYCoord, m.lnTop, m.lnTop + .Height)

			If !.ldown
				.buttondown
			Endif

			lnDelay = .Delay	&& / 3
			Do While .T.
				.Click
				lnSec = Seconds() + m.lnDelay
				*!*			If !This.Parent.Parent.ContinuousScroll
				*!*				Exit
				*!*			EndIf
				Do While Mdown() And m.lnSec > Seconds()
				Enddo
				loCurObject = Sys( 1270)
				If !Mdown() Or Vartype( m.loCurObject) # "O" Or ( m.loCurObject # .lbldirection And m.loCurObject # This)
					If ( Vartype( m.loCurObject) = "O" And m.loCurObject # .lbldirection And loCurObject # This)
						.buttonup()
					Endif
					Exit
				Endif
			Enddo
		Else
			If .ldown
				.buttonup()
			Endif
		Endif
	Endwith
Endif
Endproc

Procedure MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	This.ldragging = .F.
	This.buttonup()
	Nodefault
Endif
Endproc

Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	With This
		.ldragging = .T.
		.buttondown()

		.Click

		Local lnSec, lnDelay, loCurObject
		lnDelay = .Delay	&& / 3
		Do While Mdown()
			lnSec = Seconds() + m.lnDelay
			.Click
			*!*			If !This.Parent.Parent.ContinuousScroll
			*!*				Exit
			*!*			EndIf
			Do While Mdown() And m.lnSec > Seconds()
			Enddo
			loCurObject = Sys( 1270)
			If !Mdown() Or Vartype( m.loCurObject) # "O" Or ( m.loCurObject # .lbldirection And m.loCurObject # This)
				If ( Vartype( m.loCurObject) = "O" And m.loCurObject # .lbldirection And loCurObject # This)
					.buttonup()
				Endif
				Exit
			Endif
		Enddo
		*!*			DoDefault( nButton, nShift, nXCoord, nYCoord)
	Endwith
Endif
Endproc

Procedure lbldirection.MouseUp
Lparameters tnButton, tnShift, tnXCoord, tnYCoord
This.Parent.MouseUp( m.tnButton, m.tnShift, m.tnXCoord, m.tnYCoord)
Endproc


Procedure lbldirection.MouseMove
Lparameters tnButton, tnShift, tnXCoord, tnYCoord
This.Parent.MouseMove( m.tnButton, m.tnShift, m.tnXCoord, m.tnYCoord)
Endproc

Procedure lbldirection.MouseDown
Lparameters tnButton, tnShift, tnXCoord, tnYCoord
This.Parent.MouseDown( m.tnButton, m.tnShift, m.tnXCoord, m.tnYCoord)
Endproc

Enddefine
*
*-- EndDefine: __cntsbbutton
**************************************************

**************************************************
*-- Class:        __vscrollbar (e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\sbcont.vcx)
*-- ParentClass:  container
*-- BaseClass:    container
*-- Time Stamp:   01/26/05 04:23:09 PM
*
#INCLUDE "e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\vfpsbcnt.h"
*
Define Class __vscrollbar As Container
Width = 16
Height = 200
BorderWidth = 0
TabStop = .F.
BackColor = Rgb(226,226,226)
*-- Determines how far the scrolling region of the associated control can move.
Range = 1
*-- Specifies the increment a control scrolls when you click on a scroll arrow. Available at design time and run time.
smallchange = 1
*-- Specifies the position of the thumb tab on the scroll bar.
position = 0
kind = 1
Protected m_noffset
m_noffset = 0
controlarea = .Null.
Protected m_npage
m_npage = 0
Protected m_nmax
m_nmax = 0
Protected m_ncalcrange
m_ncalcrange = 0
Delay = 0.02
Protected m_nthumbarea
m_nthumbarea = 0
Protected m_nbuttonsize
m_nbuttonsize = 16
*-- Specifies the margin width created in the text portion of the control.
Margin = 0
thumbsize = 0
Name = "__vscrollbar"
Hidden m_bcalcautorange
Protected m_bthumbmove
Protected m_bthumbmoving

Add Object shpsplash As Shape With ;
Height = 0, ;
Width = 0, ;
Visible = .F., ;
BackColor = Rgb(0,0,0), ;
Name = "shpSplash"

Add Object scrollthumb As Container With ;
Width = 0, ;
Height = 0, ;
SpecialEffect = 0, ;
Name = "ScrollThumb"

Add Object cntup As __cntsbbutton With ;
Width = 0, ;
Height = 0, ;
Name = "cntUp", ;
lbldirection.Caption = "5", ;
lbldirection.Name = "lblDirection"

Add Object cntdown As __cntsbbutton With ;
Width = 0, ;
Height = 0, ;
Name = "cntDown", ;
lbldirection.Caption = "6", ;
lbldirection.Name = "lblDirection"

Procedure scrollmessage
Lparameters tnMessage, tnPos

Local lnKind, lnOldPos, lnScrollDir
With This
	lnScrollDir = -1
	lnKind = .kind
	lnOldPos = .position
	Do Case
		Case m.tnMessage = SB_LINEUP
			lnScrollDir = Iif( m.lnKind = 1, 0, 4)
			.position = ( .position - .smallchange)
		Case m.tnMessage = SB_LINEDOWN
			lnScrollDir = Iif( m.lnKind = 1, 1, 5)
			.position = ( .position + .smallchange)
		Case m.tnMessage = SB_PAGEUP
			lnScrollDir = Iif( m.lnKind = 1, 2, 6)
			.position = ( .position - Int( .ControlSize() / .smallchange) * .smallchange)
		Case m.tnMessage = SB_PAGEDOWN
			lnScrollDir = Iif( m.lnKind = 1, 3, 7)
			.position = ( .position + Int( .ControlSize() / .smallchange) * .smallchange)
		Case m.tnMessage = SB_THUMBPOSITION
			.position = ( m.tnPos)
			lnScrollDir = Iif( m.lnKind = 1, ;
				IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 0, 1), ;
				IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 4, 5))
		Case m.tnMessage = SB_THUMBTRACK
			If .Parent.ContinuousScroll
				.position = ( m.tnPos)
				lnScrollDir = Iif( m.lnKind = 1, ;
					IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 0, 1), ;
					IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 4, 5))
			Endif
	Endcase
	*!*		If m.lnOldPos != .Position
	.Parent.Scrolled( m.lnScrollDir)
	*!*		EndIf
Endwith
Endproc

Procedure Update
With This
	Local lnControlSize
	lnControlSize = .ControlSize()
	.m_ncalcrange = Max( 0, .Range - m.lnControlSize)
	.m_npage = m.lnControlSize + 1
	.m_nmax = Iif( .m_ncalcrange > 0, .Range, 0)

	.SetScrollInfo()
	.position = .position
Endwith
Endproc

Procedure calcAutoRange
With This
	If !.m_bcalcautorange And !Isnull( .controlarea)
		.m_bcalcautorange = .T.
		Local lnNewRange, loControl, lnMargin
		lnMargin = Val( "0" + Trans( .Margin))
		lnNewRange = 0
		For Each loControl In .controlarea.Controls
			If m.loControl.Visible
				lnNewRange = Max( m.lnNewRange, ;
					IIF( .kind = 1, ;
					m.loControl.Top + m.loControl.Height, ;
					m.loControl.Left + m.loControl.Width))
			Endif
		Endfor
		.Range = ( m.lnNewRange + m.lnMargin)
		.m_bcalcautorange = .F.
	Endif
Endwith
Endproc

Protected Procedure SetScrollInfo
With This
	If .m_nmax > 0
		Local lnControlSize, lnThumbArea, lnThumbSize
		lnControlSize = .ControlSize()

		If .kind = 1	&& Vertical
			lnThumbArea = .Height - .m_nbuttonsize * 2
			lnThumbSize = Max( 8, ;
				Min( m.lnThumbArea, ;
				( m.lnThumbArea) * m.lnControlSize / .m_nmax))
			.scrollthumb.Height = m.lnThumbSize
			.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
		Else
			lnThumbArea = .Width - .m_nbuttonsize * 2
			lnThumbSize = Max( 8, Min( m.lnThumbArea, ( m.lnThumbArea) * m.lnControlSize / .m_nmax))
			.scrollthumb.Width = m.lnThumbSize
			.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
		Endif

		If m.lnThumbArea >= 8
			.scrollthumb.Visible = .T.
		Else
			.scrollthumb.Visible = .F.
		Endif

		.cntup.Enabled = .T.
		.cntdown.Enabled = .T.

		.Enabled = .T.
	Else
		If .kind = 1	&& Vertical
			.scrollthumb.Height = 0
			.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
		Else
			.scrollthumb.Width = 0
			.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
		Endif

		.scrollthumb.Visible = .F.

		.cntup.Enabled = .F.
		.cntdown.Enabled = .F.

		.Enabled = .F.
	Endif
Endwith
Endproc

Protected Procedure ControlSize
*--	Return IIF( This.Kind = 0, This.Parent.Width, This.Parent.Height)
Return Iif( This.kind = 0, This.Width, This.Height)
*!*	Return IIF( Type( "This.ControlArea") = "O" And !IsNull( This.ControlArea), ;
*!*				IIF( This.Kind = 0, This.ControlArea.Width, This.ControlArea.Height), ;
*!*				0)
Endproc

Hidden Procedure position_assign
Lparameters tnNewPosition

With This
	tnNewPosition = Max( 0, Min( .m_ncalcrange, Int( m.tnNewPosition)))

	Local lnOldPos, lnNewThumbPos
	lnOldPos = .position
	.position = m.tnNewPosition

	lnNewThumbPos = Min( .m_nthumbarea, Max( 0, Iif( .m_ncalcrange = 0, 0, (.position / .m_ncalcrange) * .m_nthumbarea))) + .m_nbuttonsize

	If .kind = 1	&& Vertical
		.scrollthumb.Top = m.lnNewThumbPos
		.Parent.ScrollBy( 0, m.lnOldPos - m.tnNewPosition)
	Else
		.scrollthumb.Left = m.lnNewThumbPos
		.Parent.ScrollBy( m.lnOldPos - m.tnNewPosition, 0)
	Endif
Endwith
Endproc

Hidden Procedure range_assign
Lparameters tnNewRange
With This
	.Range = Max( 0, m.tnNewRange)
	If !Isnull( .controlarea) And .Range != 0
		If .kind = 1 &&Vertical
			.controlarea.Height = .Range
		Else
			.controlarea.Width = .Range
		Endif
	Endif
	.Parent.UpdateScrollBars()
Endwith
Endproc

Hidden Procedure thumbsize_access
Return Iif( This.kind = 0, This.scrollthumb.Width, This.scrollthumb.Height)
Endproc

Hidden Procedure thumbsize_assign
Lparameters vNewVal

Error 1740, "ThumbSize"
Endproc

Procedure needsscrollbarvisible
Lparameters tnSize
If Pcount() = 0 Or Type( "m.tnSize") != "N"
	Return This.Range > This.ControlSize()
Endif
Return This.Range > m.tnSize
Endproc

Procedure thumb_mousedown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
	With This
		.m_noffset = Iif( .kind = 1, m.nYCoord - .scrollthumb.Top, m.nXCoord - .scrollthumb.Left) + .m_nbuttonsize
		.m_bthumbmove = .T.
	Endwith
Endif
Endproc

Procedure thumb_mousemove
Lparameters nButton, nShift, nXCoord, nYCoord

If Bitand( m.nButton, 1) = 1 And This.m_bthumbmove And !This.m_bthumbmoving
	With This
		.m_bthumbmoving = .T.
		Local lnNewPos
		If .kind = 1	&& Vertical
			lnNewPos = Max( 0, Min( m.nYCoord - .m_noffset, .m_nthumbarea))
		Else
			lnNewPos = Max( 0, Min( m.nXCoord - .m_noffset, .m_nthumbarea))
		Endif
		.scrollmessage( SB_THUMBTRACK, ( m.lnNewPos / .m_nthumbarea) * .m_ncalcrange)
		.m_bthumbmoving = .F.
	Endwith
Endif
Endproc

Procedure thumb_mouseup
Lparameters nButton, nShift, nXCoord, nYCoord

If m.nButton = 1
	With This
		.m_bthumbmove = .F.
		Local lnNewPos, lnNewPos
		If .kind = 1	&& Vertical
			lnNewPos = Max( 0, Min( m.nYCoord - .m_noffset, .m_nthumbarea))
		Else
			lnNewPos = Max( 0, Min( m.nXCoord - .m_noffset, .m_nthumbarea))
		Endif
		.scrollmessage( SB_THUMBPOSITION, ( m.lnNewPos / .m_nthumbarea) * .m_ncalcrange)
	Endwith
Endif
Endproc

Procedure Destroy
This.controlarea = .Null.
DoDefault()
Endproc

Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord

Local loCurObject, lnSec, lnDelay
With This
	lnDelay = This.Delay
	nYCoord = m.nYCoord - Objtoclient( This, 1)
	nXCoord = m.nXCoord - Objtoclient( This, 2)
	If .Enabled And m.nButton = 1 And .scrollthumb.Visible
		If ( .kind = 1 And m.nYCoord < .scrollthumb.Top) Or ( .kind = 0 And m.nXCoord < .scrollthumb.Left)
			Nodefault
			Do While .T.
				lnSec = Seconds() + lnDelay
				If .kind = 1	&& Vertical
					.shpsplash.Move( 0, 0, .m_nbuttonsize, .scrollthumb.Top)
				Else
					.shpsplash.Move( 0, 0, .scrollthumb.Left, .m_nbuttonsize)
				Endif
				.shpsplash.Visible = .T.
				.scrollmessage( SB_PAGEUP)

				Do While Mdown() And m.lnSec > Seconds()
				Enddo

				loCurObject = Sys( 1270)
				If !Mdown() Or Type( "m.loCurObject") # "O" Or m.loCurObject # .shpsplash
					Exit
				Endif
			Enddo
			.shpsplash.Visible = .F.
		Else
			If ( .kind = 1 And m.nYCoord > .scrollthumb.Top + .scrollthumb.Height) Or ( .kind = 0 And m.nXCoord > .scrollthumb.Left + .scrollthumb.Width)
				Nodefault
				Do While .T.
					lnSec = Seconds() + m.lnDelay
					If .kind = 1	&& Vertical
						.shpsplash.Move( 0, .scrollthumb.Top + .scrollthumb.Height, .m_nbuttonsize, .Height - (.scrollthumb.Top + .scrollthumb.Height) - .m_nbuttonsize)
					Else
						.shpsplash.Move( .scrollthumb.Left + .scrollthumb.Width, 0, .Width - (.scrollthumb.Left + .scrollthumb.Width) - .m_nbuttonsize, .m_nbuttonsize)
					Endif
					.shpsplash.Visible = .T.
					.scrollmessage( SB_PAGEDOWN)

					Do While Mdown() And m.lnSec > Seconds()
					Enddo

					loCurObject = Sys( 1270)
					If !Mdown() Or Type( "m.loCurObject") # "O" Or m.loCurObject # .shpsplash
						Exit
					Endif
				Enddo
				.shpsplash.Visible = .F.
			Endif
		Endif
	Endif
Endwith
Endproc

Procedure Resize
Local lnSize
With This

	If .kind = 1	&& Vertical
		lnSize = .Height
		If m.lnSize <= .m_nbuttonsize * 2
			lnSize = Int( m.lnSize / 2)
			.cntdown.Move( 0, .Height - m.lnSize, .m_nbuttonsize, m.lnSize)
			.cntup.Height = m.lnSize
		Else
			.cntdown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
			.cntup.Height = .m_nbuttonsize
		Endif
	Else
		lnSize = .Width
		If m.lnSize <= .m_nbuttonsize * 2
			lnSize = Int( m.lnSize / 2)
			.cntdown.Move( .Width - m.lnSize, 0, m.lnSize, .m_nbuttonsize)
			.cntup.Width = m.lnSize
		Else
			.cntdown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
			.cntup.Width = .m_nbuttonsize
		Endif
	Endif
	.Update()
	*--	.Range = .Range
Endwith
Endproc

Procedure Init
Lparameters toArea
Declare Integer GetSysColor In Win32API Integer
With This
	.m_nbuttonsize = Sysmetric( 5)
	Local lnColor1, lnColor2, lnRed1, lnGreen1, lnBlue1, lnRed2, lnGreen2, lnBlue2

	lnColor1 = GetSysColor( COLOR_BTNHIGHLIGHT)
	lnColor2 = GetSysColor( COLOR_BTNFACE)

	lnRed1 =	Bitand( m.lnColor1, 0x000000FF)
	lnGreen1 =	Bitand( m.lnColor1, 0x0000FF00) / 256
	lnBlue1 =	Bitand( m.lnColor1, 0x00FF0000) / 65536

	lnRed2 =	Bitand( m.lnColor2, 0x000000FF)
	lnGreen2 =	Bitand( m.lnColor2, 0x0000FF00) / 256
	lnBlue2 =	Bitand( m.lnColor2, 0x00FF0000) / 65536

	lnRed1 = 	Bitand( m.lnRed2 + Int( ( m.lnRed1 - m.lnRed2) / 2), 0xFF)
	lnGreen1 = 	Bitand( m.lnGreen2 + Int( ( m.lnGreen1 - m.lnGreen2) / 2), 0xFF)
	lnBlue1 = 	Bitand( m.lnBlue2 + Int( ( m.lnBlue1 - m.lnBlue2) / 2), 0xFF)

	.BackColor = Rgb( m.lnRed1, m.lnGreen1, m.lnBlue1)

	.m_nmax = 1
	.m_npage = 1
	If Pcount() > 0 And Vartype( m.toArea) = "O"
		.controlarea = m.toArea
	Else
		.controlarea = .Null.
	Endif
	.cntup.Move( 0, 0, .m_nbuttonsize, .m_nbuttonsize)
	If .kind = 1	&& Vertical
		.cntdown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
		.scrollthumb.Move( 0, .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
		.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
	Else
		.cntdown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
		.scrollthumb.Move( .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
		.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
	Endif
	*--	.Range = 0
Endwith
Endproc

Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Procedure scrollthumb.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.thumb_mousemove( nButton, nShift, nXCoord, nYCoord)
Endproc

Procedure scrollthumb.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.thumb_mousedown( nButton, nShift, nXCoord, nYCoord)
Endproc

Procedure scrollthumb.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.thumb_mousemove( nButton, nShift, nXCoord, nYCoord)
Endproc

Procedure scrollthumb.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Procedure cntup.Click
This.Parent.scrollmessage( SB_LINEUP)
Endproc

Procedure cntup.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Procedure cntdown.Click
This.Parent.scrollmessage( SB_LINEDOWN)
Endproc

Procedure cntdown.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Enddefine
*
*-- EndDefine: __vscrollbar
**************************************************


**************************************************
*-- Class:        __hscrollbar (e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\sbcont.vcx)
*-- ParentClass:  __vscrollbar (e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\sbcont.vcx)
*-- BaseClass:    container
*-- Time Stamp:   01/26/05 04:11:05 PM
*
#INCLUDE "e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\vfpsbcnt.h"
*
Define Class __hscrollbar As __vscrollbar
Width = 252
Height = 16
kind = 0
Name = "__hscrollbar"
shpsplash.Name = "shpSplash"
scrollthumb.Name = "ScrollThumb"
cntup.lbldirection.Caption = "3"
cntup.lbldirection.Name = "lblDirection"
cntup.Name = "cntUp"
cntdown.lbldirection.Caption = "4"
cntdown.lbldirection.Name = "lblDirection"
cntdown.Name = "cntDown"
Enddefine
*
*-- EndDefine: __hscrollbar
**************************************************


**************************************************
*-- Class:        _scrollcontainer (e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\sbcont.vcx)
*-- ParentClass:  container
*-- BaseClass:    container
*-- Time Stamp:   02/18/05 06:26:08 PM
*-- ScrollContainer class for Microsoft Visual FoxPro
*
#INCLUDE "e:\_______________________yoverlblog_posts\yposted\yvfpscrollbars_yimg\scrollcontainer_arg\vfpsbcnt.h"
*
Define Class _scrollcontainer As Container
Width = 447
Height = 329
SpecialEffect = 1
*-- Specifies if control scrolling is continuous or the control is only redrawn when the scroll box is released.
ContinuousScroll = .T.
*-- Specifies the type of scroll bars control has. 0 - none, 1 - horizontal, 2 - vertical, 3 - both.
ScrollBars = 3
*-- Specifies the horizontal scrolling increment for a control's horizontal scroll bar.
HscrollSmallChange = 8
*-- Specifies the vertical scrolling increment for a controls vertical scroll bar.
VscrollSmallChange = 8
*-- Specifies the margin between the client area and the inside edges of the scrolling container.
Margin = 0
*-- Contains reference to the ClientArea container.
clientarea = .Null.
*-- The number of lines to scroll when the mouse wheel is rotated. If this number is less than 0 control will use system default value (3 lines). If this number is equal to 0 control will not support mouse wheel.
wheelScrollLines = -1
Name = "_scrollcontainer"
Protected m_bscrollby
Protected m_bupdatingscrollbars
Protected m_bcalcautorange

*-- Indicates whether scroll bars appear automatically on the scrolling windowed control if it is not large enough to display all of its controls.
autoScroll = .F.

Add Object viewframe As Container With ;
Width = 1024, ;
Height = 1024, ;
Name = "ViewFrame"


Add Object hscrollbar As __hscrollbar With ;
Top = -20, ;
Name = "HScrollBar", ;
shpsplash.Name = "shpSplash", ;
scrollthumb.Name = "ScrollThumb", ;
cntup.lbldirection.Name = "lblDirection", ;
cntup.Name = "cntUp", ;
cntdown.lbldirection.Name = "lblDirection", ;
cntdown.Name = "cntDown"

Add Object vscrollbar As __vscrollbar With ;
Left = -20, ;
Name = "VScrollBar", ;
shpsplash.Name = "shpSplash", ;
scrollthumb.Name = "ScrollThumb", ;
cntup.lbldirection.Name = "lblDirection", ;
cntup.Name = "cntUp", ;
cntdown.lbldirection.Name = "lblDirection", ;
cntdown.Name = "cntDown"

*-- Scrolls the contents of the scrolling container.
Procedure ScrollBy
Lparameters tnDeltaX, tnDeltaY
With This
	If !.m_bscrollby
		.m_bscrollby = .T.
		.viewframe.clientarea.Move( .viewframe.clientarea.Left + m.tnDeltaX, .viewframe.clientarea.Top + m.tnDeltaY)
		.m_bscrollby = .F.
	Endif
Endwith
Endproc

*-- Updates scroll bars.
Procedure UpdateScrollBars
With This
	If !.m_bupdatingscrollbars
		.m_bupdatingscrollbars = .T.
		If Bitand( .ScrollBars, SBC_VERT) != 0
			.vscrollbar.Visible = .T.
			.vscrollbar.Update()
		Else
			.vscrollbar.Visible = .F.
		Endif
		If Bitand( .ScrollBars, SBC_HORS) != 0
			.hscrollbar.Visible = .T.
			.hscrollbar.Update()
		Else
			.hscrollbar.Visible = .F.
			*!*				If Bitand( .ScrollBars, SBC_VERT) != 0
			*!*					.VScrollBar.Visible = .T.
			*!*				EndIf
		Endif
		.m_bupdatingscrollbars = .F.
	Endif
Endwith
Endproc

*-- Scrolls a control into the visible area of the scrolling windowed control.
Procedure ensureisvisible
Lparameters toControl

If Type( [m.toControl]) = "O" And !Isnull( m.toControl)

	With This
		Local lnLeft, lnTop, lnRight, lnBottom, lnHSPos, lnVSPos, lnVPWidth, lnVPHeight

		lnHSPos = .hscrollbar.position
		lnVSPos = .vscrollbar.position
		lnVPWidth = .viewframe.Width
		lnVPHeight = .viewframe.Height

		lnLeft = m.toControl.Left - m.lnHSPos
		lnTop = m.toControl.Top - m.lnVSPos
		lnRight = m.lnLeft + m.toControl.Width
		lnBottom = m.lnTop + m.toControl.Height

		If Bitand( .ScrollBars, SBC_HORS) != 0 And .hscrollbar.Enabled
			If m.lnLeft < 0
				.hscrollbar.position = ( m.lnHSPos + m.lnLeft)
			Else
				If m.lnRight > m.lnVPWidth
					If m.lnRight - m.lnLeft > m.lnVPWidth
						m.lnRight = m.lnLeft + m.lnVPWidth
					Endif
					.hscrollbar.position = ( m.lnHSPos + m.lnRight - m.lnVPWidth)
				Endif
			Endif
		Endif
		If Bitand( .ScrollBars, SBC_VERT) != 0 And .vscrollbar.Enabled
			If m.lnTop < 0
				.vscrollbar.position = ( m.lnVSPos + m.lnTop)
			Else
				If m.lnBottom > m.lnVPHeight
					If m.lnBottom - m.lnTop > m.lnVPHeight
						m.lnBottom = m.lnTop + m.lnVPHeight
					Endif
					.vscrollbar.position = ( m.lnVSPos + m.lnBottom - m.lnVPHeight)
				Endif
			Endif
		Endif
	Endwith
Endif
Endproc

*-- Calculates the size of the client area depending on the size and position of controls and updates scroll bars.
Procedure calcAutoRange
With This
	If !.m_bcalcautorange

		Local lOldAutoYield
		lOldAutoYield = _vfp.AutoYield
		_vfp.AutoYield = .F.

		.m_bcalcautorange = .T.
		.hscrollbar.calcAutoRange()
		.vscrollbar.calcAutoRange()
		.m_bcalcautorange = .F.

		_vfp.AutoYield = m.lOldAutoYield
	Endif
Endwith
Endproc

Hidden Procedure autoscroll_assign
Lparameters tbNewVal
With This
	If .autoScroll != m.tbNewVal
		.autoScroll = m.tbNewVal
		If m.tbNewVal
			.calcAutoRange
		Else
			.hscrollbar.Range = 0
			.vscrollbar.Range = 0
		Endif
	Endif
Endwith
Endproc

*-- Occurs when the horizontal or vertical scroll bars are clicked or dragged
Procedure Scrolled
Lparameters tnDirection
Endproc

Hidden Procedure scrollbars_assign
Lparameters tnNewVal
This.ScrollBars = m.tnNewVal
This.Resize
Endproc

Protected Procedure clientarea_access
Return This.viewframe.clientarea
Endproc

Procedure MouseWheel
Lparameters tnDirection, tnShift, tnXCoord, tnYCoord

#Define WHEEL_DELTA		120

With This
	If .wheelScrollLines > 0
		If Bitand( .ScrollBars, SBC_VERT) != 0 And .vscrollbar.Enabled
			.vscrollbar.position = .vscrollbar.position - ;
				(.VscrollSmallChange * .wheelScrollLines * Round( m.tnDirection / WHEEL_DELTA, 0))
		Else
			If Bitand( .ScrollBars, SBC_HORS) != 0 And .hscrollbar.Enabled
				.hscrollbar.position = .hscrollbar.position - ;
					(.HscrollSmallChange * .wheelScrollLines * Round( m.tnDirection / WHEEL_DELTA, 0))
			Endif
		Endif
	Endif
Endwith
Endproc

Procedure Destroy
If Val( _vfp.Version) < 6
	This.clientarea = .Null.
Endif
DoDefault()
Endproc

Procedure Init
DoDefault()
This.viewframe.AddObject("clientarea","clientarea")
#Define SM_MOUSEWHEELPRESENT		75
#Define SPI_GETWHEELSCROLLLINES		0x0068

Local lOldAutoYield
lOldAutoYield = _vfp.AutoYield
_vfp.AutoYield = .F.

With This
	Declare Integer GetSystemMetrics In Win32API Integer
	If GetSystemMetrics( SM_MOUSEWHEELPRESENT) != 1
		&& Mouse with a wheel isn't installed
		.wheelScrollLines = 0
	Else
		If Type( ".WheelScrollLines") != "N" Or .wheelScrollLines < 0
			&& retrieve number of scroll lines

			Declare Integer SystemParametersInfo In Win32API Integer, Integer, Integer @, Integer

			Local lnScrollLines
			lnScrollLines = 3		&& default value

			If SystemParametersInfo( SPI_GETWHEELSCROLLLINES, 0, @m.lnScrollLines, 0) != 1
				.wheelScrollLines = 3
			Else
				.wheelScrollLines = m.lnScrollLines
			Endif
			*!*				Clear Dlls SystemParametersInfo
		Else
			.wheelScrollLines = Int( .wheelScrollLines)
		Endif
	Endif
	*!*		Clear Dlls GetSystemMetrics


	If Val( _vfp.Version) < 6
		.clientarea = .viewframe.clientarea
	Endif

	.viewframe.BorderWidth = 0
	.viewframe.clientarea.BorderWidth = 0
	.hscrollbar.smallchange = Val( "0" + Trans( .HscrollSmallChange))
	.vscrollbar.smallchange = Val( "0" + Trans( .VscrollSmallChange))
	.hscrollbar.Margin = Val( "0" + Trans( .Margin))
	.vscrollbar.Margin = Val( "0" + Trans( .Margin))
	.hscrollbar.controlarea = .clientarea
	.vscrollbar.controlarea = .clientarea
	.calcAutoRange()
	*!*		.Resize()
Endwith

_vfp.AutoYield = m.lOldAutoYield
Endproc

Procedure Resize
Local lOldAutoYield
lOldAutoYield = _vfp.AutoYield
_vfp.AutoYield = .F.

Local lnMargin, lnVPWidth, lnVPHeight, lOldLockScreen, lnHSBH, lnVSBW
lOldLockScreen = Thisform.LockScreen
Thisform.LockScreen = .T.
With This

	lnMargin = .BorderWidth

	If This.SpecialEffect != 2
		lnMargin = m.lnMargin + 1
	Endif

	lnHSBH = Sysmetric( 8)
	lnVSBW = Sysmetric( 5)

	lnVPWidth = Max( 0, .Width - ( m.lnVSBW + m.lnMargin * 2))
	lnVPHeight = Max( 0, .Height - ( m.lnHSBH + m.lnMargin * 2))

	If Bitand( .ScrollBars, SBC_VERT) = 0
		lnVPWidth = m.lnVPWidth + m.lnVSBW
	Endif

	If Bitand( .ScrollBars, SBC_HORS) = 0
		lnVPHeight = m.lnVPHeight + m.lnHSBH
	Endif

	*!*		If Bitand( .ScrollBars, SBC_VERT) != 0 And .VScrollBar.Enabled And .VScrollBar.NeedsScrollBarVisible( m.lnVPHeight)
	If Bitand( .ScrollBars, SBC_VERT) != 0 And .vscrollbar.needsscrollbarvisible( m.lnVPHeight)
		.vscrollbar.Visible = .T.
		.vscrollbar.Enabled = .T.
	Else
		.vscrollbar.Visible = .F.
		.vscrollbar.Enabled = .F.
		If Bitand( .ScrollBars, SBC_VERT) != 0
			lnVPWidth = m.lnVPWidth + m.lnVSBW
		Endif
	Endif

	*!*		If Bitand( .ScrollBars, SBC_HORS) != 0 And .HScrollBar.Enabled And .HScrollBar.NeedsScrollBarVisible( m.lnVPWidth)
	If Bitand( .ScrollBars, SBC_HORS) != 0 And .hscrollbar.needsscrollbarvisible( m.lnVPWidth)
		.hscrollbar.Visible = .T.
		.hscrollbar.Enabled = .T.
	Else
		.hscrollbar.Visible = .F.
		.hscrollbar.Enabled = .F.
		If Bitand( .ScrollBars, SBC_HORS) != 0
			lnVPHeight = m.lnVPHeight + m.lnHSBH
		Endif
	Endif

	.viewframe.Move( m.lnMargin, m.lnMargin, m.lnVPWidth, m.lnVPHeight)

	.hscrollbar.Move( m.lnMargin, lnVPHeight + m.lnMargin, m.lnVPWidth, m.lnHSBH)
	.vscrollbar.Move( m.lnVPWidth + m.lnMargin, m.lnMargin, m.lnVSBW, m.lnVPHeight)
Endwith
Thisform.LockScreen = m.lOldLockScreen
_vfp.AutoYield = m.lOldAutoYield
Endproc
*-- Sets the scrolling range of specified scroll bar.
Procedure setscrollrange
Endproc

Procedure viewframe.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Enddefine
*
*-- EndDefine: _scrollcontainer
**************************************
Define Class clientarea As Container
Top = 0
Left = 0
Width = 1024
Height = 1024
BackStyle = 0
Visible=.T.
Name = "ClientArea"

Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.Parent.MouseWheel( nDirection, nShift, nXCoord, nYCoord)
Endproc

Enddefine
*-- EndDefine: clientarea

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


*3* API scrolls
*using the vfp form as scrollable container (scrollbars=2 or 3), here to scroll a big shape object (or an image....or more objects)
*scroll programmatly (using API )the form by the 4 keyboard arrows(up/down,left/right)
*this method can scroll any object having a handle (hwnd) as form,RTFbox,....



Declare Integer SendMessage In user32;
    INTEGER HWnd,;
    INTEGER Msg,;
    INTEGER wParam,;
    INTEGER Lparam
#Define WM_VSCROLL  0x0115
#Define WM_HSCROLL  0x0114
#Define  SB_LINEDOWN 1
#Define  SB_LINEUP  0

Public oform
oform=Newobject("ScrollForm")
oform.Show

Define Class ScrollForm As Form
    Top = 0
    Left = 0
    Height = 600
    Width = 800
    ShowWindow=2
    AutoCenter=.T.
    ScrollBars = 3  &&horz and vert scroll
    KeyPreview=.T.
    Caption = "Use 4 arrosws (up, down and left right) to Scroll a client area"
    VscrollSmallChange=10
    Name = "Form1"

    &&a very big shape or image here (here a shape)
    Add Object shape1 As Shape With ;
        Top = 12, ;
        Left = 12, ;
        Height = 4121, ;
        Width = 4553, ;
        backcolor=Rgb(0,255,0), ;
        Name = "shape1"

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        *Object.SetViewPort(nLeft, nTop)

        If nKeyCode=24  And Thisform.ScrollBars>=2 &&down arrow
            For i=1 To 10
                =SendMessage(Thisform.HWnd, WM_VSCROLL, SB_LINEDOWN , 0)
            Endfor

        Endif
        If nKeyCode=5  And Thisform.ScrollBars>=2 &&up arrow
            For i=1 To 10
                =SendMessage(Thisform.HWnd, WM_VSCROLL, SB_LINEUP, 0)
            Endfor

        Endif



        If nKeyCode=19  And Thisform.ScrollBars>=2  &&left arrow
            For i=1 To 10
                =SendMessage(Thisform.HWnd, WM_HSCROLL,SB_LINEUP  , 0)
            Endfor

        Endif
        If nKeyCode=4 And Thisform.ScrollBars>=2  &&right arrow
            For i=1 To 10
                =SendMessage(Thisform.HWnd, WM_HSCROLL, SB_LINEDOWN, 0)
            Endfor
        Endif

    Endproc

Enddefine

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


*4*
*using the vfp form as scrollable container (scrollbars=2 or 3), here to scroll a big shape object (or an image....or more objects) using setViewPort form method.
*scroll programmatly the form by the 4 keyboard arrows(up/down,left/right)

Public oform
oform=Newobject("oForm")
oform.Show

Define Class oForm As Form
    Top = 0
    Left = 0
    Height = 600
    Width = 800
    ShowWindow=2
    AutoCenter=.T.
    ScrollBars = 3  &&horz and vert scroll
    KeyPreview=.T.
    Caption = "Use 4 arrows (up, down and left right) to Scroll a client area"
    vertscrollpos = 0
    horzscrollpos = 0
    VscrollSmallChange=10
    Name = "Form1"

    &&a very big shape or image here (here a shape)
    Add Object shape1 As Shape With ;
        Top = 12, ;
        Left = 12, ;
        Height = 4121, ;
        Width = 4553, ;
        backcolor=Rgb(0,255,0), ;
        Name = "shape1"

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        *Object.SetViewPort(nLeft, nTop)

        If nKeyCode=24  And Thisform.ScrollBars>=2 &&down arrow
            With  Thisform
                .vertscrollpos=.vertscrollpos+.Height
                .SetViewPort(0,.vertscrollpos)
                .Refresh
            Endwith
        Endi

        If nKeyCode=5  And Thisform.ScrollBars>=2 &&up arrow
            With Thisform
                .vertscrollpos=.vertscrollpos-.Height
                .SetViewPort(0,.vertscrollpos)
                .Refresh
            Endwith
        Endif
        If nKeyCode=19  And Thisform.ScrollBars>=2  &&left arrow
            With Thisform
                .horzscrollpos=.horzscrollpos-.Width
                .SetViewPort(.horzscrollpos,0)
                .Refresh
            Endwith
        Endi

        If nKeyCode=4 And Thisform.ScrollBars>=2  &&right arrow
            With  Thisform
                .horzscrollpos=.horzscrollpos+.Width
                .SetViewPort(.horzscrollpos,0)
                .Refresh
            Endwith
        Endif
    Endproc
Enddefine

Testing VFP scrollbar container classes . - Visual Foxpro codes

http://yousfi.over-blog.com/2015/12/testing-a-vfp-scrollbar-container-class-application.html

Published on Visual foxpro, vfpscrollbar, container scroll, Browser class, BrowserX class, form scroll, viewport, sendMessage

To be informed of the latest articles, subscribe:
You might also like:
My last post with Visual Foxpro
My last post with Visual Foxpro
Working with IE11 fullscreen apps from vfp
Working with IE11 fullscreen apps from vfp
Grid cosmetics part 3
Grid cosmetics part 3
Working with "EveryThing" filer instant search.
Working with "EveryThing" filer instant search.
Retrieve all my VFP posts on my Blog
Internet Explorer used as rich editor
Comment on this post