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
the container width is set as _width constant, can customize.
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


*1*
*!*	created on friday 19 of may 2017.updated on 21 of may 2017 with some minors changes(close button,menu button,button class).
*minor update 21 of may 2017 (close button class+black exit screen+Added a set of button to command the panels from the form.)+yexit button position for large screens+container width as variable
*i made random colors but can fix this along all this post as custom ones.

_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
****
#define _width 250   &&this is the container width general setting  (can customize)

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 ;
Anchor=768,;
top=660,;
left=920,;
name="yexit1"

ADD OBJECT ycont AS ycont0 WITH ;
Top = 12, ;
Left = 0, ;
Width = _width, ;
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

*myad method  &&a set of 7 buttons to command the accordion from the form
procedure myad
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.name,8)))
local m.u
m.u="this.ycont.yitem"+trans(m.x)+".command1.mousedown(1)"
=eval(m.u)	
endproc


PROCEDURE Resize
dodefault()
ENDPROC

PROCEDURE Init
_screen.windowstate=1

with thisform
.addproperty("panelcount",7)  &&7 panels here
.addobject("ycnt","container")
with eval (".ycnt")
.Top =10
.Left = 600
.Width = 156
.Height = 27
.BackStyle = 0
.BorderWidth = 0
.Name = "ycnt"
.visible=.t.

local m.xx,m.yy
m.xx=15
m.yy=27


for i=1 to thisform.panelcount
.ADDOBJECT("command"+trans(i),"commandbutton")
   with eval(".command"+trans(i))
	.AutoSize = .T.
	.Top = 0
	.Height = 27
	.Width = 27
	.Left =m.xx+(i-1)*yy+1	
	.FontBold = .T.
	.Caption = trans(i)
	.MousePointer = 15
	.BackColor = RGB(128,255,0)
	.Name = "Command"+trans(i)
	.visible=.t.
	endwith
bindevent(eval(".command"+trans(i)),"mousedown",thisform,"myad")
endfor
.width=thisform.panelcount*yy+27	
endwith
	
endwith		

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 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 = _width
Height = 688
BorderWidth = 0
Name = "ycont0"

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

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

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

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

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

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

ADD OBJECT yitem7 AS yitem WITH ;
Top = 384, ;
Left = 0, ;
Width = _width, ;
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=_width
.backstyle=1
.backcolor=rgb(212,210,208)
.borderWidth=2

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

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

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

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

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

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

with .yitem7
.Top = 384
.Left = 0
.Width = _width
.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 = "yexit"

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
My new vfp navigation bar

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


*2*
*!*	created on Monday 13 of june 2017.
*builds a basic vfp accordion with some text in editbox an a clickable image
*i made random colors but can fix this along all this post as custom ones.
*this code is extracted and adapted  from the *1* code.

_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
****
#define _width 610   &&this is the container width general setting  (can customize)

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 = "A basic vfp  accordion."
yleft = 0
Name = "Form1"


ADD OBJECT yexit1 as yexit WITH ;
Anchor=768,;
top=660,;
left=920,;
name="yexit1"

ADD OBJECT ycont AS ycont0 WITH ;
Top = 12, ;
Left = 0, ;
Width = _width, ;
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

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

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

*myad method  &&a set of 7 buttons to command the accordion from the form
procedure myad
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.name,8)))
local m.u
m.u="this.ycont.yitem"+trans(m.x)+".command1.mousedown(1)"
=eval(m.u)	
endproc

PROCEDURE Resize
dodefault()
ENDPROC

PROCEDURE Init
_screen.windowstate=1

with thisform
.addproperty("panelcount",7)  &&7 panels here
local m.xx,m.yy
m.xx=_width+10
m.yy=27
for i=1 to .panelcount
.ADDOBJECT("command"+trans(i),"commandbutton")
with eval(".command"+trans(i))
.AutoSize = .T.
.Top = 0
.Height = 27
.Width = 27
.Left =m.xx+(i-1)*yy+1	
.FontBold = .T.
.Caption = trans(i)
.MousePointer = 15
.BackColor = RGB(128,255,0)
.Name = "Command"+trans(i)
.visible=.t.
endwith
bindevent(eval(".command"+trans(i)),"mousedown",thisform,"myad")
endfor
.width=thisform.panelcount*yy+27	
endwith

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 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 = 0
Left = 0
Width = _width
Height = 688
BorderWidth = 0
Name = "ycont0"

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

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

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

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

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

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

ADD OBJECT yitem7 AS yitem WITH ;
Top = 384, ;
Left = 0, ;
Width = _width, ;
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=_width
.backstyle=1
.backcolor=rgb(212,210,208)
.borderWidth=2

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

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

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

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

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

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

with .yitem7
.Top = 384
.Left = 0
.Width = _width
.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")
endwith

with this
for i=1 to .controlcount
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
rand(-1)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.left=1
.width=.parent.width-2
with .command1
.top=0
.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=3
.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,7)
*rand(-1)
.addObject("image1","image")
with .image1
.stretch=2
.width=48
.height=48
.left=10
.mousepointer=15
.top=.parent.command1.top+.parent.command1.height+1    &&.parent.edit1.top+.parent.edit1.height+5
.picture=trans(i)+".png"
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

