Scrolling vfp containers with FlatScrollbar activeX

Published on by Yousfi Benameur


i was surprised by an old microsoft scrollbar shipped with vfp as activex (olecontrol).i project to make it in use.
in preview posts i have presented 2 scrollbars classes  for vfp containers (from SPS and kirov sites) (see links below the page).
The FlatScrollBar control is a mouse-sensitive version of the standard Windows scroll bar that offers two-dimensional formatting options.
The FlatScrollBar provides increased interactivity when using vfp containers.
the FlatScrollBar has three Appearance styles: a standard style, a three-dimensional (beveled) style, and
a two-dimensional style that becomes beveled when the mouse pointer hovers over it

the demo code below builds:
-a container with vertical and horizontal scrollbars and with many objects in the scrollable area of the container.
-a scrolling region with an inside container (cntInside ) with a big image downloaded from the web(internet must be connected and some fast).
i added a grid, a listbox and an editbox to diversify objects.

-what is good is the simplicity of this control (like a slider)
there is 2 methods (change and scroll) to make it working. of course properties must set before using(orientation,width,left,top,with,height,
smallChange,largeChange,value...and min and max).see in code.
the olescrollbar scale can be (min=0 and max=100% or absolute pixel value<=32000).
-fill the "cntInside"  container with custom  objects and set the scrollbars properties in setViewport method.
-better method to work with scrollbars is to use api to implement scrollH or scrollV.the sendmessage api and constants are used here.
the olescrollbar control have a builder (can set properties in a dialog...rightclick on and select assistant...).

*the big image is downloaded from the web.can use local image.

Notes: MSCOMCTL32 library must be redistributed to work with the flatscrollbar ole object.
      this code is rendered/tested on 32 pouces screen.

https://msdn.microsoft.com/en-us/library/aa276347(v=vs.60).aspx

Distribution Note The FlatScrollBar control is part of a group of ActiveX controls that are found in the MSCOMCT2.OCX file.
To use the FlatScrollBar control in your application, you must add the MSCOMCT2.OCX file to the project. When distributing
your application, install the MSCOMCT2.OCX file in the user's Microsoft Windows System or System32 directory.

[Post 244]


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


*1* created on thursday 23 of november 2017
*working with scrolling container of objects with the ole flatScrollbar "MSComCtl2.FlatScrollBar.2" of mscomctl32 library.
*
*test if mscomctl32 library exists on system otherwise cancel this code.
Local m.o,m.test
m.test=.F.
Try
	o=Newobject("MSComCtl2.FlatScrollBar.2")
	m.test=.T.
Catch
	m.test=.F.
Endtry
If m.test=.F.
	Messagebox("Mscomctl32 library have no longer on system....cancelling application!",16+4096)
	m.o=Null
	Return .F.
Endi
m.o=Null
*
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
*download a big  image from my blog used in code.nternet must be connected.
Local m.ydownl
m.ydownl=.T.  && make it false since  image downloaded for use
If m.ydownl=.T.
	Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
		Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
	lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20171123/ob_29d95d_taghit.jpg"
	lcDownloadLoc ="taghit.jpg"
	lnResult = DeleteUrlCacheEntry(lcDownloadURL)
	lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
	If lnResult = 0
		Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
		*Else
		*!*  Messagebox("Download fails")
	Endi
Endi
*

_Screen.WindowState=1
set curs off
_vfp.autoyield=.f.
Publi oform
oform=Newobject("yscroll")
oform.Show
Read Events
Retu

