Scrolling containers with pure and simple vfp solutions

Published on November 25 2017 by Yousfi Benameur


scroll container dont implemented at all in vfp litterature.
in my knowledge vfp IDE have not a scrollbar class!
i presented in previous post 3 some big methods to scroll any vfp container embedding  objects.
the codes below implement 2 simple solutions to do that job.
Infortunatly vfp controls (as container) have not handle and that why cannot use APIs to scrollH/V or mouseWheel.
but vfp have  always many solutions to any problem.
*the code *7* is suffisent for me to scroll any container (only with mouseWheel event) (if mouse built with wheel !).

[post 245]

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


*1* created on 24 of november 2017
*this code can scroll any vfp container with a simple (spinner+textbox) vertically or/and horizontally
*can fill the container with objects as wanted
*2 classes yscrollV and yscrollH make the job with increment typed in textbox class (can be small or big)
*adjust the spinnerhightvalue function of  scroll aera.
*it's a bit of a craft solution.
*cannot use APIs to scroll a vfp container because vfp objects have not handles (only form have it).


Publi yform
yform=Newobject("yscrolls")
yform.Show
Read Events
Retu
*
Define Class yscrolls As Form
	Top = 0
	Left = 0
	Height = 495
	Width = 678
	ShowWindow = 2
	ShowTips = .T.
	Caption = "Form1"
	Name = "form1"

	Add Object container1 As ycnt With ;
		Top = 24, ;
		Left = 36, ;
		Width = 589, ;
		Height = 409, ;
		BorderWidth = 2, ;
		BackColor = Rgb(213,255,255), ;
		Name = "Container1"

	Add Object yscrollV As yscrollV With ;
		name="yscrollV"

	Add Object yscrollH As yscrollH With ;
		name="yscrollH"

	Add Object check1 As Checkbox With ;
		autosize=.T. ,;
		style=1,;
		caption="MouseWheel ScrollV",;
		backcolor=Rgb(0,255,0),;
		fontbold=.T.,;
		value=1,;
		visible=.T.,;
		name="check1"

	Procedure Destroy
		Clea Events
	Endproc

	Procedure Init
		With This.check1
			.Left=(Thisform.container1.Width-.Width)/2
			.Top=Thisform.container1.Top+Thisform.container1.Height+20
		Endwith

	Procedure check1.InteractiveChange
		This.Caption=Iif(This.Value=1,"MouseWheel ScrollV","MouseWheel ScrollH")
	Endproc

Enddefine
*
*-- EndDefine: yscrolls

Define Class ycnt As Container
	Top = 24
	Left = 36
	Width = 589
	Height = 409
	BorderWidth = 2
	BackColor = Rgb(213,255,255)
	Name = "Container1"

	Add Object image1 As Image With ;
		Picture = home(1)+"SAMPLES\TASTRADE\BITMAPS\TTRADESM.BMP", ;
		Height = 900, ;
		Left = 7, ;
		Top = 6, ;
		Width = 900*9/16, ;
    backstyle=0,;
		stretch=2,;
		Name = "Image1"

	Add Object edit1 As EditBox With ;
		Height = 289, ;
		Left = 611, ;
		Top = 12, ;
		Width = 373, ;
		Name = "Edit1"

	Add Object grid1 As Grid With ;
		Height = 193, ;
		Left = 72, ;
		Top = 419, ;
		Width = 445, ;
		Name = "Grid1"

	Procedure edit1.Init
		With This
			TEXT to .value pretext 7 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
		pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
		lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
		sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
		sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
		velit vel ex aliquam, eget convallis ante mollis.
			ENDTEXT

			.Top=10
			.Left=.Parent.image1.Left+.Parent.image1.Width+20
			.BackStyle=0
			.BorderStyle=0
			.ForeColor=Rgb(128,0,64)
			.ScrollBars=0
			.FontBold=.T.
		Endwith
	Endproc

	Procedure grid1.Init
		Sele * From Home(1)+"samples\data\customer" Into Cursor ygridCurs
		With This
			.RecordSource=""
			.RecordSource="ygridCurs"
			.RecordSourceType=1
			.GridLines=0
			.DeleteMark=.F.
			.Height=400
			.Left=90
			.Top=.Parent.image1.Top+.Parent.image1.Height+40
			.FontBold=.T.
			.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255)  , RGB(190,235,200))", "Column")
			Locate
			.Refresh
		Endwith
	Endproc

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		DoDefault()
		Do Case
			Case Thisform.check1.Value=1   &&scroll vertical
				If nDirection>0
					Thisform.yscrollV.yscroller.DownClick
				Else
					Thisform.yscrollV.yscroller.UpClick
				Endi

			Case Thisform.check1.Value=0
				If nDirection>0
					Thisform.yscrollH.yscroller.DownClick
				Else
					Thisform.yscrollH.yscroller.UpClick
				Endi
		Endcase
	Endproc

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

Enddefine
*
*-- EndDefine: ycnt


*yScrollV class
Define Class yscrollV As Container
	Top = 24
	Left = 629
	Width = 40
	Height = 156
	BackStyle = 1
	BorderWidth = 0
	BackColor = Rgb(128,128,128)
	ToolTipText = "scrollV"
	Name = "yscrollerV"

	Add Object Spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 1000, ;
		KeyboardLowValue = 0, ;
		Left = 9, ;
		MousePointer = 15, ;
		SpinnerHighValue = 1000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 4, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object Text1 As TextBox With ;
		FontBold = .T., ;
		FontSize = 8, ;
		Alignment = 3, ;
		Value = 50, ;
		Height = 24, ;
		Left = 4, ;
		ToolTipText = "Increment", ;
		Top = 29, ;
		Width = 32, ;
		VALUE=50,;
		Name = "Text1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 8, ;
		WordWrap = .T., ;
		BackStyle = 0, ;
		Caption = ("S"+Chr(13)+"c"+Chr(13)+"r"+Chr(13)+"o"+Chr(13)+"l"+Chr(13)+"l"+Chr(13)+"V"), ;
		Height = 100, ;
		Left = 15, ;
		Top = 54, ;
		Width = 10, ;
		ForeColor = Rgb(255,255,0), ;
		Name = "Label1"

	Procedure Init
		With This
			.Top=Thisform.container1.Top
			.Left=Thisform.container1.Left+Thisform.container1.Width+2
		Endwith
	Endproc

	Procedure Spinner1.UpClick
		This.Increment=This.Parent.Text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top-This.Increment
			Next
		Endwith
	Endproc

	Procedure Spinner1.DownClick
		This.Increment=This.Parent.Text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top+This.Increment
			Next
		Endwith
	Endproc

	Procedure Spinner1.Init
		With This
			.Increment =  50.00
			.KeyboardHighValue = 2000
			.KeyboardLowValue = 0
			.SpinnerHighValue = 2000.00
			.SpinnerLowValue =   0.00
			.MousePointer=15
			.Name = "yscroller"
			.Value=0
		Endwith
	Endproc
