My new vfp navigation bar

Published on by Yousfi Benameur

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


the code below builds a vfp navigation bar with accordion principe.
a main container covers some item containers (can embed any control).
each item container is collapsed as a commandutton area.its clickable to re arrange all main container items.
the clicked item expands its area and show embed controls inside.
the main container is positionned at the left of the form (can be at right also)
its expandable/collapsable from arrow button
each editbox have a modern contextuel menu (rightclick to fire it).
accordion buttons colors can be set in panel7 (shape yshp) 
this new method uses bindevent to achieve the goal.
i choosed a top level form targeting a desktop application.(can Press ESC to release the form).
Internet must be connected to show the decorating images(can replace with images on disc..).
can also convert the class as visual one and drop it into any form.The init method builds all custom items(in this case move the form methods binded to classes).

*Note : can build a project (add a congig.fpw) and compile exe (desktop application:48Ko~)

[post 234]


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

              

*!*	created on friday 19 of may 2017.updated on 21 of may 2017 with some minors changes(close button,menu button,button class).

*1*created on friday 19 of may 2017
*minor update 21 of may 2017 (close button class+black exit screen)

_screen.windowstate=1
set date long
set defa to addbs(justpath(sys(16,1)))
***
*download 7 images from my blog used in code.
local m.ydownl
m.ydownl=.t.  && make it false since 7 images downloaded
if m.ydownl=.t.
*download some pngs used in code (8)
*the code downloads first working image from my blog (or point later on the form to any image on disc)
Declare Integer Sleep In kernel32 Integer
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName

for i=1 to 7
do case
case i=1
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_194e6b_1.png"
lcDownloadLoc ="1.png"
case i=2
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_101293_2.png"
lcDownloadLoc ="2.png"
case i=3
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_ec32c9_3.png"
lcDownloadLoc ="3.png"
case i=4
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_6b1fd7_4.png"
lcDownloadLoc ="4.png"
case i=5
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_108941_5.png"
lcDownloadLoc ="5.png"
case i=6
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_6c2878_6.png"
lcDownloadLoc ="6.png"
case i=7
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170519/ob_06b6bd_7.png"
lcDownloadLoc ="7.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
endi
****

publi yform
yform=newObject("ynavigBar")
yform.show
read events
retu
*
DEFINE CLASS ynavigBar AS form
Height = 705
Width = 987
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
KeyPreview=.t.
Caption = "My vfp navigation bar as  accordion."
yleft = 0
Name = "Form1"


add Object yexit1 as yexit WITH ;
top=695,;
left=920+20,;
name="yexit1"

ADD OBJECT ycont AS ycont0 WITH ;
Top = 12, ;
Left = 0, ;
Width = 252, ;
Height = 688, ;
BorderWidth = 0, ;
Name = "ycont"

ADD OBJECT image1 AS image WITH ;
Height = 504, ;
Left = 264, ;
Top = 0, ;
Width = 721, ;
Name = "Image1"


ADD OBJECT ymen1 as ymen WITH;
top=7,;
left=900,;
name="ymen"	


ADD object yhelp as label with ;
autosize=.t.,;
fontname="webdings",;
caption=chr(0x69),;
top=7,;
left=945,;
backstyle=0,;
fontsize=28,;
mousepointer=15,;
forecolor=255,;
Anchor=768,;
tooltiptext="Help",;
name="yhelp"
Procedure QueryUnload
With Thisform
	Try
		.AddObject("zshape","shape")
	Catch
	Endtry

	With .zshape
		.Left=0
		.Top=0
		.Width=.Parent.Width
		.Height=.Parent.Height
		.DrawMode=9
		.BackColor=Rgb(46,46,46)
		.ZOrder(0)
		.Visible=.T.
	Endwith
Endwith

If Messagebox("Want indeed to exit ?",4+64)=6
	DoDefault()
	Thisform.Release