.addObject("ytitle","label")
with .ytitle
.left=.parent.image1.left+.parent.image1.width+5
.autosize=.t.
.fontsize=24
.backstyle=0
.mousepointer=15
.top=.parent.image1.top
.caption ="my title"+trans(i)+" here!"
.zorder(0)
.forecolor=255
.fontname="Tahoma"
.fontbold=.t.
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")


.addObject("edit1","editbox")
with .edit1
.width=.parent.width-2
.left=1
.top=.parent.image1.top+.parent.image1.height+1
.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. 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
.height=200
.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
endi
.refresh
endwith
endfor
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 = 3, ;
PictureSpacing = 10, ;
Name = "Command1"
ENDDEFINE
*
*-- EndDefine: yitem


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

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

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

*3* created on 14 of june 2017
*builds a basic vfp accordion with some text in editbox an a clickable image
*the commandbutton is replaced by a container with picture,title and icon
*container.picture is built with gradients from vfp9 gdiplus class.
*i made random colors but can fix this along all this post as custom ones.
*this code is extracted and adapted  from the *1* code.

_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
****
*this is a random color set to build gradients container picture.
rand(-1)
with _screen
.addproperty("tnRed",255*rand())
.addproperty("tnGreen",255*rand())
.addproperty("tnBlue",255*rand())
endwith

#define _width 610   &&this is the container width general setting  (can customize)
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 = "A basic vfp  accordion with gradient image"
yleft = 0
Name = "Form1"

ADD OBJECT yexit1 as yexit WITH ;
Anchor=768,;
top=660,;
left=920,;
name="yexit1"

ADD OBJECT ycont AS ycont0 WITH ;
Top = 12, ;
Left = 0, ;
Width = _width, ;
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]
loObjectP=loObject.parent

with thisform.ycont
.height=750
for i=1 to .controlcount
if !lower(.controls(i).name)==lower(loObjectp.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
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
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 mye
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.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.parent.backcolor=rgb(128,68,0)
ENDPROC

*myad method  &&a set of 7 buttons to command the accordion from the form
procedure myad
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.name,8)))
local m.u
m.u="this.ycont.yitem"+trans(m.x)+".command1.mousedown(1)"
=eval(m.u)	
endproc

PROCEDURE Resize
dodefault()
ENDPROC

PROCEDURE Init
_screen.windowstate=1
thisform.ybuild()
endproc

procedure ybuild()

with thisform
.addproperty("panelcount",7)  &&7 panels here
local m.xx,m.yy
m.xx=_width+10
m.yy=27
for i=1 to .panelcount
try
.ADDOBJECT("command"+trans(i),"commandbutton")
catch
endtry

with eval(".command"+trans(i))
.AutoSize = .T.
.Top = 0
.Height = 27
.Width = 27
.Left =m.xx+(i-1)*yy+1	
.FontBold = .T.
.Caption = trans(i)
.MousePointer = 15
.BackColor = RGB(128,255,0)
.Name = "Command"+trans(i)
.visible=.t.
endwith
bindevent(eval(".command"+trans(i)),"mousedown",thisform,"myad")
endfor
.width=thisform.panelcount*yy+27	
endwith

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

procedure ygrad()
lparameters loObject
*create horizontal bmp image   with linear gradient 2 colors
Local nWidth,lnHeight As Integer
Set Classlib To Locfile (Home(1)+"ffc\_gdiplus.vcx")
Local    OBitmap, oGraphics, Open, nY,nX, cFileName
*hoprizontal
lnWidth= loObject.width
lnHeight= loObject.height
m.cFileName =Addbs(Sys(2023))+"ygrad_"+Sys(2015)+".jpg"

m.OBitmap = Createobject ("gpBitmap")
m.OBitmap. Create (lnWidth, lnHeight)
m.oGraphics = Createobject ("gpGraphics")
m.oGraphics.CreateFromImage (m.OBitmap)
m.xcolor=This.rgb2html(Rgb(_screen.tnRed,_screen.tnGreen,_screen.tnBlue))
m.xcolor="0x"+Strtran(m.xcolor,"#","") +"00"  &&build a compatible vfp  color like 0xAAAA0000 with html color

m.oPen = Createobject ("gpPen", 0)
For m.nY = 0 To (lnHeight - 1) Step 1
m.oPen.PenColor = Eval(m.xcolor)+ (m.nY * 255 / lnHeight)
m.oGraphics.DrawLine (m.oPen, 0, m.nY, lnWidth - 1, m.nY)
Endfor
m.OBitmap.SaveToFile (m.cFileName, "image/jpeg")
*can be mimes as  image/bmp,image/png,image/gif....
loObject.Picture=m.cFileName
m.oPen=Null
m.oGraphics=Null
m.OBitmap=Null
Set Classlib To
Erase ( m.cFileName)   &&&&can not erase and use it saved as it
endproc

Procedure rgb2html
Lparameters tnColor
Local loColor
loColor = Createobject("Empty")
AddProperty(loColor, "nR", Bitand(tnColor, 0xFF))
AddProperty(loColor, "nG", Bitand(Bitrshift(tnColor, 8), 0xFF))
AddProperty(loColor, "nB", Bitand(Bitrshift(tnColor, 16), 0xFF))
AddProperty(loColor, "cHTMLcolor", Strtran("#" + ;
TRANSFORM(loColor.nR, "@0") +   ;
TRANSFORM(loColor.nG, "@0") +   ;
TRANSFORM(loColor.nB, "@0"), "0x000000", "" ))
Return loColor.cHTMLcolor
endproc