Enddefine
*
*-- EndDefine: yScrollV

*yScrollH class
*
Define Class yscrollH As Container
	Top = 440
	Left = 472
	Width = 156
	Height = 30
	BackStyle = 1
	BorderWidth = 0
	BackColor = Rgb(128,128,128)
	ToolTipText = "scrollH"
	Name = "yscrollerH"

	Add Object Spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 1000, ;
		KeyboardLowValue = 0, ;
		Left = 2, ;
		MousePointer = 15, ;
		SpinnerHighValue = 1000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 3, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object Text1 As TextBox With ;
		FontBold = .T., ;
		FontSize = 8, ;
		Alignment = 3, ;
		Value = 20, ;
		Height = 24, ;
		Left = 23, ;
		ToolTipText = "Increment", ;
		Top = 3, ;
		Width = 37, ;
		VALUE=50,;
		Name = "Text1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 8, ;
		BackStyle = 0, ;
		Caption = "Scroll H", ;
		Height = 16, ;
		Left = 61, ;
		Top = 6, ;
		Width = 43, ;
		ForeColor = Rgb(255,255,0), ;
		Name = "Label1"

	Procedure Init
		With This
			.Top=Thisform.container1.Top+Thisform.container1.Height+2
			.Left=Thisform.container1.Width-.Width
		Endwith
	Endproc

	Procedure Spinner1.UpClick
		This.Increment=This.Parent.Text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Left=obj.Left-This.Increment
			Next
		Endwith
	Endproc

	Procedure Spinner1.DownClick
		This.Increment=This.Parent.Text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Left=obj.Left+This.Increment
			Next
		Endwith
	Endproc

	Procedure Spinner1.Init
		With This
			.Increment =  50.00
			.KeyboardHighValue = 2000
			.KeyboardLowValue = 0
			.SpinnerHighValue = 2000.00
			.SpinnerLowValue =   0.00
			.MousePointer=15
			.Name = "yscroller"
			.Value=0
		Endwith
	Endproc

Enddefine

can scroll with mouseWhell event with the mouse (scroll V & H)

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


*2* created on 24 of november 2017
*this is a simple scrollable form with showWindow=1(in the master form).master form can be as ShowWindow=0 (screen form) or 2 (top level)
*the good add is that scrollable container can be resized with the mouse (see the  gripper at bottom right, and from window sides).
*note that form.scrollbars (0,1,2,3) is Read/write at design time; read-only at run time.that why this code needs a form class scroller (bottom class).
*modal forms are not concerned here.
*the scroll form embeds an editbox,a container and an image as demo.

Publi oform
oform=Newobject("ymain")
oform.Show
Read Events
Retu
*
Define Class ymain As Form
	Top = 10
	Left = 83
	Height = 520
	Width = 750
	ShowWindow =2   &&0
	autocenter=.t.
	ScrollBars = 3   &&both H and V scrolls
	Caption = "Form embedding a form as scrollable container"
	Name = "form1"
  
  add object command1 as commandbutton with ;
left=620,;
top=20,;
caption="this is my button",;
autosize=.t.,;
backcolor=rgb(128,0,64),;
name="command1"

add object text1 as textbox with ;
left=620,;
top=60,;
value="this is test texbox",;
width=120,;
name="text1"

	Procedure Destroy
		Clea Events
	Endproc

	Procedure Init
		Publi  o
		o=Newobject("ychild")
		With o
			.TitleBar=0
			.ScrollBars=3
			.Width=500
			.Height=450
			.Name="child"
			.AddObject("edit1","editbox")
			.AddObject("container1","container")
			.AddObject ("image1","image")

			With .edit1
				.Height=500
				.Width=200
				.Value=Repli("***",400)
				.Visible=.T.
			Endwith

			With .container1
				.Left=.Parent.edit1.Left+.Parent.edit1.Width+2
				.Width=200
				.Height=200
				.BackColor=Rgb(0,255,0)
				.SpecialEffect=2
				.borderwidth=3
				.Visible=.T.
			Endwith

			With .image1
				.Stretch=2
				.Width=400
				.Height=.Width*9/16
        .backstyle=0
				.Left=.Parent.container1.Left+.Parent.container1.Width+10
				.Top=10
				.Picture=Home(1)+"SAMPLES\TASTRADE\BITMAPS\TTRADESM.BMP"
				.Visible=.T.
			Endwith

		Endwith
		Activate Window Child In Window (Thisform.Name)
	Endproc

Enddefine
*
*-- EndDefine: ymain

Define Class ychild As Form
	TitleBar=0
	Width=500
	Height=300
	ShowWindow=1
	ScrollBars=3
	Name="child"
Enddefine

Scrolling containers with pure and simple vfp solutions

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


*3* created on saturday 25 of november 2017
*a scrollable container as custom listbox 
*see help in form yhelp button

Close Data All
Local m.myvar
TEXT to m.myvar textmerge noshow
zazezezez ezezezeze   http://www.yousfi.over-blog.com zezeze yhyuyuiuiuoioiopppopopouiuio uii
vbxhdduu http://www.lebuteur.com/
ENDTEXT
if len(m.myvar)>128  &&limit the text to 128 chars
m.myvar=substr(m.myvar,1,128)
endi

Create Cursor ycurs(xtext m)
For i=1 To 20
	Insert Into ycurs Values (Trans(i)+" ."+Chr(13)+m.myvar)
Endfor
*brow
with _Screen
.AddProperty("opt",_vfp.EditorOptions)  &&save initial  editorOptions  to restore it late
endwith

_vfp.EditorOptions="k"  &&Enable Hyperlinks (Click to follow the link)  [K:Enable Hyperlinks (Click to follow the link)]