Else
	Thisform.RemoveObject("zshape")
	Nodefault
	Return .F.
Endi
Endproc

PROCEDURE yhelp.click
local m.myvar
text to m.myvar pretext 7 noshow
the code below builds a vfp navigation bar with accordion principe.
a main container covers some item containers (can embed any control).
each item container is collapsed as a commandutton area.its clickable to re arrange all main container items.
the clicked item expands its area and show embed controls inside.
the main container is positionned at the left of the form (can be at right also)
its expandable/collapsable from arow button
this new method uses bindevent to achieve the goal.
Internet must be connected to show the decorating images(can replace with images on disc..).

Yousfi Benameur El Bayadh Algeria  19 of may 2017
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 my
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]

	local m.x
	m.x=int(val(substr(loObject.parent.name,10)))

	do case
	case m.x=1
	run/n notepad
	case m.x=2
	run/n calc
	*case m.x=3
	*case m.x=4
	*case m.x=5
	*case m.x=6
	*case m.x=7
	otherwise
	messagebox(loObject.name +"of "+loOBject.parent.name+" clicked! write some code here",0+32+4096,'',1200)
	endcase
ENDPROC

PROCEDURE my1
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	loObject.mousepointer=15
with thisform.ycont
.height=750
for i=1 to .controlcount
if !lower(.controls(i).name)==lower(loObject.parent.name)
.controls(i).height=27
else
.controls(i).height=300
endi

if i=1
.controls(i).top=0
else
.controls(i).top=eval("thisform.ycont.controls(i-1).top")+eval("thisform.ycont.controls(i-1).height")
endi
.controls(i).refresh
endfor
.refresh
endwith

with loObject.parent.parent.olecontrol1
.width=217
.height=180
.visible=.t.
.refresh
endwith
ENDPROC

PROCEDURE my2
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	local o
	o=newObject("hyperlink")
	o.navigateto(loObject.caption)
	o=null
ENDPROC

PROCEDURE yexpcol
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]

with loObject.parent
do case
case loObject.caption="7"
thisform.yleft=.left
.left=-(.width-.left)+33

case loObject.caption="8"
.left=thisform.yleft

endcase
endwith
loObject.caption=iif(loObject.caption="7","8","7")
with thisform
.image1.left=.ycont.left+.ycont.width
.image1.width=.width-.image1.left
endwith

with loObject.parent.olecontrol1
if loObject.caption="7"
.visible=.t.
.refresh
else
.visible=.f.
endi
endwith
ENDPROC

PROCEDURE yedmenu
SET COLOR OF SCHEME 1 TO N+/w*,GR+/N*,,,,W+/R
	 Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol() color scheme 1
	DEFINE BAR _med_slcta OF raccourci PROMPT "Sélectionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		PICTRES _med_slcta ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	DEFINE BAR _med_paste OF raccourci PROMPT "Coller" ;
		KEY CTRL+V, "Ctrl+V" ;
		PICTRES _med_paste ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	DEFINE BAR _med_copy OF raccourci PROMPT "Copier" ;
		KEY CTRL+C, "Ctrl+C" ;
		PICTRES _med_copy ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_cut OF raccourci PROMPT "Couper" ;
		KEY CTRL+X, "Ctrl+X" ;
		PICTRES _med_cut ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_redo OF raccourci PROMPT "Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		PICTRES _med_redo
	DEFINE BAR _med_undo OF raccourci PROMPT "Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		PICTRES _med_undo ;
		MESSAGE "Annule la dernière modification"
	ACTIVATE POPUP raccourci
ENDPROC

PROCEDURE yloadimg &&internet must be mandatory  connected to run this function (can replace with disc image..)
Lparameters lcURL
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcURL,.F.)
m.loRequest.Send()
local m.x
m.x=m.loRequest.ResponseBody
m.loRequest=Null
Return m.x
ENDPROC