ENDDEFINE
*
*-- EndDefine: ynavigBar
*
DEFINE CLASS ycont0 AS container      &&8 7  items container to create here
Top = 0
Left = 0
Width = _width
Height = 688
BorderWidth = 0
Name = "ycont0"

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

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

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

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

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

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

ADD OBJECT yitem7 AS yitem WITH ;
Top = 384, ;
Left = 0, ;
Width = _width, ;
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"

ADD object ycolors as shape with;
anchor=768,;
backcolor=255,;
curvature=25,;
left=200+20,;
top=500,;
width=100,;
height=30,;
mousepointer=15,;
tooltipText="change background",;
name="ycolors"

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

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

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

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

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

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

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

with .yitem7
.Top = 384
.Left = 0
.Width = _width
.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")
endwith

with this
for i=1 to .controlcount
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
rand(-1)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.left=1
.width=.parent.width-2

with .command1
.top=0
.left=0
.height=27+1
.width=_width
.label1.caption="This is my Panel"+trans(i)
.mousepointer=15
endwith
.height=32
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,7)
*rand(-1)
.addObject("image1","image")
with .image1
.stretch=2
.width=48
.height=48
.left=10
.mousepointer=15
.top=.parent.command1.top+.parent.command1.height+1    &&.parent.edit1.top+.parent.edit1.height+5
.picture=trans(i)+".png"
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

.addObject("ytitle","label")
with .ytitle
.left=.parent.image1.left+.parent.image1.width+5
.autosize=.t.
.fontsize=24
.backstyle=0
.mousepointer=15
.top=.parent.image1.top
.caption ="my title"+trans(i)+" here!"
.zorder(0)
.forecolor=255
.fontname="Tahoma"
.fontbold=.t.
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

.addObject("edit1","editbox")
with .edit1
.width=.parent.width-2
.left=1
.top=.parent.image1.top+.parent.image1.height+1
.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. 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
.height=200
.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
endi
.refresh
endwith
endfor
endwith
ENDPROC

procedure ycolors.click
thisform.lockscreen=.t.
*thisform.ybuild()
dodefault()
with _screen
.tnRed=255*rand()
.tnGreen=255*rand()
.tnBlue=255*rand()
endwith

for i=1 to thisform.panelcount
thisform.ygrad(eval("thisform.ycont.yitem"+trans(i)+".command1"))
endfor
thisform.lockscreen=.f.
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 ycommand WITH ;
Top = 0, ;
Left = 0, ;
Height = 32, ;
Width = 253, ;
Name = "Command1"
ENDDEFINE
*
*-- EndDefine: yitem

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

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
*
DEFINE CLASS ycommand AS container
Top = 132
Left = 24
Width = 625
Height = 32
BackStyle = 1
BorderWidth = 1
Picture =""    &&can put here any custom gradients images
Name = "ycommand"

ADD OBJECT label1 AS label WITH ;
FontBold = .f., ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Label1", ;
Height = 25, ;
Left = 192, ;
MousePointer = 15, ;
Top = 6, ;
Width = 181, ;
Name = "Label1"

ADD OBJECT image2 AS image WITH ;
Picture = home(1)+"graphics\bitmaps\outline\plus.bmp", ;
BackStyle = 0, ;
Height = 13, ;
Left = 597-10, ;
Top = 11, ;
Width = 13, ;
Name = "Image2"

procedure label1.mousedown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.parent.mousedown(1)
endproc

procedure image2.mousedown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.parent.mousedown(1)
endproc

ENDDEFINE
*
*-- EndDefine: ycommand


in each panel can add what user wants to add as controls
in each panel can add what user wants to add as controls
in each panel can add what user wants to add as controls

in each panel can add what user wants to add as controls

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


*4* created on 15 of june 2017
*builds a basic vfp accordion with some text in editbox an a clickable image
*the commandbutton is replaced by a container with custom  picture,a title and icon
*container.picture can be any custom one (800x40 as PNG).
*i made random colors but can fix this along all this post as custom ones.
*this code is extracted and adapted  from the *1* code.


_screen.windowstate=1
set date long
set safe off
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

*******
*here 5 custom images  for decorating the container background (a1.png...a5.png)

*a1.png
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAyAAAAAoCAYAAAAGy56YAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAGgSURBVHhe7dcxi48BAAfg9/f+3/e9L2WxWCwWi8WiJMVwAymGG6hLiuEGSgw3UJJiuIGS1A2UpBhuoCRFUZJiON/iNz3Pt3gy7O/vDwAAAAUZ/v4TEAAAoCLD7z8CAgAAVCQ/fwkIAABQkXz7ISAAAEBF8uW7gAAAABXJp68CAgAAVCR7nwUEAACoSN5/FBAAAKAi49s9AQEAACoyvv4gIAAAQEXG3XcCAgAAVGR88UZAAACAiozPXgkIAABQkXFnV0AAAICKrB6/FBAAAKAiq4fPBQQAAKjI6v5TAQEAACqy2t4REAAAoCKrO08EBAAAqMh065GAAAAAFZm2HggIAABQken6PQEBAAAqMl3dFhAAAKAi05W7AgIAAFRk2rgtIAAAQEXmizcFBAAAqMh8fktAAACAiszrNwQEAACoyHzmmoAAAAAVmU9tCggAAFCR+cRlAQEAACqyHN8QEAAAoCLLsUsCAgAAVGQ5ekFAAACAiixHzgkIAABQkeXwuoAAAAAVWQ6dFRAAAKAiawdPCwgAAFCRtQMnBQQAACgYhv87el0eWkyVyAAAAABJRU5ErkJggg==
endtext
strtofile (strconv(m.myvar,14),"a1.png")

