A navBar (navigation bar) vfp class part1

Published on by Yousfi Benameur


The original class was downloaded from UT , adapted ,and added some requirements.
*Original Author : Galanopoulos Emmanouil
Its a great class i  not seen in vfp namespace as equal in the same subject.
this works as a sidebar or navigation bar embedding a complet menu ( as mnx mandatory here).
the menu can be customized by user (vfp menu designer) and the class does the rest.
It can works inside vfp with showWIndow=0,1 or as application  desktop (shoWindow=2).
can enable vertical scroll with (form.scrollbars=2 ) but this is needed on particular cases when the container number items are great.

Some limitations:
menu accepts commands only (no procedure, no submenu).menu are mono items.
to avoid this i wrote some procedures called by the menu as command but in form class.
collapse/expand (at left screen/desktop or right).i made the form to  move by mousedown on.collapsing is in principe for the navbar at screen left.be aware if you move the navbar you collapse the form but inside the screen/desktop.
form navbar can be showindow=0,1 or 2 (its a form) set at design time (readonly at runtime)
form scrollbars can be set to 0 or 2 (vertical) at design time (readonly at runtime)-
on need the form scrollbar appear at form right(if form.scrollbars=2).this can be used only if the containers count is great.
otherwise can navigate only with headers (accordion).

-no mpr but mnx to work.
-on rightclick on form...inbuilt submenu (hide or close).
-move the form by mousedown (if needed only)
-accepts picture background and headers.accepts icons in menu item (menu designer).
-can stylize with other pictures than native(gradients bmps...).i added  2*10 images styles built with previous gradients posts.

Important: the code below must work with images and custom menu mandatory.all is the below zip to  download and run ynavbar.prg.Can compile an exe with the project attached(add a config.fpw file)
*Note: simple navbar.downloaded from https://www.levelextreme.com/ShowHeaderDownloadOneItem.aspx?ID=37303

Yousfi Benameur  El Bayadh saturday 29 of april 2017

[Post 230]


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

                

*1*
* original Navigation Bar downloaded from UT
* Author : Galanopoulos Emmanouil - Owl_portf@yahoo.com
* www.CurioSoftware.gr - Info@Curiosoftware.gr
* License : Freeware

Clea All
Close All
Close Data All
Set Default To  Addbs(Justpath(Sys(16,1)))  &&(application.ActiveProject.HomeDir)

Set Path To .\Sample,.\bitmaps,\bitmaps\styles
*set Class to navbar

Public navbar
navbar=Createobject("NavBar")

* Optional Settings
*******************************************
navbar.GroupExpandType=1 && 1=Animated , 0=Not Animated
navbar.GroupSpace=5      && Space in pixels between NavBar Groups
navbar.SideMargin=10     && Side Margin in pixels for NavBar Groups
navbar.TopMargin=10      && Top Margin in pixels for NavBar Groups
navbar.Width=200

* MenuFile to convert to Navigation Bar
*******************************************
with navbar
.MenuFile=".\Sample\Sample"   &&here is the use custom menu file as mnx(it used as table in code)
.TitleBar=1
.InitNavBar()
.TitleBar=0
.ycollapse()
.ScrollBars=0   &&2 if too containers
endwith
Bindevent(_Screen,"resize",navbar,"resize")

If navbar.ShowWindow=0  &&0,1,2  0,1 for vfp environment screen  2 for desktop app
	_Screen.WindowState=1
Endi
Read Events
Retu


*below is the complet class with some adds
*user have just to build the custom menu for navigation.