PROCEDURE ypgf
*Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
messagebox(loObject.parent.parent.name+"."+loObject.parent.name+"."+loObject.name+" clicked.....can write some code from here.",0+32+4096,"",1200)
ENDPROC

PROCEDURE mye
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	loObject.backcolor=rgb(255,201,14)
ENDPROC

PROCEDURE myl
Lparameters nButton, nShift, nXCoord, nYCoord
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	loObject.backcolor=rgb(128,68,0)
ENDPROC

PROCEDURE ycal1
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)=="ycal"
	activate window calculator in window  (thisform.name) top
	
	case lower(loObject.name)=="ycale"
	activate window calendar in window (thisform.name) top
	
	case lower(loObject.name)=="ynew"		
	sys(1500,"_MST_HPSCH","_MSYSTEM")
	case lower(loObject.name)=="about"
	sys(1500,"_MST_ABOUT","_MSYSTEM")

	case lower(loObject.name)=="backg"
	rand(-1)
	loObject.parent.backcolor=rgb(255*rand(),255*rand(),255*rand())
	loObject.parent.edit1.forecolor=rgb(255*rand(),255*rand(),255*rand())

	case lower(loObject.name)=="ytime"
	messagebox(dateTime())

case lower(loObject.name)=="yshp"
	local m.xcolor
	m.xcolor=getcolor()
	if m.xcolor=-1
	return .f.
	endi
with thisform.ycont
for i=1 to .controlcount
if lower(.controls(i).class)=="yitem"
.controls(i).command1.backColor=m.xcolor
.controls(i).refresh
endi
endfor
endwith
	
	endcase
ENDPROC

PROCEDURE Resize
dodefault()
ENDPROC

PROCEDURE Init
_screen.windowstate=1
thisform.backcolor=rgb(128,128,128)
this.ycont.yitem1.command1.mousedown(1)
thisform.windowstate=2
ENDPROC

PROCEDURE KEYPRESS   && esc to release the form here
LPARAMETERS nKeyCode, nShiftAltCtrl
if nkeycode=27
thisform.queryUnload()   &&release
endi
endproc


PROCEDURE ycont.Destroy
clea events
ENDPROC

PROCEDURE image1.Init
With This
	.Anchor=15
	.Left=.Parent.ycont.Left+.Parent.ycont.Width
	.Top=0
	.Width=.Parent.Width-.Parent.ycont.Left-.Parent.ycont.Width
	.Height=.Parent.Height
	.ZOrder(1)
	.Stretch=2
	.PictureVal=Thisform.yloadimg("https://voyageforum.com/images/posts/medium/1a5d3e54b3d50958be5fec986d4413391240487382.jpeg")
Endwith
ENDPROC

ENDDEFINE
*
*-- EndDefine: ynavigBar

*

DEFINE CLASS ycont0 AS container      &&8 7  items container to create here
Top = 12
Left = 0
Width = 252
Height = 688
BorderWidth = 0
Name = "ycont0"

ADD OBJECT yitem1 AS yitem WITH ;
Top = -1, ;
Left = 0, ;
Width = 250, ;
Height = 321, ;
BackColor = RGB(128,255,0), ;
Name = "yitem1"

ADD OBJECT yitem2 AS yitem WITH ;
Top = 105, ;
Left = 0, ;
Width = 252, ;
Height = 50, ;
BackColor = RGB(255,255,0), ;
Name = "yitem2"

ADD OBJECT yitem3 AS yitem WITH ;
Top = 201, ;
Left = 0, ;
Width = 250, ;
Height = 50, ;
BackColor = RGB(0,255,255), ;
Name = "yitem3"

ADD OBJECT yitem4 AS yitem WITH ;
Top = 261, ;
Left = 0, ;
Width = 250, ;
Height = 84, ;
BackColor = RGB(255,128,64), ;
Name = "yitem4"

ADD OBJECT yitem5 AS yitem WITH ;
Top = 297, ;
Left = 0, ;
Width = 250, ;
Height = 84, ;
BackColor = RGB(255,128,64), ;
Name="yitem5"