Define Class yscroll As Form
	Height = 625
	Width = 1040
	BorderStyle=0
	Closable=.F.
	MaxButton=.F.
	ShowWindow = 2
	AutoCenter = .T.
	ShowTips=.T.
	Caption = "scrolling any vfp container."
	Name = "form1"
	BackColor=Rgb(45,45,45)

	Add Object ycnt As cntscrollregion With ;
		Top = 15, ;
		Left = 15, ;
		Width = 900, ;
		Height = 500, ;
		borderwidth=3,;
		Name = "ycnt"

	Add Object check1 As Checkbox With ;
		anchor=768,;
		autosize=.T.,;
		Top = 560, ;
		Left = 432, ;
		Caption= " Mousewheel V ",;
		style=1,;
		value=1,;
		backcolor=Rgb(255,140,120),;
		specialEffect=2,;
		mousepointer=15,;
		fontbold=.T.,;
		Name = "Check1"

	Add Object ycom As ycom With;
		anchor=768,;
		left=1020-110  ,;
		top= 10 ,;
		name="ycom"

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

	Procedure check1.InteractiveChange()
		With Thisform.ycnt
			Do Case
				Case This.Value=1
					.mwV=1
					.mwH=0

				Case This.Value=0
					.mwV=0
					.mwH=1
			Endcase
			This.BackColor=Iif(This.Value=1,Rgb(255,140,120),Rgb(0,255,0))
			This.Caption=Iif(This.Value=1," Mousewheel V "," Mousewheel H ")
		Endwith
	Endproc

	Procedure Load
		Declare Integer SendMessage In user32;
			INTEGER HWnd,;
			INTEGER Msg,;
			INTEGER wParam,;
			INTEGER Lparam

		Declare Integer Sleep In kernel32 Integer
	
		Close Data All
	Endproc

	Procedure Init
		DoDefault()
		This.check1.Left=(This.ycnt.Width-This.check1.Width)/2
	Endproc

Enddefine
*
*scrolling region container embedding the cntinside container and olescrollbars (V,H)
Define Class cntscrollregion As Container
	Width = 820
	Height = 600
	BorderWidth = 0
	BackColor=Rgb(153,217,234)
	BackStyle=1
	Name = "cntscrollregion"
	gnScrollValue=0
	mwV=1
	mwH=0

	Add Object cntInside As cntInside With ;
		Left = 0, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		TabIndex = 3, ;
		Name = "cntInside"

	Add Object olescrollBarH As OleControl With ;
		oleclass="MSComCtl2.FlatScrollBar.2", ;
		Top = 0, ;
		Left = 432, ;
		Height = 198, ;
		Width = 17, ;
		Visible = .T., ;
		TabIndex = 1, ;
		Name = "oleScrollBarH"

	Add Object olescrollBarV As OleControl With ;
		oleclass="MSComCtl2.FlatScrollBar.2", ;
		Top = 0, ;
		Left = 432, ;
		Height = 198, ;
		Width = 17, ;
		Visible = .T., ;
		TabIndex = 2, ;
		Name = "oleScrollBarV"

	Procedure Init
		With  This
			.AddProperty("gnScrollValue",0)
			.gnScrollValue = 0
			.SetViewPort()
		Endwith

	Endproc

	*-- Specifies the ViewPortLeft and ViewPortTop properties for a form.
	Procedure SetViewPort
		*-- Set up the olescrollbarH
		With This.olescrollBarH
			.appearance=0
			.Orientation=1
			.arrows=0
			.Height =17
			.Left = This.Left -15
			.Top = This.Height-.Height +18
			.Width=This.Width
			.Min = 0
			.Max =Max(0,(This.cntInside.Width -This.Width) + 20)
			.SmallChange = 20
			.LargeChange = This.Width- 20
			.Value =This.gnScrollValue
			.Refresh
			.Visible = .T.
		Endwith

		*-- Set up the olescrollbarV
		With This.olescrollBarV
			.appearance=0
			.Orientation=0
			.arrows=0
			.Width=17
			.Left = This.Width - 18
			.Top = 0
			.Height =This.Height
			.Min = 0
			.Max =Max(0,(This.cntInside.Height - This.Height) + 20)
			.SmallChange = 20
			.LargeChange = This.Height - 20
			.Value =This.gnScrollValue
			.Refresh
			.Visible = .T.
		Endwith

	Endproc

	*-- Releases all controls within the pane container
	Procedure Clear
		This.cntInside.Clear()
	Endproc

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		Do Case
			Case This.mwV=1
				This.mwH=0
				#Define WM_VSCROLL  0x0115
				#Define WM_HSCROLL  0x0114
				#Define  SB_LINEUP  0
				#Define  SB_LINEDOWN 1
				If nDirection>0
					=SendMessage(This.olescrollBarV.HWnd, WM_VSCROLL, SB_LINEUP, 0)
					=SendMessage(This.olescrollBarV.HWnd, WM_VSCROLL, SB_LINEUP, 0)
					
				Else
					=SendMessage(This.olescrollBarV.HWnd, WM_VSCROLL, SB_LINEDOWN, 0)   &&vertical
					=SendMessage(This.olescrollBarV.HWnd, WM_VSCROLL, SB_LINEDOWN, 0)
				Endi
				This.olescrollBarV.Change()

			Case This.mwH=1
				This.mwV=0
				If nDirection>0
					=SendMessage(This.olescrollBarH.HWnd, WM_HSCROLL, SB_LINEDOWN, 0)   &&horizontal
					=SendMessage(This.olescrollBarH.HWnd, WM_HSCROLL, SB_LINEDOWN, 0)
				Else
					=SendMessage(This.olescrollBarH.HWnd, WM_HSCROLL, SB_LINEUP, 0)
					=SendMessage(This.olescrollBarH.HWnd, WM_HSCROLL, SB_LINEUP, 0)
				Endi
				This.olescrollBarH.Change()
		Endcase
	Endproc

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

	Procedure olescrollBarV.Refresh
		*** ActiveX Control Method ***
		This.Change()
	Endproc

	Procedure olescrollBarH.Refresh
		*** ActiveX Control Method ***
		This.Change()
	Endproc

	Procedure olescrollBarV.Change
		*** ActiveX Control Event ***
		This.Parent.gnScrollValue = This.Value
		This.Parent.cntInside.Top = -This.Parent.gnScrollValue
	Endproc

	Procedure olescrollBarH.Change
		*** ActiveX Control Event ***
		This.Parent.gnScrollValue = This.Value
		This.Parent.cntInside.Left = -This.Parent.gnScrollValue
	Endproc