Publi yform
yform=Newobject("ylistbox")
yform.Show
Read Events
Retu

Define Class ylistbox As Form
  showWindow=2
	Top = 0
	Left = 0
	Height = 500
	Width = 550
	AutoCenter=.T.
	Caption = "can use mouseWheel to scrollV"
	ShowTips=.T.
	MaxButton=.F.
	BorderStyle=0
	Name = "form1"
	ncount=1

	Add Object container1 As Container With ;
		Left = 12, ;
		Width = 349, ;
		Height = 469, ;
		borderwidth=2,;
		bordercolor=Rgb(0,0,255),;
		Name = "Container1"

	Add Object yscroller As yscroller With;
		toscroll="thisform.container1",;
		name="yscroller"

	Add Object check1 As Checkbox With;
		autosize=.T.,;
		caption="Visibility",;
		value=1,;
		name="check1"

	Add Object yhelp As Label With;
		autosize=.T.,;
		mousepointer=15,;
		backstyle=0,;
		caption="?",;
		fontsize=18,;
		fontbold=.T.,;
		forecolor=255,;
		tooltiptext="Summary help",;
		name="yhelp"

	Add Object check2 As Checkbox With;
		autosize=.T.,;
		caption="EnableHyperlinks",;
		value=0,;
		name="check2"

	Add Object check3 As Checkbox With;
		autosize=.T.,;
		caption="borders",;
		value=0,;
		name="check3"

	Procedure container1.MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		*  mousewheel scroll vertical here
		If nDirection>0
			Thisform.yscroller.spinner1.DownClick
		Else
			Thisform.yscroller.spinner1.UpClick
		Endi
	Endproc

	Procedure Init
		DoDefault()
		Sele ycurs
		Thisform.ncount=Reccount()
		With Thisform.container1
			For i=1 To Thisform.ncount
				.AddObject ("yitem"+Trans(i),"yitem")
				With Eval(".yitem"+Trans(i))
					.Top=(i-1)*.Height+1
					.Left=2
					.Width=.Parent.Width -4
					.Name="yitem"+Trans(i)
					Sele ycurs
					Go i
					.Value=xtext
					.Visible=.T.
				Endwith
			Endfor
			.Refresh
		Endwith

		With This.yscroller
			.Left=.Parent.container1.Left+.Parent.container1.Width+5
			.Top=10
			.Parent.check1.Top=15
			.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10

			.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
			.Parent.yhelp.Top=.Parent.check1.Top-10

			.Parent.check2.Left=.Left
			.Parent.check2.Top=.Top+.Height+10
			.Parent.check3.Left=.Left
			.Parent.check3.Top=.Top+3*.Height
		Endwith

	Endproc

	Procedure check1.InteractiveChange()
		Thisform.yscroller.Visible=!Thisform.yscroller.Visible
	Endproc

	Procedure check2.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="edit1"
					.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure check3.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="edit1"
					.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure yhelp.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers editbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions setting (whether click or CTRL+Click goes to the link).

can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.

can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note:  property enablehyperlnks makes all color disappear ? (bug)

		ENDTEXT
		Local oshell
		oshell = Createobject('WScript.Shell')
		oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096)  &&4,16,48,64...
		oshell=Null
	Endproc

	Procedure Destroy
		_vfp.EditorOptions=_Screen.opt
		Clea Events
	Endproc
Enddefine
*Enddefine ylistbox

Define Class yitem As EditBox
	BackStyle = 0
	BorderStyle =0  &&1
	Margin=10
	Height = 110
	Left = 7
	MousePointer = 15
	ReadOnly = .T.
	FontSize=11
	ScrollBars = 0
	Top = 1
	Width = 337
	SpecialEffect=2
	EnableHyperlinks = .F.
	ForeColor=255
	DisabledForeColor=255
	Name = "Edit1"

	Procedure Init
		This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		This.DisabledForeColor=This.ForeColor
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Set Curs Off
		With This
			.BackStyle=1
			.DisabledBackColor=Rgb(175,175,175)
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackStyle=0
			.DisabledBackColor=Rgb(240,240,240)
		Endwith
		Set Curs On
	Endproc

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

Enddefine
*-- EndDefine:yitem

Define Class yscroller As Container
	Top = 84
	Left = 390
	Width = 68
	Height = 27
	BorderWidth = 0
	Name = "yscroller"
	toscroll=""

	Add Object spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 2000, ;
		KeyboardLowValue = 0, ;
		Left = 5, ;
		SpinnerHighValue = 2000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 2, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object text1 As TextBox With ;
		Height = 25, ;
		Left = 29, ;
		Top = 1, ;
		Width = 37, ;
		value=20,;
		fontbold=.T.,;
		Name = "Text1"

	Procedure Init
		If !Vartype(Eval(This.toscroll))="O"
			Messagebox("toscroll container must exist",16+4096,"error")
			Return .F.
		Endi
		With This.text1
			.Parent.spinner1.Increment=.Value
		Endwith
	Endproc

	Procedure spinner1.DownClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top-This.Increment
			Next
		Endwith
	Endproc

	Procedure spinner1.UpClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top+This.Increment
			Next
		Endwith
	Endproc
Enddefine
*
*-- EndDefine: ycom

can put textbox or labels instead editbox ...with hyperlinks..

can put textbox or labels instead editbox ...with hyperlinks..

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


*4* created on sunday 26 of november 2017
*same as above code but with images decoration.
*a scrollable container as custom listbox with images and editbox
*see help in form yhelp button

Close Data All
Local m.myvar
TEXT to m.myvar textmerge noshow
zazezezez ezezezeze   http://www.yousfi.over-blog.com zezeze yhyuyuiuiuoioiopppopopouiuio uii
vbxhdduu http://www.lebuteur.com/
ENDTEXT
If Len(m.myvar)>128  &&limit the text to 128 chars
	m.myvar=Substr(m.myvar,1,128)
Endi

Local gnbre
gnbre=Adir(gabase,Home(1)+"GRAPHICS\ICONS\MISC\*.ico")