ADD OBJECT yitem6 AS yitem WITH ;
Top = 333, ;
Left = 12, ;
Width = 250, ;
Height = 84, ;
BackColor = RGB(255,128,64), ;
Name = "yitem6"

ADD OBJECT yitem7 AS yitem WITH ;
Top = 384, ;
Left = 0, ;
Width = 250, ;
Height = 84, ;
BackColor = RGB(255,128,64), ;
Name = "yitem7"

ADD OBJECT ylab AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "webdings", ;
FontSize = 12, ;
Caption = "7", ;
Height = 21, ;
Left = 202, ;
Top = 475, ;
Width = 19, ;
Name = "ylab"

PROCEDURE Init
*this populates the navigation bar with some controls,menus,links...olecontrol..  *the items containers are initiamized with custom controls here.
with this
.left=1
.top=0
.height=750
.width=252
.backstyle=1
.backcolor=rgb(212,210,208)
.borderWidth=2

 WITH .yitem1
	.Top = -1
	.Left = 0
	.Width = 250
	.Height = 321
	.BackColor = RGB(128,255,0)
	.Name = "yitem1"
	.visible=.t.
	endwith

  with .yitem2
	.Top = 105
	.Left = 0
	.Width = 252
	.Height = 50
	.BackColor = RGB(255,255,0)
	.Name = "yitem2"
	.visible=.t.
	endwith
	
  with .yitem3
	.Top = 201
	.Left = 0
	.Width = 250
	.Height = 50
	.BackColor = RGB(0,255,255)
	.Name = "yitem3"
	.visible=.t.
	endwith

with .yitem4
	.Top = 261
	.Left = 0
	.Width = 250
	.Height = 84
	.BackColor = RGB(255,128,64)
	.Name = "yitem4"
	.visible=.t.
	endwith

with .yitem5
	.Top = 297
	.Left = 0
	.Width = 250
	.Height = 84
	.BackColor = RGB(255,128,64)
	.Name = "yitem5"
	.visible=.t.
	endwith

with .yitem6
	.Top = 333
	.Left = 12
	.Width = 250
	.Height = 84
	.BackColor = RGB(255,128,64)
	.Name = "yitem6"
	.visible=.t.
	endwith

with .yitem7
	.Top = 384
	.Left = 0
	.Width = 250
	.Height = 84
	.BackColor = RGB(255,128,64)
	.Name = "yitem7"
	.visible=.t.
	endwith

with .ylab
.autosize=.t.
.top=.parent.height-.height-10   &&0
.left=.parent.width-.width-1
.fontname="webdings"
.fontsize=12
.forecolor=rgb(0,0,255)
.backstyle=0
.mousepointer=15
.caption="7"
endwith
bindevent(.ylab,"mousedown",thisform,"yexpcol")

for i=1 to .controlcount
rand(-1)
if lower(.controls(i).class)=="yitem"
bindevent(.controls(i).command1,"mousedown",thisform,"my1")
bindevent(.controls(i).command1,"mouseEnter",thisform,"myE")
bindevent(.controls(i).command1,"mouseLeave",thisform,"myL")
endi
.height=200

with .controls(i)
if !lower(.class)=="yitem"
loop
endi

.backstyle=1
.borderwidth=0
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.left=1
.width=.parent.width-2
with .command1
.top=0-1
.left=0
.height=27+1
.width=.width
.caption="This is my Panel"+trans(i)
.mousepointer=15
.backcolor=rgb(128,68,0)
.fontbold=.t.
.picture=home(1)+"GRAPHICS\BITMAPS\OUTLINE\PLUS.BMP"
.picturePosition=0
.pictureSpacing=5
endwith

.height=27
endwith

if i=1
.controls(i).top=0
else
.controls(i).top=eval("thisform.ycont.controls(i-1).top")+eval("thisform.ycont.controls(i-1).height")
endi

