A scrollable menu with vfpScrollbar class

Published on January 5 2016 by Yousfi Benameur


I wanted initially to add this example with the previous posts in same subject but i think its a big code and i made it separatly in a standalone post.
Its a direct application of the SPS vfpscrollbar i used to generate a menu on a top level form.
simply point to a folder of PNG icons (as in images below) and the code do the rest.
each PNG is cliquable and can make any vfp action (do...or execute any vfp routine).i used Bindevent for this purpose.
in some PNGs can set an idividual contextuel menu to fire many actions...

Set in the method "My" the actions to fire in each PNG click.
(In this example i used exhaustively 146 PNGs to test horizontal scroll container).Of course can use a vertical class container (set scroll=2 for vertical scroll). can also add all kinds of vfp objects.
ScrollContainer theme colors can be accessed directly on the PEM sheet (or set in the code).can also use the native picture container property to add a background picture.


Important: this code is tested on Win10 pro & VFP9SP2.
the vfpscroll class is from SPS (see previous posts).its used here as flat text (no vcx,vct).

    
*the second code *2* simulates a special menu a la Firefox.

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

*updated on 29 of march 2017---add getdir() to point to any disc folder images PNgs 
*1* SPS vfpScrollbar class as prg class  added to code(to make one standalone code).
*this class as flat text is used to make a kind of menu or toolbar with some PNGs to fire any action.
*point to a folder of PNG images and the code makes the rest.

Publi yform
yform=Newobject("ymenu_form")
yform.Show
Read Events
Retu
*
Define Class ymenu_form As Form
	Height = 397
	Width = 818
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "A menu with icones with a scrollable container class"
	Name = "Form1"

	Add Object sbscrollcontainer1 As sbscrollcontainer With ;
		Top = 0, ;
		Left = 0, ;
		Width = 816, ;
		Height = 252, ;
		BorderWidth = 2, ;
		BackColor = Rgb(0,0,0), ;
		scrollbars = 1, ;
		scrollableheight = 0, ;
		Name = "Sbscrollcontainer1"

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	Do Case
	Case Lower(loObject.Name)=="img1"
		Messagebox("do something from "+loObject.Name,0+32+4096,'',1000)
*.......
	Otherwise
		Messagebox("do something from "+loObject.Name,0+32+4096,'',1000)

	Endcase
	Endproc

	Procedure my1
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	For i=1 To 6
		loObject.RotateFlip=i
	Endfor
	Endproc

	Procedure my2
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	loObject.RotateFlip=0
	Endproc


	Procedure Resize
	With This.sbscrollcontainer1
		.Left=1
		.Top=1
		.Width=Thisform.Width-2
		.Refresh
	Endwith
	Endproc

	Procedure Init
	This.ShowTips=.T.
	Endproc

	Procedure sbscrollcontainer1.Init
	DoDefault()

	Local m.myrep
	m.yrep=Getdir("","folder of pngs images","Get folder with PNGs icons")&&PNGs folder
	If Empty(m.yrep)
		Return .F.
	Endi
	m.yrep=Addbs(m.yrep)

	Local m.xint
	m.xint=5
	Local m.gnbre
	gnbre=Adir(gabase,m.yrep+"*.png")   &&PNGs icons
*messagebox(trans(gnbre))
	If gnbre=0
		Return .F.
	Endi

	With This
		.ScrollBars=1   &&horizontal only
		Local m.xbackcolor    &&color theme here
		m.xbackcolor=Rgb(0,0,0)   && getcolor()
		.BackColor=m.xbackcolor