*a2.png
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAyAAAAAoCAYAAAAGy56YAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAlFSURBVHhe7Z1BayVVEEbTSUZnIYgLwY3gQhBEEBeCCxciggvBxSwEQRQREUF/pQsRxHn+HcdJrK+66nbd+/rlJc6keeI5UO+rW7c709n14SaZ6ZdvvrmepulsurjwOn/w4OzixRc9zy8v55nS6lz9Cy/4nl9/fr7k2NvXtA+v7D2NTM26BAAAAACA0+D6uuV19Jltpry6mkvr7FVPn55dPXlydvX3322m66dfv/9+ERCTjIsQkAsTDZeOqNZLQLTW9SEcEhOXDs2LfGRm+b+TvR5cfU0AAAAAADgNJBSRkosmHDHLSvlokhEp8XABMRGRjOT9028//tgERGIh8bh8+HA+BZFwDCchvlalgGgu6ci1+iIhttn6LoX6SAAAAAAAOCEkFZkhD5nz2DJko0qIz3T6YfX0r79a73t2zfT7Tz91AiK5aAIS8tEkxEqCclRAUjKqfIwiktQeAAAAAABOhyobEowxB/nw+TEB+ePnnw8LSJEPFxDrERAAAAAAgP8JEgqP5yggj8cTkPojWCkfmXbNUQFR6evZzOViEI/W6zux9G9JM4V/LgkAAAAAANvg7+UlXRYiXTAkF5k+tgzZ8H31koy7Ckj9HZCLIh/+S+i6xvb1i+reh3CMAuKCoVnIh1cISYpH4kJSGdcAAAAAALANIRdJyobm3ik1i7wK2fD1AQFx+QgB0T3Tn8MvobcTkBQNzUp1JyAmFZl+v3orF40UjiIhvlaKyE43hj0AAAAAANgIiUVNo3USDM2jNNfapWIQkJy5gDx5cnatv4YVc1037X74oQmITjwkHYcExK+JuQtHikekl8SjSMeqgKgCX1fGNQAAAAAAbIMEo+DSMTdzn+mjOAGRWCi1l30RkPr/gOiaaffdd/sCoh+/uklAom+nIEVAfCaJqOJh1FkM5vDPYNgDAAAAAICNCLFoabROcqF5VJUQ//Eqy5QRrxsF5NtvFwFRVQEp8uFiYan9JiAhHp7Z6zoJRBWQlUx8XRnXAAAAAACwDSEWSYqG5t7HOnvlUQHRflyjmnZffz0LiAmDn4BYPZOARJ+ykYLhqb1Ya3+OQTjGNQAAAAAAbIMJQsVFY27mPirnLhUhHVelv1lAvvrquIBILEI6biUgkgh9zajsaya+roxrAAAAAADYhhCLJEVDc+9jnb1LhYTD0k9Acn2jgHz55SIgIRiXkg+VhKJIyL8SEFtn76knVh90upHzTHtAAAAAAAC4R8Z37/IO3jrJQ2Tt24mH9asCor+AtScgX3zRC4jJxa0ExK73mTKko8qIvhGf6RuqqYdVH/i8Mq4BAAAAAGAbTBAqEoZoFgHxsNRMFRLS/QiW1gcF5NGjXkCs9gQk0gXEUvMqGzeegJTeU0+sPlg6I+eZ9oAAAAAAAHCPjO/e5R28dZKHyDksNVNJOCy7E5AbBeTzz9dPQHTSIaHIOiYg+ho50zehdVT2nnpi9YHPK+MaAAAAAAC2wQShImGI5riAZJ/rgwLy2WfrJyApIBIMpdWdBMTwmfqa84bvi6Uzcp5pDwgAAAAAAPfI+O5d3sFbJ3mInMNSs1KrJyBWLiDlumn36ae3FxBdsyYgcX+VEX0jTUCMgwJSemdcAwAAAADANpggVCQM0ewLSOSNJyCrAvLJJ4uAqPQjWJKPZxUQw7+u+przhu+LyR6ikfOyDwAAAAAAG5Dv5eX93EQhmhUB0axUdwKitQREP4JVpEQ17T7+eBYQK4mFqhOQUp2AFNnIREAAAAAAAP6j5Ht5eT//VwKisl7rdQH56KN1AQnRcPlIsYj9zQSk7gEAAAAAwPNnfPcu7+DPLCD6Eaw6t5p2H354WEAkFLZeFRC73mfai/s7AcmZeqPN5oXPxNIFZQ8AAAAAADbEBKHSVpKHyDmWzLq9gHzwwb6ASD7WBMTq1gJi+Gxulow99R72EI1hz55wTgAAAAAAuB/Gd+/yDt6dgJR97yJTLEbROCwg77+/CEgIxlEBiT7FI6Wj9iJn2dsHJyAAAAAAAKeKCUKlrSQPkXMsmeV/BSvLpKMJSKx9bvdMu/fe6wXE6qCA6JpjAhJpHy4XrhPRe2oveg97kMawZ085JwAAAAAA3A/ju3d5B7/TCUikVwqIss7t+mn37ruLgKh0AiLJCNFI+bizgOiLq/fOev9Y9tR7+Gch9wEAAAAAYFtMEiptFQLR+rk7LCBap4BYtbldP+3eeeewgNj6oIBoz8pzTUCU+gf0ZNHXTPgzvAAAAAAAJ0C+l5f38+4EJNIjemUTjsicHRaQt9++nYDoGkvJx56ARLZTET1QpObzss8EAQEAAAAAOAHyvby8nzcBMSQQSfZVLG4vIG+9da0vKzFwubBc/REsmzcBUW917wJS9wAAAAAA4PkzvnuXd/D7EZA331wXkJANCcXBE5C4rwlI6e1jFhCr7Oc2u5l+ZdR9e0gAAAAAALhHbnj/risJROJdCEXKhQvIsF4XkDfeOCwg1ncCktesCUj0KvtY1sqonCuT7gRElD0AAAAAANiQ4d187XdA8grllVL3aD5c0wQk92I+/fn6601AUjYuQz6agJQ9yUeu/Z64N+9PfWgZM6Wv/XMh5wAAAAAAcFq4XARLN8+1btKhXlXmLiBaR68U0+PXXusERILhAhIS0slGVDe3ezNTNoSvVWVPZCb9CgAAAAAAToWUC5EC4Z8SCgsXC60N5bgnAdk7AXn86quLgFhKJi6t6klHrVE+8j7vY53pxDozpi3rL7Z4Zw+2TAAAAAAAYAtcHuzd3DPIX5fQZ849QyY8o88USv141uoJyB+vvHJrAdE1TUDiHt3bCUiZixSRNrN/OPds2KeIBwMAAAAAgI1Zey+XPChtL9/UUyZG+Wj7Vp2AaBb3TL+//PK6gGg9lK65s4D4x7zuZontAQAAAADACRLSUMWiZZGOOwnIby+91P8OiFUTEJtX2WjrMtO9tc+vVbUij258Nu7ZupIPDQAAAAAA29K/mS/S4J+SCV/N5K9SaLYnILY+KCC/Pnw4C4jKvsiFpeRDpXWTDavsc53VCUikNXMWfD//Yf/saQ8cCQAAAAAA25Dv54fe06twVJp8RIqUDq/c14Yx/fLgQScgkol6+qF5CofPch179d5ubZVkP6Zj9wEAAAAAwAkShwdNLCJFnWUJ70M69gXk7Owfbo312miw4bMAAAAASUVORK5CYII=
endtext
strtofile (strconv(m.myvar,14),"a2.png")