with .controls(i)
if inlist(i,1,2,3,4,5,6)
.addObject("edit1","editbox")
with .edit1
.value="this is the "+.parent.name +" (or panel"+substr(.parent.name,10)+")"
text to .value textmerge pretext 7 noshow
<<.value>>
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.
endtext

.left=4
.top=27+4
.width=240
.height=100
.scrollbars=0
.borderstyle=0
rand(-1)
.forecolor=rgb(255*rand(),255*rand(),255*rand())
.visible=.t.
.fontbold=.t.
endwith
bindevent(.edit1,"rightclick",thisform,"yedmenu")  &&contextuel menu for editbox

.addObject("image1","image")
with .image1
.stretch=2
.width=100
.height=100
.left=10
.mousepointer=15
.top=.parent.edit1.top+.parent.edit1.height+5
.picture=trans(i)+".png"
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

 .AddObject("yctime1","yctime")
 with  .yctime1
 .top=.parent.image1.top + .parent.image1.height+5
 .left=10     &&(.parent.width-.width)/2
 .zorder(0)
 .visible=.t.
 bindevent(.ytime,"mousedown",thisform,"ycal1")
 endwith


.addObject("ycal","label")
with .ycal
.left=10+.parent.image1.width+5
.height=27
.top=.parent.image1.top
.backstyle=0
.fontname="Tahoma"
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
.caption="calculator"
.tooltiptext=.caption
.visible=.t.
endwith
bindevent(.ycal ,"mousedown",thisform,"ycal1")

.addObject("ycale","label")
with .ycale
.left=10+.parent.image1.width+5
.height=27
.top=.parent.image1.top+27
.backstyle=0
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
.caption="VFP Calendar"
.tooltiptext=.caption
.visible=.t.
endwith
bindevent(.ycale ,"mousedown",thisform,"ycal1")

.addObject("ynew","label")
with .ynew
.left=10+.parent.image1.width+5
.height=27
.top=.parent.image1.top+2*27
.backstyle=0
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
.caption="VFP Help"
.tooltiptext=.caption
.visible=.t.
endwith
bindevent(.ynew ,"mousedown",thisform,"ycal1")

.addObject("about","label")
with .about
.left=10+.parent.image1.width+5
.height=27
.top=.parent.image1.top+3*27
.backstyle=0
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
.caption="VFP about"
.tooltiptext=.caption
.visible=.t.
endwith
bindevent(.about ,"mousedown",thisform,"ycal1")

.addObject("backg","label")
with .backg
.left=10+.parent.image1.width+5
.height=27
.top=.parent.image1.top+4*27
.backstyle=0
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
.caption="Backcolor/forecolor"
.tooltiptext=.caption
.visible=.t.
endwith
bindevent(.backg ,"mousedown",thisform,"ycal1")

.AddObject("pageframe1","pageframe")
with .pageframe1
	.PageCount = 4
	.themes=.f.
	.Top = .parent.image1.top+.parent.image1.height+30
	.Left = 4
	.Taborientation=0
	.Width = 241
	.Height = 31
	.Name = "Pageframe1"
	.Page1.Caption = "1"
	.Page1.Name = "Page1"
	.Page2.Caption = "2"
	.Page2.Name = "Page2"
	.Page3.Caption = "3"
	.Page3.Name = "Page3"
	.Page4.Caption = "4"
	.Page4.Name = "Page4"
	.visible=.t.
	for k=1 to .pagecount
	.pages(k).backcolor=rgb(255*rand(),255*rand(),255*rand())
	bindevent(.pages(k),"click",thisform,"ypgf")
	endfor
endwith
.refresh
endi