*local m.xpict
*	m.xpict="E:\____YMEDIA\BACKGROUND\FONDS_8.JPG"        &&getpict()   &&add a background container picture
*.picture=m.xpict
		.Scrollbarhorizontal1.Sbshape1.BackColor = m.xbackcolor
		.Height=85
		For i=1 To m.gnbre
			.AddObject("img"+Trans(i),"image")
			With Eval(".img"+Trans(i))
				.Top=4
				If i=1
					.Left=1
				Else
					.Left=Eval(".parent.img"+Trans(i-1)+".left")+Eval(".parent.img"+Trans(i-1)+".width")+m.xint
				Endi
				.Stretch=2
				.Width=64
				.Height=64
				.Picture=m.yrep+gabase(i,1)
				.MousePointer=15
				.ToolTipText=gabase(i,1)+"...[do action"+Trans(i)+"]"
				.Name="img"+Trans(i)
				.Visible=.T.
			Endwith
			Bindevent(Eval(".img"+Trans(i)),"mousedown",Thisform,"my")
			Bindevent(Eval(".img"+Trans(i)),"mouseEnter",Thisform,"my1")
			Bindevent(Eval(".img"+Trans(i)),"mouseLeave",Thisform,"my2")
		Endfor
		DoDefault()
		.scrollableheight=0
		.scrollableWidth=Eval(".img"+Trans(gnbre-1)+".left")+Eval(".img"+Trans(gnbre)+".width")+m.xint
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: ymenu_form

**************************************

*SPS vfpscroll class 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

Can customize colors and many properties directly on the PEM VFP sheet.

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

                    

*2* added on 31 may 2016
*a simple button on a top level form simulating a menu on a child form  --- A la Firefox style-

publi m.yrep

m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (m.yrep)

*first download the 7 png pictures used in code in source folder.
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName

Local lcDownloadUrl,lcDownloadLoc
For i=1 To 7
  Do Case
    Case i=1
      lcDownloadUrl ="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_7bc69e_19834-bubka-acrobat.png"
      lcDownloadLoc =m.yrep+"acrobat.png"

    Case i=2
      lcDownloadUrl = "http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_7482d8_adobe-pdf-reader.png"
      lcDownloadLoc =m.yrep+"adobe_pdf_reader.png"

    Case i=3
      lcDownloadUrl ="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_30d1cf_557447-elephant-128.png"
      lcDownloadLoc =m.yrep+"557447-elephant-128.png"

    Case i=4
      lcDownloadUrl="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_081ac2_books.png"
      lcDownloadLoc =m.yrep+"books.png"

    Case i=5
      lcDownloadUrl ="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_49f901_bug.png"
      lcDownloadLoc =m.yrep+"nug.png"
    Case i=6
      lcDownloadUrl ="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_dc86ab_print1png.png"
      lcDownloadLoc =m.yrep+"print1png.png"
    Case i=7
      lcDownloadUrl ="http://img.over-blog-kiwi.com/1/43/54/07/20160531/ob_c7ec7e_ymenu.png"
      lcDownloadLoc =m.yrep+"ymenu.png"

  Endcase
  lnResult = DeleteUrlCacheEntry(lcDownloadUrl)
  lnResult = URLDownloadToFile(0, lcDownloadUrl, lcDownloadLoc , 0,0)
  If lnResult = 0
    Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
    *Else
    *!*        Messagebox("Download fails")
  Endi
Endfor
Wait Clea


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

*
Define Class ybutton_special_menu As Form
  Top = 0
  Left = 0
  Height = 106
  Width = 294
  ShowWindow = 2
  Caption = "ybutton_special_menu"
  Name = "Form1"

  Add Object image1 As Image With ;
    Picture = "ymenu.png", ;
    Stretch = 0, ;
    Height = 32, ;
    Left = 24, ;
    MousePointer = 15, ;
    Top = 12, ;
    Width = 32, ;
    Name = "Image1"

  Procedure Destroy
    Clea Events
  Endproc

  Procedure Load
    _Screen.WindowState=1
  Endproc

  Procedure image1.Click
    *do form ybutton_menu1 with this.left+this.width+2,this.top
    Local oform
    oform=Newobject("ybutton_special_menu1","","",Thisform.Left+This.Left+Sysmetric(3)+This.Width+2,Thisform.Top+This.Top+Sysmetric(9)+Sysmetric(4))
    oform.Show
  Endproc

Enddefine
*
*-- EndDefine: ybutton_special_menu