*a3.png
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAyAAAAAoCAYAAAAGy56YAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAIUSURBVHhe7d2vSx5xHMDx+5ywsrKysrJisVhMFovFYrFYhCGDLawYBjMYDBaDwWAwGCwGw5JsYTBYGAiCQRAMgmAQBMGwsbQ9t+89d47nH9in+Hrdr8/dcX/Am+N5Ln4drTTVP2Vs2tPRY3/9QUQ/AAAAj1fXCs1oK1SlFUovRNRVVY+Vue7mYUN0HRE/Pr4ZfQIAAOC/ifvDZQECAACkiLuDJQECAACkiNv9RQECAACkiJu9BQECAACkiOvdeQECAACkiKudOQECAACkiMvtWQECAACkiIutGQECAACkiPPNaQECAACkiLONKQECAACkiNP1SQECAACkiJO1CQECAACkiOPVcQECAACkiO/vXwoQAAAgRXxbeSFAAACAFPH13XMBAgAApIgvb58JEAAAIEV8fv1UgAAAACni6NUTAQIAAKTwBgQAAEjjNyAAAEAa/4IFAACk8R0QAAAgjS+hAwAAaeJ4dVyAAAAAKeJkbUKAAAAAKeJ0fVKAAAAAKeJsY0qAAAAAKeJ8c1qAAAAAKeJia0aAAAAAKeJye1aAAAAAKeJqZ06AAAAAKeJ6d16AAAAAKeJmb0GAAAAAKeJ2f1GAAAAAKeLuYEmAAAAAKeL+cFmAAAAAKeLnpw9dgDTtYVA1gz9lLtvgdz8P2pv9FsOlXfsdAADwKJU+GK5tJzxoW6EUQ9RVVY+Vue7mcq3rh6r6C5SxiZl7/5ARAAAAAElFTkSuQmCC
endtext
strtofile (strconv(m.myvar,14),"a3.png")