Define Class groupitem_footer As Container
	Width = 169
	Height = 8
	BackStyle = 0
	BorderWidth = 0
	itemorder = .F.
	Name = "groupitem_footer"

	Add Object imgbackgroundc1 As Image With ;
		Picture = "bitmaps\navbaritem_footerc1.bmp", ;
		Height = 4, ;
		Left = 0, ;
		Top = 0, ;
		Width = 27, ;
		Name = "imgBackgroundC1"

	Add Object imgbackgroundc2 As Image With ;
		Anchor = 10, ;
		Picture = "bitmaps\navbaritem_footerc2.bmp", ;
		Stretch = 2, ;
		Height = 4, ;
		Left = 27, ;
		Top = 0, ;
		Width = 134, ;
		Name = "imgBackgroundC2"

	Add Object imgbackgroundc3 As Image With ;
		Anchor = 8, ;
		Picture = "bitmaps\navbaritem_footerc3.bmp", ;
		Height = 4, ;
		Left = 161, ;
		Top = 0, ;
		Width = 8, ;
		Name = "imgBackgroundC3"

Enddefine
*
*-- EndDefine: groupitem_footer

*
Define Class groupitem_label As Container
	Width = 169
	Height = 23
	itemorder = 0
	Command = .F.
	Name = "groupitem_label"

	Add Object imgbackgroundc2 As Image With ;
		Anchor = 10, ;
		Picture = "bitmaps\navbaritem_labelc2.bmp", ;
		Stretch = 2, ;
		Height = 27, ;
		Left = 26, ;
		Top = 0, ;
		Width = 135, ;
		Name = "imgBackgroundC2"

	Add Object imgbackgroundc1 As Image With ;
		Picture = "bitmaps\navbaritem_labelc1.bmp", ;
		Height = 27, ;
		Left = 0, ;
		Top = 0, ;
		Width = 27, ;
		Name = "imgBackgroundC1"

	Add Object imgbackgroundc3 As Image With ;
		Anchor = 8, ;
		Picture = "bitmaps\navbaritem_labelc3.bmp", ;
		Height = 27, ;
		Left = 161, ;
		Top = 0, ;
		Width = 8, ;
		Name = "imgBackgroundC3"

	Add Object shape1 As Shape With ;
		Top = 3, ;
		Left = 28, ;
		Height = 19, ;
		Width = 137, ;
		Anchor = 10, ;
		BackStyle = 1, ;
		FillStyle = 0, ;
		Visible = .F., ;
		FillColor = Rgb(150,150,150), ;
		BorderColor = Rgb(100,100,100), ;
		Name = "Shape1"

	Add Object label1 As Label With ;
		FontName = "MS Sans Serif", ;
		Anchor = 10, ;
		BackStyle = 0, ;
		Caption = "Label1", ;
		Height = 17, ;
		Left = 33, ;
		MousePointer = 15, ;
		Top = 6, ;
		Width = 128, ;
		Name = "Label1"

	Add Object imgicon1 As Image With ;
		BackStyle = 0, ;
		Height = 16, ;
		Left = 5, ;
		Top = 5, ;
		Visible = .F., ;
		Width = 16, ;
		Name = "imgIcon1"

	Procedure label1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.ForeColor=Rgb(255,255,255)
	This.Parent.shape1.Visible=.T.
	Endproc

	Procedure label1.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.ForeColor=Rgb(0,0,0)
	This.Parent.shape1.Visible=.F.
	Endproc

	Procedure label1.Click
	Execscript(This.Parent.Command)
	Endproc

Enddefine
*
*-- EndDefine: groupitem_label

*
Define Class groupitem_seperator As Container
	Width = 169
	Height = 12
	BackStyle = 0
	BorderWidth = 0
	itemorder = 0
	Name = "groupitem_seperator"

	Add Object imgbackgroundc1 As Image With ;
		Picture = "bitmaps\navbaritem_labelc1.bmp", ;
		Height = 27, ;
		Left = 0, ;
		Top = 0, ;
		Width = 27, ;
		Name = "imgBackgroundC1"

	Add Object imgbackgroundc2 As Image With ;
		Anchor = 10, ;
		Picture = "bitmaps\navbaritem_labelc2.bmp", ;
		Stretch = 2, ;
		Height = 27, ;
		Left = 27, ;
		Top = 0, ;
		Width = 134, ;
		Name = "imgBackgroundC2"

	Add Object imgbackgroundc3 As Image With ;
		Anchor = 8, ;
		Picture = "bitmaps\navbaritem_labelc3.bmp", ;
		Height = 27, ;
		Left = 161, ;
		Top = 0, ;
		Width = 8, ;
		Name = "imgBackgroundC3"

	Add Object line1 As Line With ;
		Anchor = 10, ;
		Height = 0, ;
		Left = 33, ;
		Top = 6, ;
		Width = 128, ;
		Name = "Line1"