Enddefine
*
*-- EndDefine: cntscrollregion
*
*here the cntInside container where the user fill with objetcs to scroll (H or V)
Define Class cntInside As Container
	Top=0
	Left=0
	Width = 2500
	Height = 2200
	BorderWidth = 0
	Name = "cntInside"
	*
	*fill container  with objects...hereone image.
	Add Object image1 As Image With ;
		top=1,;
		left=1,;
		width=1000,;
		height=1700,;
		stretch=0,;
		picture="taghit.jpg"  &&getpict() for local image
	Name="image1"

	Add Object edit1 As EditBox With ;
		left=450,;
		top=50,;
		width=400,;
		height=400,;
		scrollbars=0,;
		forecolor=Rgb(128,0,64),;
		fontbold=.T.,;
		scrollbars=0,;
		borderstyle=0,;
		backstyle=0,;
		fontname="script",;
		fontsize=14,;
		name="edit1"

	Add Object list1 As ListBox With ;
		Height = 285, ;
		Left = 516, ;
		Top = 429, ;
		Width = 145, ;
		Name = "List1"

	Add Object grid1 As Grid With ;
		Height = 133, ;
		Left = 100, ;
		Top = 369, ;
		Width = 349, ;
		Name = "Grid1"

	Procedure edit1.Init
		With This
			.Top=.Parent.image1.Top+.Parent.image1.Height+40

			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
		Endwith
	Endproc

	Procedure grid1.Init
		Sele address From Home(1)+"samples\data\customer" Into Cursor ycurs1
		With This
			.RecordSource=""
			.RecordSource="ycurs1"
			.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 list1.Init
		Sele company From Home(1)+'samples\data\customer' Into Cursor lcurs
		With This
			.RowSource="lcurs"
			.RowSourceType=2
			.SelectedItemBackColor=Rgb(70,60,50)
			.SelectedItemForeColor=Rgb(10,191,160)
			.SpecialEffect=1
			.FontSize=8
			.ItemBackColor=Rgb(40,40,40)
			.ItemForeColor=Rgb(255,204,153)
			.BorderColor=Rgb(235,132,0)
			.ItemTips=.T.
			.MousePointer=15
			.ListIndex=1
			.Top=.Parent.edit1.Top+.Parent.edit1.Height+10
		Endwith
	Endproc

	Procedure Init
		DoDefault()
		With This
			.BackColor=Rgb(153,217,234)
			.BackStyle=1
		Endwith
	Endproc

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

	*-- Releases all controls
	Procedure Clear
		lnControlCount = This.ControlCount
		For i = 1 To lnControlCount
			This.RemoveObject(This.Controls(1).Name)
		Endfor
	Endproc

	Procedure Destroy
		oform=Null
		Release oform
		Clea Events
	Endproc