*a4.png
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAyAAAAAoCAYAAAAGy56YAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsIAAA7CARUoSoAAAAUPSURBVHhe7dyxixVHHMDxm/wXFhZWNoKVlTFgEGITkCAYEIIQCZJGCBIbUwhBYmMgEosIARtBApLCIgjGIgppAskfpJeZ2Zm93+zbu8T23ucD+2Z2Zt9e/WX3Xfrn1avdnSylVD7qWI7dcp71sdibAQAA26oGRJN221kYd9ux8/bttN6PLP39+nW7MuuxUcZ81LMQIAAAAIMSG22ctfnumzfTfg+RLP3VnoBUAgQAAHgX7xogf7582WbTq1fzmIVb7IVIHwEAgO3TQyMEx1wIJTb6WPbXXsF6/eLFNCtiZOSjngkOAABgPyU22liFsT75yEeNkbae/nj+vM2m0Kg/Og/xMeSHGAEAAHpkZHVWYqOeZXlef5he1kJ81DFLvz971mZTeAwBUpbbOMdHHwEAgO3TQqKP7Wx4ClIDJMZH3Pvt6dM2m8LDExAAAOBALSaKHhfzSp73JyAbR5aePXnSZgIEAAD4H1pMFHWWz/tY9CcgMTzmvV8fP26zFhctQKbpIjgECAAA0KOi6b/vqHp0rB1Z+uXRozZbCZD62cT9rt0EAAA4xNYaILTAUAVxPz4Faevp8cOHbTbdtL+CVXgCAgAAbOiR0SyfgNRq6NERjyw9evCgzaa4GAKkfjY9PmKEtJsAAACH2FoDhBYYqiCv16vL/vLI0s/377fZdFMBAgAADNYaILTAUAV5vV5d9pdHln66d6/Nppt6BQsAADhQi4nunV7B+vHu3Tab4sITEAAAYLDWAKEFhirI6/Xqsr88svTDnTttNt1UgAAAAIO1BggtMM96ZJQxHkXf+/727TZL0xfLmI/6J/rY1DgBAAC2Wg2Mps7y+byS5zFAakGUeZO+u3VrOlsLkHLaxkKAAAAAGwESxhgdPUTmIMnStzdvttlKgJSLy1iE/Vm7CQAAcIgtGqC3Qh3KR2+FIuyvBsjtGzfa7L8DZBiLdhMAAOAQW2uANs4NUc+y3hBlLNeEsUjfXL/eZmOA1Gn9DOIfBgAAtlOLiW44K8HRxjk++nmWvr52rc2muKjx0UOjX1z0tRghcR8AADic1hpgrRV6ZJSxH0W4Nn119Wq7avqSAAEAAAZrDbDWCm0tBkjdCdem61eutKumLw0BsrTfOgAAsD1CUGyI0VHm/do2pi8vX94/QPrFRV+LERL3AQCAw2mtAdZaoUdGGdtRd8K16YtLl9pV05cECAAAMFhrgLVWaGtzgPR5kD6/eHFvJX+xnsQ/EO23DgAAbI9FVAzyXq2G5dikzy5cmL/d42NvIdy4x4cIAQCA7dUbYa0Vmv7Uo4xxXsdPz5+fv1lfvwrj8LhkLUDiPgAAcDitNUBogd4P3YEBcvHcufmbAgQAANiw1gChBWKA1FneK+MyPor0ydmz9awvlS/vbY9S/MMAAMBW2g1BEfVaKMExl8Pi2vTx6dN7Kz0++pgvjpcLEAAAIAZILYTcCTE46rxdM7xVlaWPTp0aVoaTRXCMXwUAALbRxmOJZWT0cSVC0rmTJ8PZ+G9493u0AgAA0A1vSuWGqGcr8VGkD0+cGFbmH6LXD69gAQAAowNfwcqGJx7LAPng+PFhJf6CfeMJiAABAACWUbHohH72Xr6uzvuYpTPHjo0B0sYSG3Ueb7YMEgAAYPssGqFHRteDZPU3IO8fPTpUxfAEJN64ECAAAMCiEzZes4pj3otXpzNHjqwGSF+Mm+OfAQAAttFaIwyt0J98tKOYxp2dfwEoAQQz3mrKJQAAAABJRU5ErkJggg==
endtext
strtofile (strconv(m.myvar,14),"a4.png")