if i=7
for j=1 to 5
.addObject("hyp"+trans(j),"label")
with eval(".hyp"+trans(j))
.left=10
.height=27
.top=(j-1)*.height+30
.backstyle=0
.FontUnderline=.t.
.fontItalic=.t.
.fontsize=10
.fontbold=.t.
.forecolor=rgb(0,0,255)
.mousepointer=15
.autosize=.t.
do case
case j=1
.caption="www.yousfi.over-blog.com "
case j=2
.caption="WWW.foxite.com"
case j=3
.caption="https://www.levelextreme.com/Default.aspx?LevelExtremeRedirect=1"
case j=4
.caption="www.atoutfox.org"
case j=5
.caption="http://www.lebuteur.com/"
endcase
.tooltiptext=.caption
.visible=.t.
endwith

.backcolor=rgb(255,201,25)
bindevent(eval(".hyp"+trans(j)) ,"mousedown",thisform,"my2")
endfor
.addObject("im1","image")
with .im1
.stretch=2
.width=100
.height=100
.left=10
.mousepointer=15
.top=170
.picture="7.png"
.visible=.t.
endwith

.addobject("yshp","shape")
with .yshp
.width=28
.height=20
.mousepointer=15
.backcolor=rgb(0,255,0)
.tooltiptext="accordion colors"
.left=(.parent.im1.left+.parent.im1.width+30)
.top=(.parent.im1.top+.parent.im1.height/2)
.curvature=15
.zorder(0)	
.visible=.t.
endwith	
bindevent(.yshp ,"mousedown",thisform,"ycal1")

endi
.refresh
endwith
endfor

 .AddObject("olecontrol1","olecontrol","MSComCtl2.MonthView.2")
with .olecontrol1
	.Top = 500   && .parent.ylab.top+.parent.ylab.height+5
	.Left = 10
	.Height = 180
	.Width = 217
	.Visible = .t.
	.Name = "Olecontrol1"
	.BackColor=rgb(212,210,208)
	.BorderStyle=0
	.MonthBackcolor=16776960
	.titleBackcolor=255
	.borderstyle=0
	.appearance=0
	.refresh
endwith	

endwith
ENDPROC

ENDDEFINE
*
*-- EndDefine: ynavbar

*base container for item
DEFINE CLASS yitem AS container
Top = -1
Left = 0
Width = 250
Height = 321
BackColor = RGB(128,255,0)
Name = "yitem"

ADD OBJECT command1 AS commandbutton WITH ;
Top = 0, ;
Left = 0, ;
Height = 27, ;
Width = 253, ;
Picture = home(1)+"graphics\icons\misc\misc15.ico", ;
Caption = "Command1", ;
PicturePosition = 0, ;
PictureSpacing = 10, ;
Name = "Command1"
ENDDEFINE
*
*-- EndDefine: yitem

DEFINE CLASS yctime AS container
Width = 71
Height = 23
backstyle=0
borderwidth=0
Name = "Container1"

ADD OBJECT ytime AS label WITH ;
AutoSize = .f., ;
Alignment=2, ;
FontBold = .T., ;
mousepointer=15,;
FontSize = 12, ;
Caption = "Label1", ;
Height = 22, ;
Left = 0, ;
Top = 0, ;
Width = 53, ;
ForeColor = RGB(0,255,0), ;
BackColor = RGB(0,0,0), ;
Name = "ytime"

ADD OBJECT timer1 AS timer WITH ;
Top = 0, ;
Left = 48, ;
Height = 23, ;
Width = 23, ;
Interval = 60000, ;
enabled=.t.,;
Name = "Timer1"

PROCEDURE ytime.Init
with this
.caption=substr(time(),1,5)
.left=(.parent.width-.width)/2
endwith
ENDPROC

PROCEDURE timer1.Timer
this.parent.ytime.caption=spac(1)+substr(time(),1,5)+spac(1)
ENDPROC

ENDDEFINE
*
*-- EndDefine: yctime

DEFINE CLASS yexit AS image
stretch=0
Height = 49
Left = 48
MousePointer = 15
Top = 500
Width = 145
Name = "Image1"

PROCEDURE MouseLeave
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	this.rotateFlip=0
ENDPROC