Enddefine
*
*command commandGroup container class
Define Class ycom As CommandGroup
	AutoSize = .T.
	ButtonCount = 11
	BackStyle = 0
	BorderStyle = 1
	Value = 1
	Height = 240
	Left = 798
	SpecialEffect = 0
	Top = 1
	Width = 94
	Name = "Commandgroup1"
	Command1.Top = 5
	Command1.Left = 5
	Command1.Height = 27
	Command1.Width = 84
	Command1.Caption = "Summary help"
	Command1.Name = "Command1"
	Command2.Top = 34
	Command2.Left = 5
	Command2.Height = 27
	Command2.Width = 84
	Command2.Caption = "MSDN help"
	Command2.Name = "Command2"
	Command3.Top = 63
	Command3.Left = 5
	Command3.Height = 27
	Command3.Width = 84
	Command3.Caption = "scrollH visibility"
	Command3.Name = "Command3"
	Command4.Top = 92
	Command4.Left = 5
	Command4.Height = 27
	Command4.Width = 84
	Command4.Caption = "ScrollV visibility"
	Command4.Name = "Command4"
	Command5.Top = 121
	Command5.Left = 5
	Command5.Height = 27
	Command5.Width = 84
	Command5.Caption = "ScrollV down"
	Command5.Name = "Command5"
	Command6.Top = 150
	Command6.Left = 5
	Command6.Height = 27
	Command6.Width = 84
	Command6.Caption = "ScrollV up"
	Command6.Name = "Command6"
	Command7.Top = 179
	Command7.Left = 5
	Command7.Height = 27
	Command7.Width = 84
	Command7.Caption = "Arrows"
	Command7.Name = "Command7"
	Command8.Top = 208
	Command8.Left = 5
	Command8.Height = 27
	Command8.Width = 84
	Command8.Caption = "Appearance"
	Command8.Name = "Command8"
	Command9.Top = 236
	Command9.Left = 5
	Command9.Height = 27
	Command9.Width = 84
	Command9.Caption = "ScrollH left"
	Command9.Name = "Command9"
	Command10.Top = 264
	Command10.Left = 5
	Command10.Height = 27
	Command10.Width = 84
	Command10.Caption = "ScrollH right"
	Command10.Name = "Command10"
	Command11.Top = 264+27+1
	Command11.Left = 5
	Command11.Height = 27
	Command11.Width = 84
	Command11.fontbold=.t.
	Command11.forecolor=255
	Command11.Caption = "Exit"
	Command11.Name = "Command11"

	Procedure Init
		With This
			.AutoSize=.T.
			.Left=.Parent.Width-.Width-25
			.SetAll("Backcolor",Rgb(0,255,0))
			.SetAll("mousepointer",15)
			.SetAll("width",100)
			.SetAll("specialeffect",2)
		Endwith
	Endproc

	Procedure Command1.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
i was surprised by an old microsoft scrollbar shipped with vfp as activex (olecontrol). i project to make it in use.
in preview posts i have presented 2 scrollbars classes  for vfp containers (from SPS and kirov sites).
The FlatScrollBar control is a mouse-sensitive version of the standard Windows scroll bar that offers two-dimensional formatting options.
The FlatScrollBar provides increased interactivity when using vfp containers.
the FlatScrollBar has three Appearance styles: a standard style, a three-dimensional (beveled) style, and a two-dimensional style that becomes beveled when the mouse pointer hovers over it.

the demo code below builds:
-a container with vertical and horizontal scrollbars and with many objects in the scrollable area of the container.
-a scrolling region with an inside container (cntInside ) with a big image downloaded from the web(internet must be connected and some fast).
i added in this cntInside container a grid, a listbox and an editbox to diversify objects.

-what is good is the simplicity of this control (like a slider)
there is 2 methods (change and scroll) to make it working. 
Of course properties must set before  using(orientation,width,left,top,with,height,smallChange, largeChange,value...and min and max).see in code.
the olescrollbar scale can be (min=0 and max=100% or absolute pixel value<=32767).Be care to set scrollbars and to make them appear around the container to scroll.
-fill the "cntInside"  container with custom  objects and set the scrollbars properties in setViewport method.
-better method to work with scrollbars is to use api to implement scrollH or scrollV.the sendmessage api and constants are used here.
the olescrollbar control have a builder (can set properties in a dialog...rightclick on and select assistant...see photo below).