*a5.png
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAyAAAAAoCAYAAAAGy56YAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAa9SURBVHhe7d3LbhxFFMbxMzNxnAtKAiGRUFihbECILWKRHWxZ8Qw8CQiJHW/CA7BhCSyQ2GUHiBBEFlEcErDH7uZ8p08VNfEYxR5Py5f/TypXdV16xok9rs8945n0zqTfM9t7arbz0OyvH83mj/z4mZfnPuZTJtOYBgAAAAD79J1nhonZ7IrZ1MvF22bXPvD6DT/e9Ak+po99N+8jbDy/b7b13RA8NGEyiwkAAAAAcGi6wNH9MwSQ6/fMLt81u3DDA8juVm9bP5g9/sZneWpp0gkAAAAAHJ3ni27b65nZqx+ZXXvfA8ijr3ub/2m2/ZsP6KlWF2IqAAAAAKzG84WuhMilt8w273gAefBVb3ueSrq/hwGufgAAAAA4Nt1QTV8xm132APLzZ8OL0AEAAABgzSb9L58TQAAAAACMwgPIFwQQAAAAAKOY9L9+2Vs/tyi2MbwInZeBAAAAAFhVvOVgN2SNTpmj8wBy/9O8AuJVr+QxHULIVLXeC0ShxOupgonejFD93he1jgEAAACcK3rTwRIsovbS7Xqtv3i147W341jzPGfoDQpTE0AOId4Z3U8SAUTBRIFFtQKLl7aOOap9HAAAAMDJpNBgHiAUGiJIqJ2hotOxwob6VDRnMVi8rKMFkMOoYUWlBBOFEV1BKQFFbfXleLnaEvMP/0kBAAAA51cJEL4Pb8NEXJFQyMgrEyp6WlQJHZMSC9a7/15/ADmSvEt6SlgJKRFGMqjUdo6pHcHG6/apYlEAAACA00Kbf98LKyzEU5cUEjIgKCjUKxBqK0T4nHrlQsFCx+OFiaM4oQFkVfkpRYDxELIQWLKtMi39KnkFpg01MVfnOHn/cQAAADiBIigoGCggZBgo4SECQjueY+UKRWmrPsEBYlVnNIAclxJkMoxEMMmQovAS/UtCTg01+oJRrXCTfWfwiwgAAOB00r6s2fRr66crDrVPVxbU1oCOs0SwUFG79GuelzMcHI4LAWRU+kJtQkn8pTEvvUKN90doUUhRX7ajv6xp+73E1ZklfQAAAGdO2fRrk+8ljlXnxj/abRjw8Zin4/bKg+pcG3M1zwt7qNEQQM4UfTPpm8dLPL0sA0oEEy8LoaYZXxZqou3loDWqowAAgPNJW0jtPcqGPjfzOq5XEZqibUOMe6kBwteUc9R5Wddzln4/Duw/TjsCCI5ADwgllOhQH7y0r6nRuNq6yqOxhVCT67R+X8DReI7FuPeVtVoTH7wdogMAgHMqt3B14+91bNKzP35ea/Oev/2PTXwOKRzU8VyvMdXq7zSu+RrPdvwZVs3TupwbQYKfxzgcAghOIX3J+oNdBBkFFNXq1gcPJxF6MrTEgJcIOnlYw5OvreHJq7pGxftqUPJSg5KXuHmN5byY2/TFd5S3434AAE612NhrI960RcfxG371NRv/GPY6Nu5qql0Cgh/X3/xrvGz8X5gb5y19/7NmuBPAqUMAAY5d/LTwSoFlaC5c6YnvOK/L0+Rieo6J5qo/+nSsw7I2+2Jqzlva54vac9Z5OffF24xOP4513tbYcMLlfQCwjz9WxAZZjxk61LHauXkeHniGusvjOs/nxLxUz5O1psfjlRoqbX/2xW/svV44Z46V2639fih1jWo1c065z9FdjssiAKsigAA4Aj1s+A/jGn5K2+u6SVCl4+yPvhJiVLv4QV/WZIlTt31Fe5tl3PviKpYrT/eLvmwfeBVK5xLNV3lhnu5XrC/jKkvU+19u+4B5rVjjddz/su5l5edWb3Od8t9o4f9wzeqmU7e95tvT7cRt5UZz3+2pL+9PDB90fzTopW5kl83TOcrnVsa1TmtEbe9fdp+iz4/j30Sa89dzan5z3rpGfVqX89RcuH85FrWKKs3z0v4fLGzSvU9D9XabeQDwkgggAAAAAEaz7l+hAQAAAEBFAAEAAAAwGgIIAAAAgNEQQAAAAACMhgACAAAAYDQEEAAAAACjIYAAAAAAGA0BBAAAAMBoCCAAAAAARkMAAQAAADAaAggAAACA0RBAAAAAAIyGAAIAAABgNFOb3TCbXPJmnwUAAAAAjknfefGcMbtqtnHLA8jlu964mQN7OQsAAAAAVqULHMoYXjZum119xwPIrU+88d4QProdH/QgAgAAAACr0pWPbneor75rdvNjm/TdvLfth2bPfjJ78q3Zzh9mk4teZrkKAAAAAA4pLnDMzTbfNHvtQ7Mrb5ttvO4BxNUJu1tm2w/Mnn7vQeR3s70nZnPv0yWTiV6vPompAAAAAPAfjxR6SYf+xtXGNYvXmW/eMbt+z+yi1zO95lxZwuxf8uD6yyMvGqMAAAAASUVORK5CYII=
endtext
strtofile (strconv(m.myvar,14),"a5.png")
**************

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
****
*this is a random color set to build gradients container picture.
rand(-1)
with _screen
.addproperty("tnRed",255*rand())
.addproperty("tnGreen",255*rand())
.addproperty("tnBlue",255*rand())
endwith

#define _width 610   &&this is the container width general setting  (can customize)
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 = "A basic vfp  accordion with gradient image"
yleft = 0
ybackg="a1.png"
Name = "Form1"

ADD OBJECT yexit1 as yexit WITH ;
Anchor=768,;
top=660,;
left=920,;
name="yexit1"

ADD OBJECT ycont AS ycont0 WITH ;
Top = 12, ;
Left = 0, ;
Width = _width, ;
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]
loObjectP=loObject.parent

with thisform.ycont
.height=750
for i=1 to .controlcount
if !lower(.controls(i).name)==lower(loObjectp.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
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
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 mye
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.parent.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.parent.backcolor=rgb(128,68,0)
ENDPROC

*myad method  &&a set of 7 buttons to command the accordion from the form
procedure myad
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.name,8)))
local m.u
m.u="this.ycont.yitem"+trans(m.x)+".command1.mousedown(1)"
=eval(m.u)	
endproc