PROCEDURE MouseEnter
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	this.rotateFlip=4
ENDPROC

PROCEDURE Init
	local m.myvar
	text to m.myvar noshow
	iVBORw0KGgoAAAANSUhEUgAAAC0AAAAtCAYAAAA6GuKaAAAFu0lEQVRYhdWZW2wUVRiAv7nQ0mlhy1LuVyUttcjdGAoPQGExJCXFxIAIIVV8sQSDGi1EsaDxAhoViSgJYhCFkIiEQFJMC4hQ0agFrMECoZByL223pex2t92d48N22+nu7K3QLn7JZOf88/8z3545ezpnKomGBrrMiROp7N49i+rqWTQ1TaOlJRNdt3TKkSQ3snyHpKQzaNoFRow4wZo1xYwa5e7qZaVYpZ319TKFaxdRVZWPw5GDEL1iv6rkok/KT2Q+tp21hYe1oUM9MZVHK117u0Zi3frFVFZuoLU1I2bRUPTqdYFxWW+y/u19aYMGimhKopKufn/TJEqPbqPZ9eR9S4YiWTvGkkX5I1fkV0dKjShdufSF1Vyp3gTEPgxiRZKamDAuP3PrZz+GTQslXf7HXzLvbNqG3f5itwiGY8igd1n7atGUKZNNh4updNnJMpmNW7Zjb3y+2wVDMaD/Zl5f+cqM6dlB4qbSJQuXbabO/nKPyIUjzfqJbf+u1wLDQdIHlhesoOrq9h4Ti0TGI8/l7fh8T3vbYuksvafog3SO/laBIDEefqbIkgPb9PFL1r1xGQCLBdV/7OsdOxXKTu9ASA+PMIBOMmWnPwKe8YckIQQ0NrIlL38pdXe/i6NeeAak2lYd3VcKbdIbk7MSkeVKhlhHk9D903GXqLH/WlhTPgPapIuSxy8DdqHIMMQKqhxnwwA8OlyrBcjZ4Kg4pgI4JXUZADpQ0wQDLaBI8ZMMpMkNkgqwGDgmFaRMtQA1QEJ7UoICaSkgPwTibg/UOUAXAHZgsOqU1NkYhQFagXoXWJNMz1N/vhQA69i53Sfr0eGuG9xeQAFf//UDstRmSZlmVrP3ThkjgKmGWGKGT9I/4pujepCMEa+Ae63g8vrakhKYMU91ok4IjB5sPA7AVSARmNgW91wopWXM3Pbb4vQ+QFldgFMHl46vW9VQmdmqU1IyjZEjDUfb9+ek5gDQoAGJEtbLR3Dqgt5+af0BdLUAXALcgJDMejaQUapTUgaZHcnuZ8PpP0EzSDrcGGZDUmV0fA/XLXLH1DjsUknQOa6PsXVqG3O8+M6nN/vET9mD67P72YJibdKqZnbEKQXcnpaO3ZNAEpB5T0VWQLlRTC3QF9rvAsCISyVUpc8H4NGLxeDz4xJQAWQ0+65x1l5spsApewkTrfMDwymqM8TtCBX30wzc8yjggYttsfT+uUgyyArotw7RF2j1KsgqKMAVoGZgLroXhptcI71/bvv+xbpDoTwSQo72riJ08OqGL9Lo+9yNb0hQcyhIMFA0ArdVTZhPAaHi4XLMavyxx63zOVvfMQwu1h0KuvUmQ8GMOlkTnlua8ODf/JytL8YY14SnPdYh5DFth4pl97N1+nGFyzVeL2BrUDXh/RcY7C+ck5rTPu2Z/aKNvRnYs+HyjVNpV+oNnJE14T2nCS/GbYFlZlAxwALLzCDpaPLNho3xWDT1hu2CtLjv9IXAftOqh5PJapLwlgIuOk+xDyu1wN+SEIKVfZ44DDwVb6Mo2PxF05+rVQBNeL/i/yH9LbQ9SmnCcwA4A0yKp1EEft/gqCgH/2oc2JiclQscjKdVBGYWOs79AgZpgC3a2CNATryswrB3lfP8s/5Gp2cPTXheAsqB5J62CsN1oMAY6NTTAHt6j14O7OxBqXC0AvOWuK78bAwGSQMcSBz+MRD0tjIOFOS5r30ZGDSVBihJHPIpsLq7rcKwwea+ud7sQEhpgLKEgUVAEf4FfM8ggHUzWmreC5UQVhqgvJc1D/gG3zuH7qYWWD6ltd58/dVGRGmAStUyGNgKPP1g3EzZBRRmehpvRkqMStpPtZI8F/iQzu9w7pfjwFsjvY6T0RbEJA1Qq/SWgNnAciAPSI3pBD7qgB+A79O8rhOxFscsbcQpqzIwAZgFjAfG4FsFDcf3B8oNOIAqfGvdcqAU+EfTPTH9a9nIfyt1aV42xku+AAAAAElFTkSuQmCC
	endtext
	local m.lcdest
	m.lcdest=addbs(sys(2023))+"ytemp.png"
	strtofile(strconv(m.myvar,14),m.lcdest)
	this.picture=m.lcdest