Create Cursor ycurs(xtext m,ximg c(150))
For i=1 To 20
	Insert Into ycurs Values (Trans(i)+" ."+Chr(13)+m.myvar,Home(1)+"GRAPHICS\ICONS\MISC\"+Allt(gabase(i,1)))
Endfor
*brow

With _Screen
	.AddProperty("opt",_vfp.EditorOptions)  &&save initial  editorOptions  to restore it late
Endwith

_vfp.EditorOptions="k"  &&Enable Hyperlinks (Click to follow the link)  [K:Enable Hyperlinks (Click to follow the link)]

Publi yform
yform=Newobject("ylistbox")
yform.Show
Read Events
Retu

Define Class ylistbox As Form
	ShowWindow=2
	Top = 0
	Left = 0
	Height = 500
	Width = 550
	ShowWindow=2
	AutoCenter=.T.
	Caption = "can use mouseWheel to scrollV"
	ShowTips=.F.
	MaxButton=.F.
	BorderStyle=0
	Name = "form1"
	ncount=1

	Add Object container1 As Container With ;
		Left = 12, ;
		Width = 349, ;
		Height = 469, ;
		borderwidth=2,;
		bordercolor=Rgb(0,0,255),;
		Name = "Container1"

	Add Object yscroller As yscroller With;
		toscroll="thisform.container1",;
		name="yscroller"

	Add Object check1 As Checkbox With;
		autosize=.T.,;
		caption="Visibility",;
		value=1,;
		name="check1"

	Add Object yhelp As Label With;
		autosize=.T.,;
		mousepointer=15,;
		backstyle=0,;
		caption="?",;
		fontsize=18,;
		fontbold=.T.,;
		forecolor=255,;
		tooltiptext="Summary help",;
		name="yhelp"

	Add Object check2 As Checkbox With;
		autosize=.T.,;
		caption="EnableHyperlinks",;
		value=0,;
		name="check2"

	Add Object check3 As Checkbox With;
		autosize=.T.,;
		caption="borders",;
		value=0,;
		name="check3"

	Procedure container1.MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		*  mousewheel scroll vertical here
		If nDirection>0
			Thisform.yscroller.spinner1.DownClick
		Else
			Thisform.yscroller.spinner1.UpClick
		Endi
	Endproc

	Procedure Init
		DoDefault()
		Sele ycurs
		Thisform.ncount=Reccount()
		With Thisform.container1
			For i=1 To Thisform.ncount
				Sele ycurs
				Go i

				.AddObject ("yitem"+Trans(i),"yitem")
				With Eval(".yitem"+Trans(i))
					.Top=(i-1)*.Height+1
					.Left=2+64+4
					.Width=.Parent.Width  -4-64-10
					.Name="yitem"+Trans(i)

					.Value=xtext
					.Visible=.T.
				Endwith


				.AddObject ("yimg"+Trans(i),"yimg")
				With Eval(".yimg"+Trans(i))
					.Left=4
					.Width=64
					.Height=64
					.Top=(i-1)*Eval(".parent.yitem"+Trans(i)+".height")+1+20
					.Stretch=2
					.Picture=Nvl(ximg,"")
					.Name="yimg"+Trans(i)
					.Visible=.T.
				Endwith
			Endfor
			.Refresh
		Endwith

		With This.yscroller
			.Left=.Parent.container1.Left+.Parent.container1.Width+5
			.Top=10
			.Parent.check1.Top=15
			.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10

			.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
			.Parent.yhelp.Top=.Parent.check1.Top-10

			.Parent.check2.Left=.Left
			.Parent.check2.Top=.Top+.Height+10
			.Parent.check3.Left=.Left
			.Parent.check3.Top=.Top+3*.Height
		Endwith
	Endproc

	Procedure check1.InteractiveChange()
		Thisform.yscroller.Visible=!Thisform.yscroller.Visible
	Endproc

	Procedure check2.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="edit1"
					.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure check3.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="edit1"
					.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure yhelp.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers editbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions setting (whether click or CTRL+Click goes to the link).

can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.

can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note:  property enablehyperlnks makes all color disappear ? (bug)
i decorated with rand forecolor,can set any user forecolors.
		ENDTEXT
		Local oshell
		oshell = Createobject('WScript.Shell')
		oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096)  &&4,16,48,64...
		oshell=Null
	Endproc

	Procedure Destroy
		_vfp.EditorOptions=_Screen.opt
		Clea Events
	Endproc
Enddefine
*Enddefine ylistbox

Define Class yitem As EditBox
	BackStyle = 0
	BorderStyle =0  &&1
	Margin=10
	Height = 110
	Left = 7
	MousePointer = 15
	ReadOnly = .T.
	FontSize=10
	ScrollBars = 0
	Top = 1
	Width = 337
	SpecialEffect=2
	EnableHyperlinks = .F.
	ForeColor=255
	DisabledForeColor=255
	Name = "Edit1"

	Procedure Init
		This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		This.DisabledForeColor=This.ForeColor
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Set Curs Off
		With This
			.BackStyle=1
			.DisabledBackColor=Rgb(175,175,175)
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackStyle=0
			.DisabledBackColor=Rgb(240,240,240)
		Endwith
		Set Curs On
	Endproc

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

Enddefine
*-- EndDefine:yitem

Define Class yimg As Image
	Left=2
	Width=64
	Height=64
	Stretch=2
	Picture=""
	MousePointer=15
	BackStyle=0
	Name="yimg"

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left-2
			.Top=.Top-2
			.BorderStyle=1
			Local m.x
			x=Eval(".parent.yitem"+Substr(.Name,5) )
			x.MouseEnter(1)
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left+2
			.Top=.Top+2
			.BorderStyle=0
			Local m.x
			x=Eval(".parent.yitem"+Substr(.Name,5) )
			x.MouseLeave(1)
		Endwith
	Endproc

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

Enddefine


Define Class yscroller As Container
	Top = 84
	Left = 390
	Width = 68
	Height = 27
	BorderWidth = 0
	Name = "yscroller"
	toscroll=""

	Add Object spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 2000, ;
		KeyboardLowValue = 0, ;
		Left = 5, ;
		SpinnerHighValue = 2000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 2, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object text1 As TextBox With ;
		Height = 25, ;
		Left = 29, ;
		Top = 1, ;
		Width = 37, ;
		value=20,;
		fontbold=.T.,;
		Name = "Text1"

	Procedure Init
		If !Vartype(Eval(This.toscroll))="O"
			Messagebox("toscroll container must exist",16+4096,"error")
			Return .F.
		Endi
		With This.text1
			.Parent.spinner1.Increment=.Value
		Endwith
	Endproc

	Procedure spinner1.DownClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top-This.Increment
			Next
		Endwith
	Endproc

	Procedure spinner1.UpClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top+This.Increment
			Next
		Endwith
	Endproc