PROCEDURE Resize
dodefault()
ENDPROC

PROCEDURE Init
_screen.windowstate=1
thisform.ybuild()
endproc

procedure ybuild()

with thisform
.addproperty("panelcount",7)  &&7 panels here
local m.xx,m.yy
m.xx=_width+10
m.yy=27
for i=1 to .panelcount
try
.ADDOBJECT("command"+trans(i),"commandbutton")
catch
endtry

with eval(".command"+trans(i))
.AutoSize = .T.
.Top = 0
.Height = 27
.Width = 27
.Left =m.xx+(i-1)*yy+1	
.FontBold = .T.
.Caption = trans(i)
.MousePointer = 15
.BackColor = RGB(128,255,0)
.Name = "Command"+trans(i)
.visible=.t.
endwith
bindevent(eval(".command"+trans(i)),"mousedown",thisform,"myad")
endfor
.width=thisform.panelcount*yy+27	
endwith

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

dodefault()
with _screen
.tnRed=255*rand()
.tnGreen=255*rand()
.tnBlue=255*rand()
endwith

for i=1 to thisform.panelcount
*thisform.ygrad(eval("this.ycont.yitem"+trans(i)+".command1"))
with  eval("this.ycont.yitem"+trans(i)+".command1")
.picture=thisform.ybackg
.refresh
endwith
endfor
ENDPROC

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

PROCEDURE 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 = 0
Left = 0
Width = _width
Height = 688
BorderWidth = 0
Name = "ycont0"

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

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

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

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

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

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

ADD OBJECT yitem7 AS yitem WITH ;
Top = 384, ;
Left = 0, ;
Width = _width, ;
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"

ADD object ycolors as shape with;
anchor=768,;
backcolor=255,;
curvature=25,;
left=200+20,;
top=500,;
width=100,;
height=30,;
mousepointer=15,;
tooltipText="change background 1-5",;
name="ycolors"

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

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

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

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

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

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

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

with .yitem7
.Top = 384
.Left = 0
.Width = _width
.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")
endwith

with this
for i=1 to .controlcount
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
rand(-1)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.left=1
.width=.parent.width-2

with .command1
.top=0
.left=0
.height=27+1
.width=_width
.label1.caption="This is my Panel"+trans(i)
.mousepointer=15
endwith
.height=32
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,7)
*rand(-1)
.addObject("image1","image")
with .image1
.stretch=2
.width=48
.height=48
.left=10
.mousepointer=15
.top=.parent.command1.top+.parent.command1.height+1    &&.parent.edit1.top+.parent.edit1.height+5
.picture=trans(i)+".png"
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

.addObject("ytitle","label")
with .ytitle
.left=.parent.image1.left+.parent.image1.width+5
.autosize=.t.
.fontsize=24
.backstyle=0
.mousepointer=15
.top=.parent.image1.top
.caption ="my title"+trans(i)+" here!"
.zorder(0)
.forecolor=255
.fontname="Tahoma"
.fontbold=.t.
.visible=.t.
endwith
bindevent(.image1,"mousedown",thisform,"my")

.addObject("edit1","editbox")
with .edit1
.width=.parent.width-2
.left=1
.top=.parent.image1.top+.parent.image1.height+1
.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. 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
.height=200
.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
endi
.refresh
endwith
endfor
endwith
ENDPROC

procedure ycolors.click
thisform.lockscreen=.t.
local m.x
m.x=int(val(substr(thisform.ybackg,2,1)))
if m.x<=4
m.x=m.x+1
else
m.x=1
endi
thisform.ybackg="a"+trans(m.x)+".png"

if file(thisform.ybackg)
for i=1 to thisform.panelcount
*thisform.ygrad(eval("this.ycont.yitem"+trans(i)+".command1"))
with  eval("thisform.ycont.yitem"+trans(i)+".command1")
.picture=thisform.ybackg
.refresh
endwith
endfor
endi

thisform.lockscreen=.f.
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 ycommand WITH ;
Top = 0, ;
Left = 0, ;
Height = 32, ;
Width = 253, ;
Name = "Command1"
ENDDEFINE
*
*-- EndDefine: yitem

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

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
*
DEFINE CLASS ycommand AS container
Top = 132
Left = 24
Width = 625
Height = 32
BackStyle = 1
BorderWidth = 1
Picture =""    &&can put here any custom image
Name = "ycommand"

ADD OBJECT label1 AS label WITH ;
FontBold = .f., ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Label1", ;
Height = 25, ;
Left = 192, ;
MousePointer = 15, ;
Top = 6, ;
Width = 181, ;
Name = "Label1"

ADD OBJECT image2 AS image WITH ;
Picture = home(1)+"graphics\bitmaps\outline\plus.bmp", ;
BackStyle = 0, ;
Height = 13, ;
Left = 597-10, ;
Top = 11, ;
Width = 13, ;
Name = "Image2"


procedure label1.mousedown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.parent.mousedown(1)
endproc

procedure image2.mousedown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.parent.mousedown(1)
endproc

ENDDEFINE
*
*-- EndDefine: ycommand


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 .

To be informed of the latest articles, subscribe:

Comment on this post