Enddefine
*
*-- EndDefine: groupitem_seperator
*
Define Class navbar As Form
	BorderStyle = 0
	Top = 0
	Left = 0
	Height = 700
	Width = 230
	ShowWindow = 2
	DoCreate = .T.
	Picture = "bitmaps\styles\v9.jpg"
	Caption = "Form"
	TitleBar = 0
	AlwaysOnTop = .T.
*-- DockSide L=Left,R=Right
	dockside = "L"
	normalwidth = 0
	TopMargin = 10
	SideMargin = 10
	GroupSpace = 5
*-- 0=Instant Expand/Collapse, 1=Animated Expand/Collapse
	GroupExpandType = 1
	navbarposy = -1
	MenuFile = .F.
	ycount = 0
	ScrollBars=2
	Name = "navbar"

	Add Object groupcontainer As yGroupContainer With ;
		Top = 40, ;
		Left = 0, ;
		Width = 220, ;
		Height = 400, ;
		BackStyle = 0, ;
		Name = "GroupContainer"

	Add Object splittercontainer As ysplittercontainer With ;
		Top = 28, ;
		Left = 219, ;
		Width = 12, ;
		Height = 406, ;
		BackStyle = 0, ;
		Name = "SplitterContainer"

	Procedure groupposition
	ntop=This.TopMargin
	nWidth=This.Width-(This.SideMargin*2)-This.splittercontainer.Width
	For N=1 To This.oGroup.Count
		This.oGroup.Item[n].Top=ntop
		This.oGroup.Item[n].Left=This.SideMargin
		This.oGroup.Item[n].Width=nWidth
		ntop=ntop+This.oGroup.Item[n].Height+This.GroupSpace
		This.oGroup.Item[n].Anchor=10
	Endfor
	This.groupcontainer.Height=ntop
	Endproc

	Procedure groupvposition
* Group Vertical Position
	ntop=This.TopMargin
	For N=1 To This.oGroup.Count
		This.oGroup.Item[n].Top=ntop
		ntop=ntop+This.oGroup.Item[n].Height+This.GroupSpace
	Endfor
	This.groupcontainer.Height=ntop
	Endproc

	Procedure InitNavBar
* NavBar
	This.menutonavbar()
	This.Top=0
	This.Left=Iif(This.dockside="L",0,_Screen.Width-This.normalwidth)
	If Thisform.ShowWindow=2
		This.Height=Sysmetric(2)-50
	Else
		This.Height=_Screen.Height
	Endi
	This.normalwidth=This.Width
	This.BackColor=Rgb(240,240,240)

	With This.splittercontainer
		.command1.Top=-1
		.command1.Width=14
		.command1.Left=-1
		.command1.Height=This.Height+2
		.command1.Anchor=13
		.Top=0
		.Width=12
		.Left=This.Width-This.splittercontainer.Width
		.Height=This.Height
		.BorderWidth=0
		.Anchor=13
	Endwith

	With This.groupcontainer
		.BorderWidth=0
		.Left=0
		.Top=0
		.Width=This.Width-This.splittercontainer.Width
		.Anchor=10
	Endwith
* Navigation Bar Groups

	Thisform.AddObject("oGroup","Collection")
	For N=1 To This.groupcontainer.ControlCount
		For n1=1 To This.groupcontainer.ControlCount
			If Lower(This.groupcontainer.Controls(n1).Class)="navbar_group" And This.groupcontainer.Controls(n1).GroupOrder=N
				Thisform.oGroup.Add(This.groupcontainer.Controls(n1))
				Exit
			Endif
		Endfor
	Endfor
	Thisform.groupposition()
	This.Visible=.T.
	This.splittercontainer.command1.SetFocus()
	Endproc

	Procedure menutonavbar