Enddefine
*
*-- EndDefine: ycom

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

 
*5* created on saturday 25 of november 2017
*custom listbox with container/textbox with enabledHyperlinks property on/off
*see help in form yhelp button

Close Data All
Local m.myvar
TEXT to m.myvar  noshow
https://www.foxite.com/forum/
https://www.levelextreme.com/Default.aspx?LevelExtremeRedirect=1
http://www.elkhabar.com/
http://www.huffpostmaghreb.com/algerie/
http://www.lebuteur.com/
http://www.atoutfox.org/
http://weblogs.foxite.com/vfpimaging/author/vfpimaging/
http://www.news2news.com/vfp/index.php
http://www.sweetpotatosoftware.com/spsblog/
https://west-wind.com/wconnect/weblog/ShowEntry.blog?id=669
http://stackoverflow.com/questions/tagged/foxpro
http://www.foxpert.com/knowlbits.htm
https://vfpx.github.io/
http://www.berezniker.com/blogs/sergey
http://doughennig.blogspot.com/
http://sandstorm36.blogspot.com/
http://www.tomorrowssolutionsllc.com/
https://blogs.msdn.microsoft.com/calvin_hsia/tag/visual-foxpro/
http://fox.wikis.com/
http://doughennig.com/papers/
https://translate.google.dz/?hl=fr&tab=wT#fr/en/
http://www.lequipe.fr/
http://www.sport.fr/
http://praisachion.blogspot.ro/2015/02/api-messagebox.html
http://www.jasinskionline.com/windowsapi/ref/funca.html
http://www.west-wind.com/articles.aspx
http://www.arg.kirov.ru/
ENDTEXT

set memowidth to 8192
Create Cursor ycurs(xtext c(50))
For i=1 To memlines(m.myvar)
	Insert Into ycurs Values (Trans(i)+" .  "+mline(m.myvar,i))
Endfor
*brow
with _Screen
.AddProperty("hyp",.F.)
.AddProperty("opt",_vfp.EditorOptions)  &&save initial  editorOptions  to restore it late
*messagebox(.opt)
endwith

_vfp.EditorOptions="k"  &&Enable Hyperlinks (Click to follow the link)  [K:Enable Hyperlinks (Click to follow the link)]

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu

Define Class asup As Form
	Top = 0
	Left = 0
	Height = 500
	Width = 550
	showWindow=2
	AutoCenter=.T.
	Caption = "can use mouseWheel to scrollV"
	ShowTips=.f.  
	MaxButton=.F.
	BorderStyle=0
	Name = "form1"
	ncount=1

	Add Object container1 As Container With ;
		Left = 12, ;
		Width = 349, ;
		Height = 469, ;
		borderwidth=2,;
		bordercolor=Rgb(0,0,255),;
		Name = "Container1"

	Add Object yscroller As yscroller With;
		toscroll="thisform.container1",;
		name="yscroller"

	Add Object check1 As Checkbox With;
		autosize=.T.,;
		caption="Visibility",;
		value=1,;
		name="check1"

	Add Object yhelp As Label With;
		autosize=.T.,;
		mousepointer=15,;
		backstyle=0,;
		caption="?",;
		fontsize=18,;
		fontbold=.T.,;
		forecolor=255,;
		tooltiptext="Summary help",;
		name="yhelp"

	Add Object check2 As Checkbox With;
		autosize=.T.,;
		caption="EnableHyperlinks",;
		value=0,;
		name="check2"

	Add Object check3 As Checkbox With;
		autosize=.T.,;
		caption="borders",;
		value=0,;
		name="check3"

	Procedure container1.MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		*  mousewheel scroll vertical here
		If nDirection>0
			Thisform.yscroller.spinner1.DownClick
		Else
			Thisform.yscroller.spinner1.UpClick
		Endi
	Endproc

	Procedure Init
		DoDefault()
		Sele ycurs
		Thisform.ncount=Reccount()
		With Thisform.container1
			For i=1 To Thisform.ncount
				.AddObject ("yitem"+Trans(i),"yitem")
				With Eval(".yitem"+Trans(i))
					.Top=(i-1)*.Height+1
					.Left=2
					.Width=.Parent.Width -4
					.Name="yitem"+Trans(i)
					Sele ycurs
					Go i
					.Value=xtext
					.Visible=.T.
				Endwith
			Endfor
			.Refresh
		Endwith

		With This.yscroller
			.Left=.Parent.container1.Left+.Parent.container1.Width+5
			.Top=10
			.Parent.check1.Top=15
			.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10

			.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
			.Parent.yhelp.Top=.Parent.check1.Top-10

			.Parent.check2.Left=.Left
			.Parent.check2.Top=.Top+.Height+10
			.Parent.check3.Left=.Left
			.Parent.check3.Top=.Top+3*.Height
		Endwith

	Endproc

	Procedure check1.InteractiveChange()
		Thisform.yscroller.Visible=!Thisform.yscroller.Visible
	Endproc

	Procedure check2.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="text1"
					.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure check3.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="text1"
					.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure yhelp.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers textbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions
setting (whether click or CTRL+Click goes to the link).

can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.

can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note:  property enablehyperlnks makes all color disappear ? (bug)
		ENDTEXT
		Local oshell
		oshell = Createobject('WScript.Shell')
		oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096)  &&4,16,48,64...
		oshell=Null
	Endproc

	Procedure Destroy
		_vfp.EditorOptions=_Screen.opt
		Clea Events
	Endproc
Enddefine


Define Class yitem As Textbox
	BackStyle = 0
	BorderStyle =0  &&1
	Margin=10
	Height = 40
	Left = 7
	MousePointer = 15
	ReadOnly = .T.
	FontSize=11
	Top = 1
	Width = 337
	SpecialEffect=2
	EnableHyperlinks = .F.
	ForeColor=255
	DisabledForeColor=255
	Name = "Text1"

	Procedure Init
		This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		This.DisabledForeColor=This.ForeColor
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Set Curs Off
		With This
			.BackStyle=1
			.DisabledBackColor=Rgb(175,175,175)
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackStyle=0
			.DisabledBackColor=Rgb(240,240,240)
		Endwith
		Set Curs On
	Endproc

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