ENDPROC

PROCEDURE Click
	thisform.QueryUnload()
ENDPROC

ENDDEFINE
*
*-- EndDefine: yexit
*
DEFINE CLASS ymen  AS container
Top = 12
Left = 12
Width = 35
Height = 34
MousePointer = 15
BackColor = RGB(0,0,0)
tooltiptext="Collapse/expand"
Name = "Container1"

ADD OBJECT shape1 AS shape WITH ;
	Top = 4, ;
	Left = 3, ;
	Height = 7, ;
	Width = 30, ;
	BorderStyle = 0, ;
	BorderWidth = 0, ;
	Curvature = 10, ;
	MousePointer = 15, ;
	SpecialEffect = 0, ;
	BackColor = RGB(0,255,0), ;
	Name = "Shape1"

ADD OBJECT shape2 AS shape WITH ;
	Top = 13, ;
	Left = 3, ;
	Height = 7, ;
	Width = 30, ;
	BorderStyle = 0, ;
	BorderWidth = 0, ;
	Curvature = 10, ;
	MousePointer = 15, ;
	SpecialEffect = 0, ;
	BackColor = RGB(0,255,0), ;
	Name = "Shape2"

ADD OBJECT shape3 AS shape WITH ;
	Top = 22, ;
	Left = 3, ;
	Height = 7, ;
	Width = 30, ;
	BorderStyle = 0, ;
	BorderWidth = 0, ;
	Curvature = 10, ;
	MousePointer = 15, ;
	SpecialEffect = 0, ;
	BackColor = RGB(0,255,0), ;
	Name = "Shape3"

PROCEDURE Init
	with this
	for i=1 to .controlcount
	
	bindevent(.controls(i),"mousedown",this,"ymen")
	bindevent(.controls(i),"mouseEnter",this,"ymen1")
	bindevent(.controls(i),"mouseLeave",this,"ymen2")
	endfor
	endwith
	bindevent(this,"mousedown",thisform,"ymen")
ENDPROC

PROCEDURE YMEN
LPARAMETERS nButton, nShift, nXCoord, nYCoord
dodefault()
thisform.ycont.ylab.mousedown(1)
ENDPROC

PROCEDURE YMEN1
LPARAMETERS nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.setall("backcolor",255,"shape")
ENDPROC

PROCEDURE YMEN2
LPARAMETERS nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.setall("backcolor",rgb(0,255,0),"shape")
ENDPROC

ENDDEFINE
*
*-- EndDefine: ymen


My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar
My new vfp navigation bar

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

Comment on this post