* Menu To NavBar
	This.MenuFile=This.MenuFile+".mnx"
	If File(This.MenuFile)=.F.
		Messagebox("Menu File Not Found")
		Return .F.
	Endif
	nItem=1
	nGroup=1
	Use (This.MenuFile) In 0 Again Shared Alias menutonavbar
	Select menutonavbar
	Scan
		If menutonavbar.objcode=77 And menutonavbar.LevelName="_MSYSMENU"
* Add NavBar Group
			cGroupName="NavBAr_Group"+Alltrim(Str(nGroup))
			This.groupcontainer.AddObject(cGroupName,"NavBar_Group")
			This.groupcontainer.&cGroupName..GroupOrder=nGroup
			This.groupcontainer.&cGroupName..header1.label1.Caption=menutonavbar.Prompt
			Skip
			nItem=1
			cLevelName=menutonavbar.LevelName
			Do While menutonavbar.LevelName=cLevelName
				Do Case
				Case menutonavbar.objcode=67 && Item
					cItemName="Item"+Alltrim(Str(nItem))
					This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Label")
					This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem
					This.groupcontainer.&cGroupName..&cItemName..label1.Caption=menutonavbar.Prompt
					This.groupcontainer.&cGroupName..&cItemName..Command=menutonavbar.Command
					If !Empty(menutonavbar.resname)
						This.groupcontainer.&cGroupName..&cItemName..imgicon1.Picture=menutonavbar.resname
						This.groupcontainer.&cGroupName..&cItemName..imgicon1.Visible=.T.
					Endif
					This.groupcontainer.&cGroupName..&cItemName..Visible=.T.
					nItem=nItem+1

				Case menutonavbar.objcode=78 && Seperator
					cItemName="Item"+Alltrim(Str(nItem))
					This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Seperator")
					This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem
					This.groupcontainer.&cGroupName..&cItemName..Visible=.T.
					nItem=nItem+1

				Endcase
				Skip
			Enddo
* Add Footer
			If nItem>1
				cItemName="Item"+Alltrim(Str(nItem))
				This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Footer")
				This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem
				This.groupcontainer.&cGroupName..&cItemName..Visible=.T.
			Endif
			This.groupcontainer.&cGroupName..InitGroup()
			nGroup=nGroup+1
			Skip -1
		Endif
	Endscan
	Use In menutonavbar
	Thisform.ycount=This.groupcontainer.ControlCount
	Endproc


	Procedure yhelp
	Local m.myvar
	TEXT to m.myvar pretext 7 noshow
	  
The original class was downloaded from UT , adapted ,and added some requirements.
*Author : Galanopoulos Emmanouil
Its a great class i  not seen in vfp namespace as equal in the same subject.
this works as a sidebar or navigation bar embedding a complet menu ( as mnx mandatory here).
the menu can be customized by user and the class does the rest.
It can works inside vfp with showWIndow=0,1 or as application  desktop (shoWindow=2).
can enable vertical scroll with (form.scrollbars=2 ) but this is needed on particular cases when the container number items are great.

Some limitations:
menu accepts commands only (no procedure, no submenu).menu are mono items
to avoid this i wrote some procedure called by the menu as command but in form class.
collapse/expand (at left screen/desktop or right).i made the form to  move by mousedown on.collapsing is in principe
for the for at screen left.be aware if you move the form you collapse th form but inside the screen.
form navbar can be showindow=0,1 or 2 (its a form). at design time 'readonly)
form scrollbars can be set to 0 or 2 (vertical) at design time (readonly at runtime)-
on need the form scrollbar appear at form right(if scrollbrs=2).this can be used only if the containers count is great.
otherwise can navigate only with headers.

no mpr but mnx to work.
on rightclick on form...inbuilt submenu (hide or close)
move the form by mousedown (if needed only)
accepts picture background
can stylize with other picture than native(gradients bmps...)i  added  10 images styles built with previous gradients posts.
the code below must work with images and custom menu manadatory.all is the below zip download.
Yousfi Benameur  El Bayadh saturday 29 of april 2017	
	ENDTEXT
	Local oshell
	oshell = Createobject('WScript.Shell')
	oshell.Popup(m.myvar,0, 'a Wscript.Shell big message', 0+32+4096)  &&4,16,48,64...
	oshell=Null
	Endproc

	Procedure ycollapse
	Try
		With navbar.groupcontainer