Enddefine
*-- EndDefine:yitem

Define Class yscroller As Container
	Top = 84
	Left = 390
	Width = 68
	Height = 27
	BorderWidth = 0
	Name = "yscroller"
	toscroll=""

	Add Object spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 2000, ;
		KeyboardLowValue = 0, ;
		Left = 5, ;
		SpinnerHighValue = 2000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 2, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object text1 As TextBox With ;
		Height = 25, ;
		Left = 29, ;
		Top = 1, ;
		Width = 37, ;
		value=20,;
		fontbold=.T.,;
		Name = "Text1"

	Procedure Init
		If !Vartype(Eval(This.toscroll))="O"
			Messagebox("toscroll container must exist",16+4096,"error")
			Return .F.
		Endi
		With This.text1
			.Parent.spinner1.Increment=.Value
		Endwith
	Endproc

	Procedure spinner1.DownClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top-This.Increment
			Next
		Endwith
	Endproc

	Procedure spinner1.UpClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top+This.Increment
			Next
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: ycom

can add images at left (or icons) for decoration.

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


*6* created on sunday 26 of november 2017
*same as above but updated with images and a similar status event.
*custom listbox with container/textbox and images (icons) with enabledHyperlinks property on/off
*see help in form yhelp button

Close Data All
Local m.myvar
TEXT to m.myvar  noshow
https://www.foxite.com/forum/
https://www.levelextreme.com/Default.aspx?LevelExtremeRedirect=1
http://www.elkhabar.com/
http://www.huffpostmaghreb.com/algerie/
http://www.lebuteur.com/
http://www.atoutfox.org/
http://weblogs.foxite.com/vfpimaging/author/vfpimaging/
http://www.news2news.com/vfp/index.php
http://www.sweetpotatosoftware.com/spsblog/
https://west-wind.com/wconnect/weblog/ShowEntry.blog?id=669
http://stackoverflow.com/questions/tagged/foxpro
http://www.foxpert.com/knowlbits.htm
https://vfpx.github.io/
http://www.berezniker.com/blogs/sergey
http://doughennig.blogspot.com/
http://sandstorm36.blogspot.com/
http://www.tomorrowssolutionsllc.com/
https://blogs.msdn.microsoft.com/calvin_hsia/tag/visual-foxpro/
http://fox.wikis.com/
http://doughennig.com/papers/
https://translate.google.dz/?hl=fr&tab=wT#fr/en/
http://www.lequipe.fr/
http://www.sport.fr/
http://praisachion.blogspot.ro/2015/02/api-messagebox.html
http://www.jasinskionline.com/windowsapi/ref/funca.html
http://www.west-wind.com/articles.aspx
http://www.arg.kirov.ru/
ENDTEXT

Set Memowidth To 8192
Local gnbre
gnbre=Adir(gabase,Home(1)+"GRAPHICS\ICONS\MISC\*.ico")
Create Cursor ycurs(xtext c(60),ximg c(150))
For i=1 To 20
	Insert Into ycurs Values (Trans(i)+" .  "+Mline(m.myvar,i),Home(1)+"GRAPHICS\ICONS\MISC\"+Allt(gabase(i,1)))
Endfor
*brow

With _Screen
	.AddProperty("hyp",.F.)
	.AddProperty("opt",_vfp.EditorOptions)  &&save initial  editorOptions  to restore it late
	*messagebox(.opt)
Endwith

_vfp.EditorOptions="k"  &&Enable Hyperlinks (Click to follow the link)  [K:Enable Hyperlinks (Click to follow the link)]

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu

Define Class asup As Form
	Top = 0
	Left = 0
	Height = 500
	Width = 550
	ShowWindow=2
	AutoCenter=.T.
	Caption = "can use mouseWheel to scrollV"
	ShowTips=.F.
	MaxButton=.F.
	BorderStyle=0
	Name = "form1"
	ncount=1

	Add Object container1 As Container With ;
		Left = 12, ;
		Width = 349, ;
		Height = 469, ;
		borderwidth=2,;
		bordercolor=Rgb(0,0,255),;
		Name = "Container1"

	Add Object ystat As Label With ;
		autosize=.T.,;
		left=12,;
		fontsize=8,;
		top=475,;
		caption="",;
		name="ystat"

	Add Object yscroller As yscroller With;
		toscroll="thisform.container1",;
		name="yscroller"

	Add Object check1 As Checkbox With;
		autosize=.T.,;
		caption="Visibility",;
		value=1,;
		name="check1"

	Add Object yhelp As Label With;
		autosize=.T.,;
		mousepointer=15,;
		backstyle=0,;
		caption="?",;
		fontsize=18,;
		fontbold=.T.,;
		forecolor=255,;
		tooltiptext="Summary help",;
		name="yhelp"

	Add Object check2 As Checkbox With;
		autosize=.T.,;
		caption="EnableHyperlinks",;
		value=0,;
		name="check2"

	Add Object check3 As Checkbox With;
		autosize=.T.,;
		caption="borders",;
		value=0,;
		name="check3"

	Procedure container1.MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		*  mousewheel scroll vertical here
		If nDirection>0
			Thisform.yscroller.spinner1.DownClick
		Else
			Thisform.yscroller.spinner1.UpClick
		Endi
	Endproc

	Procedure Init
		DoDefault()
		Sele ycurs
		Thisform.ncount=Reccount()
		With Thisform.container1
			For i=1 To Thisform.ncount
				.AddObject ("yitem"+Trans(i),"yitem")
				With Eval(".yitem"+Trans(i))
					.Top=(i-1)*.Height+1
					.Left=32+2
					.Width=.Parent.Width -32-4
					.Name="yitem"+Trans(i)
					Sele ycurs
					Go i
					.Value=xtext
					.Visible=.T.
				Endwith

				.AddObject ("yimg"+Trans(i),"yimg")
				With Eval(".yimg"+Trans(i))
					.Left=4
					.Width=20
					.Height=20
					.Top=(i-1)*Eval(".parent.yitem"+Trans(i)+".height")+1+5
					.Stretch=2
					.Picture=Nvl(ximg,"")
					.Name="yimg"+Trans(i)
					.Visible=.T.
				Endwith
			Endfor

			.Refresh
		Endwith

		With This.yscroller
			.Left=.Parent.container1.Left+.Parent.container1.Width+5
			.Top=10
			.Parent.check1.Top=15
			.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10

			.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
			.Parent.yhelp.Top=.Parent.check1.Top-10

			.Parent.check2.Left=.Left
			.Parent.check2.Top=.Top+.Height+10
			.Parent.check3.Left=.Left
			.Parent.check3.Top=.Top+3*.Height
		Endwith

	Endproc

	Procedure check1.InteractiveChange()
		Thisform.yscroller.Visible=!Thisform.yscroller.Visible
	Endproc

	Procedure check2.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="text1"
					.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure check3.InteractiveChange()
		With Thisform.container1
			DoDefault()
			For i=1  To .ControlCount
				If Lower(.Controls(i).Class)=="text1"
					.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
					.Refresh
				Endi
			Endfor
		Endwith
	Endproc

	Procedure yhelp.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers textbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions
setting (whether click or CTRL+Click goes to the link).

can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.

can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note:  property enablehyperlnks makes all color disappear ? (bug)
		ENDTEXT
		Local oshell
		oshell = Createobject('WScript.Shell')
		oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096)  &&4,16,48,64...
		oshell=Null
	Endproc

	Procedure Destroy
		_vfp.EditorOptions=_Screen.opt  &&restore settings
		Clea Events
	Endproc