*
Define Class ybutton_special_menu1 As Form
  BorderStyle = 0
  Top = 2
  Left = 52
  Height = 375
  Width = 584
  Desktop = .T.
  ShowWindow = 1
  Caption = ""
  ControlBox = .T.
  MaxButton = .F.
  MinButton = .F.
  Movable = .F.
  TitleBar = 0
  WindowType = 1
  BackColor = Rgb(0,0,0)
  xheight = .F.
  Name = "ymenu"

  Add Object image1 As Image With ;
    Picture = "books.png",;
    Height = 128,;
    Left = 12,;
    Top = 49,;
    Width = 128,;
    Name = "Image1"

  Add Object image2 As Image With ;
    Picture = "557447-elephant-128.png",;
    Height = 128,;
    Left = 203,;
    Top = 49,;
    Width = 128,;
    Name = "Image2"

  *
  Add Object image3 As Image With ;
    Picture = "print1png.png", ;
    Height = 128, ;
    Left = 394, ;
    Top = 49, ;
    Width = 128, ;
    Name = "Image3"

  Add Object image4 As Image With ;
    Picture = "bug.png", ;
    Height = 128, ;
    Left = 10, ;
    Top = 202, ;
    Width = 128, ;
    Name = "Image4"

  Add Object image5 As Image With ;
    Picture = "19834-bubka-acrobat.png", ;
    Height = 128, ;
    Left = 203, ;
    Top = 202, ;
    Width = 128, ;
    Name = "Image5"


  Add Object image6 As Image With ;
    Picture = "adobe_pdf_reader.png", ;
    Height = 128, ;
    Left = 392, ;
    Top = 205, ;
    Width = 128, ;
    Name = "Image6"

  Add Object label1 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontSize = 20, ;
    BackStyle = 0, ;
    Caption = "X", ;
    Height = 35, ;
    Left = 554, ;
    MousePointer = 15, ;
    Top = 4, ;
    Width = 20, ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Label1"

  Add Object label2 As Label With ;
    FontBold = .T., ;
    FontName = "Segoe Script", ;
    FontSize = 20, ;
    Alignment = 2, ;
    BackStyle = 0, ;
    Caption = "A Special menu", ;
    Height = 37, ;
    Left = 83, ;
    Top = -3, ;
    Width = 396, ;
    ForeColor = Rgb(255,255,0), ;
    Name = "Label2"

  Add Object label3 As Label With ;
    FontBold = .T., ;
    FontName = "Segoe Script", ;
    FontSize = 16, ;
    Alignment = 2, ;
    BackStyle = 0, ;
    Caption = "", ;
    Height = 37, ;
    Left = 87, ;
    Top = 340, ;
    Width = 396, ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Label3"

  Procedure my
    Lparameters nButton, nShift, nXCoord, nYCoord
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]

    Messagebox(loObject.Name+" do something here..",0+32+4096,"",1000)
    Thisform.Release
  Endproc

  Procedure my1
    Lparameters nButton, nShift, nXCoord, nYCoord
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    With loObject
      .Left=.Left-2
      .Top=.Top-2
      .BorderStyle=1
    Endwith
    Thisform.label3.Caption=loObject.Name+"...do something when click"
  Endproc

  Procedure my2
    Lparameters nButton, nShift, nXCoord, nYCoord
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    With loObject
      .Left=.Left+2
      .Top=.Top+2
      .BorderStyle=0
    Endwith
    Thisform.label3.Caption=""
  Endproc

  Procedure Init
    Lparameters x,Y
    If !Pcount()=2
      Return .F.
    Endi
    With This
      .xheight=.Height
      .Left=x
      .Top=Y+20
      .Height=20
      .SetAll("Mousepointer",15,"image")
      For i=1 To .ControlCount
        If Lower( .Controls(i).Class)=="image"
          Bindevent(.Controls(i),"mousedown",Thisform,"my")
          Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
          Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
        Endi
      Endfor
    Endwith
  Endproc

  Procedure KeyPress
    Lparameters nKeyCode, nShiftAltCtrl
    If nKeyCode=27
      Thisform.Release
    Endi
  Endproc

  Procedure Activate
    Local m.delta
    m.delta=50
    With Thisform
      Do While .Height<=.xheight
        .Height=.Height+m.delta
        Inkey(0.05)
      Enddo
      .Height=.xheight
    Endwith
  Endproc

  Procedure label1.Click
    Thisform.Release
  Endproc

Enddefine
*
*-- EndDefine: ybutton_special_menu1