*.NavBAr_Group2.header1.shape1.click
			.NavBAr_Group2.header1.shape1.Click
			.NavBAr_Group3.header1.shape1.Click
			.NavBAr_Group4.header1.shape1.Click
		Endwith
	Catch
	Endtry
	Endproc

	Procedure ystyle
	Local m.x
	m.x=Int(Val(Inputbox("Apply style:0 native... 1-10","","1")))
	If ! Between(m.x,0,10)
		m.x=1
	Endi

	If  m.x=0
		For i=1 To Thisform.ycount
			m.y=Eval("navbar.GroupContainer.NavBAr_Group"+Trans(i)+".header1.imgHighLight")
			Y.Picture='bitmaps\navbarheader_highlight.bmp'
		Endfor
		Thisform.Picture="bitmaps\NavBarBackground.bmp"

	Else

		For i=1 To Thisform.ycount
			m.y=Eval("navbar.GroupContainer.NavBAr_Group"+Trans(i)+".header1.imgHighLight")
			Y.Picture='bitmaps\styles\h'+Trans(m.x)+'.jpg'
		Endfor
		Thisform.Picture='bitmaps\styles\v'+Trans(x)+".jpg"
	Endi
	Endproc

	Procedure Resize
	If Thisform.ShowWindow=2
		This.Height=Sysmetric(2)-50
		This.Height=_Screen.Height
	Endi
* NavBar
	If This.groupcontainer.Top<0 ;
			and This.groupcontainer.Height+This.groupcontainer.Top<This.Height
		This.groupcontainer.Top=Min(This.Height-This.groupcontainer.Height,0)
	Endif
	Endproc

	Procedure RightClick
	Define Popup shortcut shortcut Relative From Mrow(),Mcol()
	Define Bar 1 Of shortcut Prompt "Hide"
	Define Bar 2 Of shortcut Prompt "\-"
	Define Bar 3 Of shortcut Prompt "Close"
	On Selection Bar 1 Of shortcut navbar.splittercontainer.command1.Click()
	On Selection Bar 3 Of shortcut navbar.Release()
	Activate Popup shortcut
	Endproc

	Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Thisform.MousePointer=15
	lnHandle = Thisform.HWnd
	param1 = 274
	param2 = 0xF012
	Declare Integer ReleaseCapture In WIN32API
	Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
	Thisform.MousePointer=0
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: navbar
*
Define Class navbar_group As Container
	Width = 180
	Height = 180
	BackStyle = 0
	BorderWidth = 0
	GroupOrder = 0
	expandedheight = .F.
	Degrees = 80
	groupexpanded = .T.
	timerresizestep = .F.
	timerdone = .F.
	timerlock = .F.
	Name = "navbar_group"

	Add Object header1 As  yHeader1 With ;
		Top = 0, ;
		Left = 0, ;
		Width = 180, ;
		Height = 30, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "Header1"

	Add Object timer1 As Timer With ;
		Tag = "expanded", ;
		Top = 39, ;
		Left = 6, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Name = "Timer1"

	Procedure InitGroup
	With This.header1
		.Top=0
		.Left=0
		.Width=This.Width
		.Anchor=11
		.shape1.Top=4
		.shape1.Left=0
		.shape1.Width=This.header1.Width
		.shape1.Height=This.header1.Height-4
		.shape1.BorderStyle=0
		.shape1.Anchor=15
	Endwith

* Item Order
	This.AddObject("oItems","Collection")
	For N=1 To This.ControlCount
		For n1=1 To This.ControlCount
			If (Lower(This.Controls(n1).Class)="groupitem_label" ;
					or Lower(This.Controls(n1).Class)="groupitem_seperator" ;
					or Lower(This.Controls(n1).Class)="groupitem_footer") ;
					and This.Controls(n1).itemorder=N
				This.oItems.Add(This.Controls(n1))
				Exit
			Endif
		Endfor
	Endfor