Enddefine

*
Define Class yitem As TextBox
	BackStyle = 0
	BorderStyle =0  &&1
	Margin=10
	Height = 40
	Left = 7
	MousePointer = 15
	ReadOnly = .T.
	FontSize=11
	Top = 1
	Width = 337
	SpecialEffect=2
	EnableHyperlinks = .F.
	ForeColor=255
	DisabledForeColor=255
	Name = "Text1"

	Procedure Init
		This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		This.DisabledForeColor=This.ForeColor
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Set Curs Off
		With This
			.BackStyle=1
			.DisabledBackColor=Rgb(175,175,175)
			Thisform.ystat.Caption=Substr(.Value,4)
		Endwith

	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackStyle=0
			.DisabledBackColor=Rgb(240,240,240)
			Thisform.ystat.Caption=""
		Endwith
		Set Curs On
	Endproc

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

Enddefine
*-- EndDefine:yitem
*
Define Class yimg As Image
	Left=2
	Width=32
	Height=32
	Stretch=2
	Picture=""
	MousePointer=15
	BackStyle=0
	Name="yimg"

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left-2
			.Top=.Top-2
			.BorderStyle=1
			Local m.x
			x=Eval(".parent.yitem"+Substr(.Name,5) )
			x.MouseEnter(1)
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left+2
			.Top=.Top+2
			.BorderStyle=0
			Local m.x
			x=Eval(".parent.yitem"+Substr(.Name,5) )
			x.MouseLeave(1)
		Endwith
	Endproc

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		This.Parent.MouseWheel(nDirection)
	Endproc
Enddefine
*
Define Class yscroller As Container
	Top = 84
	Left = 390
	Width = 68
	Height = 27
	BorderWidth = 0
	Name = "yscroller"
	toscroll=""

	Add Object spinner1 As Spinner With ;
		Height = 24, ;
		Increment =  10.00, ;
		KeyboardHighValue = 2000, ;
		KeyboardLowValue = 0, ;
		Left = 5, ;
		SpinnerHighValue = 2000.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 2, ;
		Width = 20, ;
		Name = "Spinner1"

	Add Object text1 As TextBox With ;
		Height = 25, ;
		Left = 29, ;
		Top = 1, ;
		Width = 37, ;
		value=20,;
		fontbold=.T.,;
		Name = "Text1"

	Procedure Init
		If !Vartype(Eval(This.toscroll))="O"
			Messagebox("toscroll container must exist",16+4096,"error")
			Return .F.
		Endi
		With This.text1
			.Parent.spinner1.Increment=.Value
		Endwith
	Endproc

	Procedure spinner1.DownClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top-This.Increment
			Next
		Endwith
	Endproc

	Procedure spinner1.UpClick
		This.Increment=This.Parent.text1.Value
		With  Thisform.container1
			For Each obj In .Controls
				obj.Top=obj.Top+This.Increment
			Next
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: ycom

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


*7* created on sunday 26 of november 2017
*this code can scroll any vfp container with a simple mousewheel event vertically or horizontally (to switch in checkBox)
*can fill the container with objects as wanted.
*cannot use APIs to scroll a vfp container because vfp objects have not handles (only form have it).
*change the increment of mouseWheel in the ycnt class container on need.
**of course can limit the scrolling area after testing the mousewhell parameters (nXcoord and nYcoord)!add test: if between(nxcoord,..,..) or between(nycoord,..,..)
*nowadays all PC mouses are built with a mousewheel and that is suffisent to scroll any vfp container (no need to build a scrollbar).

Close Data All
Create Cursor ycurs (ximg  c(150))