*the big image is downloaded from the web (internet connected and fast).can use local image.
Notes: MSCOMCTL32 library must be redistributed to work with the flatscrollbar ole object.
      this code is rendered/tested on 32 pouces screen.
		ENDTEXT
		Local oshell
		oshell = Createobject('WScript.Shell')
		oshell.Popup(m.myvar,0, 'Summary help launched from web to vfp', 0+32+4096)  &&4,16,48,64...
		oshell=Null
	Endproc

	Procedure Command2.Click
		Local o
		o=Newobject("hyperlink")
		o.NavigateTo("https://msdn.microsoft.com/en-us/library/aa231260(v=vs.60).aspx")
		o=Null
	Endproc

	Procedure Command3.Click
		With Thisform.ycnt.olescrollBarH
			.Visible=!.Visible
			DoEvents
		Endwith
	Endproc

	Procedure Command4.Click
		With Thisform.ycnt.olescrollBarV
			.Visible=!.Visible
			DoEvents
		Endwith
	Endproc

	Procedure Command5.Click
		#Define WM_VSCROLL  0x0115
		#Define WM_HSCROLL  0x0114
		#Define  SB_LINEDOWN 1
		#Define  SB_LINEUP  0

		With Thisform.ycnt.olescrollBarV
			.Change()   &&give focus
			For i=.Value To .Max
				=SendMessage(.HWnd, WM_VSCROLL, SB_LINEDOWN, 0)
				=SendMessage(.HWnd, WM_VSCROLL, SB_LINEDOWN, 0)
				.Change()
			Endfor
		Endwith
	Endproc

	Procedure Command6.Click
		#Define WM_VSCROLL  0x0115
		#Define WM_HSCROLL  0x0114
		#Define  SB_LINEDOWN 1
		#Define  SB_LINEUP  0

		With Thisform.ycnt.olescrollBarV
			.Change()   &&give focus
			For i=.Value To .Min Step-1
				=SendMessage(.HWnd, WM_VSCROLL, SB_LINEUP, 0)
				=SendMessage(.HWnd, WM_VSCROLL, SB_LINEUP, 0)
				.Change()
			Endfor
		Endwith
	Endproc

	Procedure Command7.Click
		With Thisform.ycnt.olescrollBarH
			Try
				.arrows=.arrows+1
			Catch
				.arrows=0
			Endtry
		Endwith

		With Thisform.ycnt.olescrollBarV
			Try
				.arrows=.arrows+1
			Catch
				.arrows=0
			Endtry
		Endwith

		DoEvents
	Endproc

	Procedure Command8.Click
		With Thisform.ycnt.olescrollBarH
			Try
				.appearance=.appearance+1
			Catch
				.appearance=0
			Endtry
		Endwith

		With Thisform.ycnt.olescrollBarV
			Try
				.appearance=.appearance+1
			Catch
				.appearance=0
			Endtry
		Endwith

		DoEvents
	Endproc

	Procedure Command9.Click
		#Define WM_VSCROLL  0x0115
		#Define WM_HSCROLL  0x0114
		#Define  SB_LINEDOWN 1
		#Define  SB_LINEUP  0

		With Thisform.ycnt.olescrollBarH
			.Change()   &&give focus
			For i=.Value To .Min Step-1
				=SendMessage(.HWnd, WM_HSCROLL, SB_LINEUP, 0)
				=SendMessage(.HWnd, WM_HSCROLL, SB_LINEUP, 0)
				.Change()
			Endfor
		Endwith
	Endproc

	Procedure Command10.Click
		#Define WM_VSCROLL  0x0115
		#Define WM_HSCROLL  0x0114
		#Define  SB_LINEDOWN 1
		#Define  SB_LINEUP  0

		With Thisform.ycnt.olescrollBarH
			.Change()   &&give focus
			For i=.Value To .Max
				=SendMessage(.HWnd, WM_HSCROLL, SB_LINEDOWN, 0)
				=SendMessage(.HWnd, WM_HSCROLL, SB_LINEDOWN, 0)
				.Change()
			Endfor
		Endwith
	Endproc

	Procedure Command11.Click
		oform=Null
		Thisform.Release
	Endproc
Enddefine
*
*-- EndDefine: ycom
*

A complet demo how to use flatScrollbar V & H on any vfp  container
A complet demo how to use flatScrollbar V & H on any vfp  container
A complet demo how to use flatScrollbar V & H on any vfp  container

A complet demo how to use flatScrollbar V & H on any vfp container

embed the comctl32 library  on vfp object explorer and see the flatscrollbar  PEM.
embed the comctl32 library  on vfp object explorer and see the flatscrollbar  PEM.

embed the comctl32 library on vfp object explorer and see the flatscrollbar PEM.

Important:All Codes above are tested on VFP9SP2 , windows 10 pro version 1703 .Comctl32 library must exits on system.

To be informed of the latest articles, subscribe:
Comment on this post