* Item Position
	nHeight=This.header1.Height
	For N=1 To This.oItems.Count
		This.oItems.Item[n].Top=nHeight
		This.oItems.Item[n].Left=0
		This.oItems.Item[n].Width=This.Width
		This.oItems.Item[n].Anchor=10
		nHeight=nHeight+This.oItems.Item[n].Height
	Endfor

	This.Height=nHeight
	This.expandedheight=nHeight
	This.Visible=.T.
	Endproc

	Procedure paintbackground
	Endproc

	Procedure addgradient
	Endproc


	Procedure timer1.Init
	This.Parent.timerresizestep=16
	This.Interval=12
	Endproc

	Procedure timer1.Timer
* Expand / Collapse
	If This.Parent.timerdone=.F.
		If This.Parent.groupexpanded=.T.
* Collapse
			nHeight=This.Parent.Height-This.Parent.timerresizestep

			If This.Parent.Degrees>10 And This.Parent.Height<48+This.Parent.header1.Height
				This.Parent.Degrees=This.Parent.Degrees-5
				Max(This.Parent.Degrees,10)
				This.Parent.timerresizestep=Ceiling(4*(1-Cos(Dtor(This.Parent.Degrees))))
			Endif

			If nHeight<=This.Parent.header1.Height
				nHeight=This.Parent.header1.Height
				This.Parent.Degrees=80
				This.Parent.timerresizestep=16
				This.Parent.groupexpanded=.F.
				This.Parent.timerdone=.T.
				This.Enabled=.F.
			Endif
		Else
* Expand

			nHeight=This.Parent.Height+This.Parent.timerresizestep

			If This.Parent.Degrees>10 And This.Parent.Height>This.Parent.expandedheight-48
				This.Parent.Degrees=This.Parent.Degrees-5
				Max(This.Parent.Degrees,10)
				This.Parent.timerresizestep=Ceiling(4*(1-Cos(Dtor(This.Parent.Degrees))))
			Endif

			If nHeight>=This.Parent.expandedheight
				nHeight=This.Parent.expandedheight
				This.Parent.Degrees=80
				This.Parent.timerresizestep=16
				This.Parent.groupexpanded=.T.
				This.Parent.timerdone=.T.
				This.Enabled=.F.
			Endif
		Endif

		This.Parent.Height=nHeight
		Thisform.groupvposition()
	Endif
	Endproc

Enddefine
*
*-- EndDefine: navbar_group

Define Class yGroupContainer As Container
	Top = 40
	Left = 0
	Width = 220
	Height = 400
	BackStyle = 0
	Name = "yGroupContainer"

	Procedure MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	If This.Height>This.Parent.Height
		This.MousePointer=7
	Else
		This.MousePointer=0
	Endif
	Endproc

	Procedure MouseMove
	Lparameters nButton, nShift, nXCoord, nYCoord
	If This.Parent.navbarposy>-1 And Mrow(_Screen.Name,3)>0
		nNavBarTop=Mrow(_Screen.Name,3)-This.Parent.navbarposy
* Top Limit
		nNavBarTop=Min(nNavBarTop,0)

* Bottom Limit
		If This.Height>This.Parent.Height
			If This.Height+nNavBarTop<This.Parent.Height
				nNavBarTop=This.Parent.Height-This.Height
			Endif
		Endif

		This.Top=nNavBarTop
	Endif
	Endproc

	*!*Procedure RightClick
	*!*Do navbar.mpr
	*!*Endproc

	Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	If This.MousePointer=7 And nButton=1
		This.Parent.navbarposy=Mrow(Thisform.Name,3)-This.Top
	Endif
	Endproc

	Procedure MouseUp
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.Parent.navbarposy=-1
	Endproc
Enddefine
*-- EndDefine:yGroupContainer