Local gnbre
gnbre=Adir(gabase,Home(1)+"graphics\icons\misc\*.ico")
For i=1 To gnbre
	Insert Into ycurs Values(Home(1)+"graphics\icons\misc\"+gabase(i,1))
Endfor
*brow

Publi yform
yform=Newobject("yscrolls")
yform.Show
Read Events
Retu
*
Define Class yscrolls As Form
	Top = 0
	Left = 0
	Height = 540
	Width = 450
	ShowWindow = 2
	ShowTips = .T.
	Caption = "scroll V or H only with ths mousewheel"
	Name = "form1"

	Add Object container1 As ycnt With ;
		Top = 24, ;
		Left = 36, ;
		BorderWidth = 2, ;
		BackColor = Rgb(213,255,255), ;
		Name = "Container1"

	Add Object check1 As Checkbox With ;
		autosize=.T. ,;
		style=1,;
		caption="MouseWheel ScrollV",;
		backcolor=Rgb(0,255,0),;
		fontbold=.T.,;
		value=1,;
		visible=.T.,;
		name="check1"

	Add Object label1 As Label With;
		autosize=.T.,;
		backstyle=0,;
		fontsize=11,;
		caption="Click on any icon",;
		name="label1"

	Add Object yhelp As Label With;
		autosize=.T.,;
		backstyle=0,;
		fontsize=22,;
		caption="?",;
		mousepointer=15,;
		forecolor=255,;
		fontbold=.T.,;
		name="yhelp"

	Procedure yhelp.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
Scroll any vfp container fill with objects vertically or horizontally with the mouseWheel only.
can sweetch V or H with the checkbox (click or key a return it have the focus).
in the objects embed must code the mouseWheel to redirect it to the main container (see in yimg class this procedure).
of course the container mouyseWheel must be coded (see in ycnt container).
change the increment of mouseWheel in the ycnt class container on need.
*of course can limit the scrolling area after testing the mousewhell parameters (nXcoord and nYcoord)!add test: if between(nxcoord,..,..) or between(nycoord,..,..).
here all misc icons of home(1).can code any of them to fire any code (as menu).
		ENDTEXT
		Messagebox(m.myvar,0+32+4096,"Summary help")
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure Init
		With This.check1
			.Left=(Thisform.container1.Width-.Width)/2
			.Top=Thisform.container1.Top+Thisform.container1.Height+20
			.Parent.label1.Left=.Left+.Width +50
			.Parent.label1.Top=.Top
			.Parent.yhelp.Left=10
			.Parent.yhelp.Top=.Top
		Endwith

	Procedure check1.InteractiveChange
		This.Caption=Iif(This.Value=1,"MouseWheel ScrollV","MouseWheel ScrollH")
	Endproc

Enddefine
*
*-- EndDefine: yscrolls

Define Class ycnt As Container
	Top = 24
	Left = 36
	Width = 400
	Height =450
	BorderWidth = 2
	BackColor = Rgb(213,255,255)
	Name = "Container1"
	Increment=30   &&variable property to implement value of scroll V or H.

	Procedure Init
		Local m.delta
		m.delta=20
		m.perRow=6

		With This
			.Top=10
			.Left=10
			.BackStyle=0

			Sele ycurs
			Locate
			k=1
			u=0
			Scan
				j=Recno()
				.AddObject("yimg"+Trans(j),"yimg")
				With Eval (".yimg"+Trans(j))
					.Picture=ximg
					.Width=64
					.Height=64

					If u>m.perRow-1
						u=1
						k=k+1
					Else
						u=u+1
					Endi

					If u=1
						Left=10
					Else
						.Left=Eval(".parent.yimg"+Trans(j-1)+".left")+Eval(".parent.yimg"+Trans(j-1)+".width")+m.delta
					Endi

					If k=1
						.Top=10
					Else
						.Top=10+(k-1)*.Height+m.delta
					Endi
					.Visible=.T.

				Endwith
			Endscan
		Endwith
	Endproc

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		DoDefault()
		Do Case
			Case Thisform.check1.Value=1   &&scroll vertical
				If nDirection>0
					With  This
						For Each obj In .Controls
            Try  &&in case object have not top property (a timer for ex)
							obj.Top=obj.Top-This.Increment
              catch
              endtry
						Next
					Endwith
				Else
					With  This
						For Each obj In .Controls
             try
							obj.Top=obj.Top+This.Increment
              catch
              endtry
						Next
					Endwith
				Endi
			Case Thisform.check1.Value=0
				If nDirection>0
					With  This
						For Each obj In .Controls
            try
							obj.Left=obj.Left-This.Increment
              catch
              endtry
						Next
					Endwith
				Else
					With  This
						For Each obj In .Controls
             Try  &&in case object have not left property (a timer for ex)
							obj.Left=obj.Left+This.Increment
              catch
              endtry
						Next
					Endwith
				Endi
		Endcase
	Endproc

Enddefine
*
*-- EndDefine: ycnt

Define Class yimg As Image
	Stretch=2
	Width=96
	Height=96
	Picture=""
	BackStyle=0
	MousePointer=15
	Name="yimg"

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		This.Parent.MouseWheel(nDirection)
	Endproc
	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left-2
			.Top=.Top-2
			.BorderStyle=1
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Left=.Left+2
			.Top=.Top+2
			.BorderStyle=0
		Endwith
	Endproc

	Procedure MouseDown
		Lparameters nButton, nShift, nXCoord, nYCoord
		Messagebox("    picture:"+Chr(13)+ +This.Picture+Chr(13)+Chr(13)+"  can fire any code from here!",0+32+4096,'',1200)
	Endproc

Enddefine

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


*8*
*created on 27 of december 2017
*mouseWeel on comboBox control
*by default the combo shows a scrollbar if its items count are >1
*you can set combo.displaycount to set the visible items on combo (by defaut its 0 corresponding to max 7 items)
*here can mouseWheel on the area of combo (not on items)or optionly on form  to dropdown the combo and scroll its items
*can set the increment to scroll (here xincrement=1)
*can scroll the same combo by mouseWheel out on the form if theoptional property ms=.t. (as below)

Public oform
oform=Newobject("ycombo_mouse")
oform.Show
Return

*
Define Class ycombo_mouse As Form
  Top = 0
  Left = 0
  Height = 399
  Width = 450
  Caption = "MouseWheel a combo area or optionly on form(to set in ms"
  Name = "Form1"
  ms=.t.   &&make it to .f. if dont want mouseWheel the combo from form.

  Add Object combo1 As ComboBox With ;
    Height = 37, ;
    Left = 60, ;
    Top = 24, ;
    Width = 181, ;
    Name = "Combo1"

  Procedure MouseWheel
    Lparameters nDirection, nShift, nXCoord, nYCoord
    if thisform.ms=.t.
    Thisform.combo1.MouseWheel(nDirection)  &&can interact with combo from form.mousewheel
    endi
  Endproc

  Procedure combo1.MouseWheel
    Lparameters nDirection, nShift, nXCoord, nYCoord
    Local m.xincrement
    m.xincrement=1

    If nDirection<0
      This.Value=This.Value+m.xincrement
      Keyboard "{f4}"  &&drop down the combo
    Endi

    If nDirection>0
      This.Value=This.Value-m.xincrement
      Keyboard "{f4}" &&drop down the combo
    Endi
  Endproc

  Procedure combo1.Init
    With This
      For i=1 To 100
        .AddItem(Trans(i)+"  blablabla")
      Endfor
      .ListIndex=1
      .Style=2
      .Value=1
    Endwith

  Endproc

Enddefine
*
*-- EndDefine: ycombo_mouse

some relative links in this blog

testing a vfp scrollbar container class application
the vfpscrollbar container class as prg code
scrolling texts images in visual foxpro
scrolling containers with flatscrollbar
mining in vfp sources

Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1703 ( creator update) .