Define Class ysplittercontainer As Container
	Add Object image1 As Image With ;
		Anchor = 15, ;
		Picture = "bitmaps\navbarsplitterc2.bmp", ;
		Stretch = 2, ;
		Height = 398, ;
		Left = 0, ;
		Top = 0, ;
		Width = 12, ;
		Name = "Image1"

	Add Object command1 As CommandButton With ;
		Top = 8, ;
		Left = 1, ;
		Height = 27, ;
		Width = 9, ;
		Caption = "Command1", ;
		Style = 1, ;
		TabStop = .F., ;
		Name = "Command1"

	Procedure command1.Click
	If This.Parent.Parent.Width>This.Parent.Width
		This.Parent.Parent.Width=This.Parent.Width
	Else
		This.Parent.Parent.Width=This.Parent.Parent.normalwidth
	Endif
	Endproc

Enddefine
*
*--EndDefine :ysplittercontainer

Define Class yHeader1 As Container
	Add Object imgbackgroundt2a As Image With ;
		Anchor = 10, ;
		Picture = "bitmaps\navbarheadert2.bmp", ;
		Stretch = 2, ;
		Height = 30, ;
		Left = 16, ;
		Top = 0, ;
		Width = 148, ;
		Name = "ImgBackgroundT2A"

	Add Object imgbackgroundt1a As Image With ;
		Anchor = 2, ;
		Picture = "bitmaps\navbarheadert1.bmp", ;
		Height = 30, ;
		Left = 0, ;
		Top = 0, ;
		Width = 16, ;
		Name = "ImgBackGroundT1A"

	Add Object imgbackgroundt3a As Image With ;
		Anchor = 8, ;
		Picture = "bitmaps\navbarheadert3.bmp", ;
		Height = 30, ;
		Left = 164, ;
		Top = 0, ;
		Width = 16, ;
		Name = "ImgBackGroundT3A"

	Add Object imghighlight As Image With ;
		Anchor = 15, ;
		Picture = "bitmaps\navbarheader_highlight.bmp", ;
		Stretch = 2, ;
		Height = 30, ;
		Left = 1, ;
		Top = 0, ;
		Visible = .F., ;
		Width = 178, ;
		Name = "ImgHighLight"

	Add Object label1 As Label With ;
		FontBold = .T., ;
		FontName = "MS Sans Serif", ;
		BackStyle = 0, ;
		Caption = "Label1", ;
		Height = 17, ;
		Left = 6, ;
		Top = 11, ;
		Width = 167, ;
		Name = "Label1"

	Add Object shape1 As Shape With ;
		Top = 0, ;
		Left = 0, ;
		Height = 16, ;
		Width = 84, ;
		BackStyle = 0, ;
		BorderStyle = 1, ;
		MousePointer = 15, ;
		Name = "Shape1"

	Procedure shape1.Click
	Do Case
	Case This.Parent.Parent.Parent.Parent.GroupExpandType=0
* instant Expand / Collapse
		If This.Parent.Parent.groupexpanded=.T.
			This.Parent.Parent.Height=This.Parent.Height
			This.Parent.Parent.groupexpanded=.F.
		Else
			This.Parent.Parent.Height=This.Parent.Parent.expandedheight
			This.Parent.Parent.groupexpanded=.T.
		Endif
		Thisform.groupvposition()

	Case This.Parent.Parent.Parent.Parent.GroupExpandType=1
* Animated Groups
		This.Parent.Parent.timerdone=.F.
		This.Parent.Parent.timer1.Enabled=.T.
	Endcase
	Endproc

	Procedure shape1.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.Parent.imghighlight.Visible=.T.     &&.f.
	This.Parent.label1.ForeColor=Rgb(0,0,0)
	Endproc

	Procedure shape1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.Parent.imghighlight.Visible=.T.
	This.Parent.label1.ForeColor=Rgb(255,255,255)
	Endproc
Enddefine
*
*EndDefine:yHeader1


see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.
see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.
see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.
see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.
see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.

see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.

Note : the zip above i updated with a complet project. 01 of may 2017.

Note : the zip above i updated with a complet project. 01 of may 2017.

Important:All Codes above are tested on VFP9SP2 & windows 10 pro.

Comment on this post