A navBar (navigation bar) vfp class part1
The original class was downloaded from UT , adapted ,and added some requirements.
*Original Author : Galanopoulos Emmanouil
Its a great class i not seen in vfp namespace as equal in the same subject.
this works as a sidebar or navigation bar embedding a complet menu ( as mnx mandatory here).
the menu can be customized by user (vfp menu designer) and the class does the rest.
It can works inside vfp with showWIndow=0,1 or as application desktop (shoWindow=2).
can enable vertical scroll with (form.scrollbars=2 ) but this is needed on particular cases when the container number items are great.
Some limitations:
menu accepts commands only (no procedure, no submenu).menu are mono items.
to avoid this i wrote some procedures called by the menu as command but in form class.
collapse/expand (at left screen/desktop or right).i made the form to move by mousedown on.collapsing is in principe for the navbar at screen left.be aware if you move the navbar you collapse the form but inside the screen/desktop.
form navbar can be showindow=0,1 or 2 (its a form) set at design time (readonly at runtime)
form scrollbars can be set to 0 or 2 (vertical) at design time (readonly at runtime)-
on need the form scrollbar appear at form right(if form.scrollbars=2).this can be used only if the containers count is great.
otherwise can navigate only with headers (accordion).
-no mpr but mnx to work.
-on rightclick on form...inbuilt submenu (hide or close).
-move the form by mousedown (if needed only)
-accepts picture background and headers.accepts icons in menu item (menu designer).
-can stylize with other pictures than native(gradients bmps...).i added 2*10 images styles built with previous gradients posts.
Important: the code below must work with images and custom menu mandatory.all is the below zip to download and run ynavbar.prg.Can compile an exe with the project attached(add a config.fpw file)
*Note: simple navbar.downloaded from https://www.levelextreme.com/ShowHeaderDownloadOneItem.aspx?ID=37303
Yousfi Benameur El Bayadh saturday 29 of april 2017
[Post 230]
Click on code to select [then copy] -click outside to deselect
*1* * original Navigation Bar downloaded from UT * Author : Galanopoulos Emmanouil - Owl_portf@yahoo.com * www.CurioSoftware.gr - Info@Curiosoftware.gr * License : Freeware Clea All Close All Close Data All Set Default To Addbs(Justpath(Sys(16,1))) &&(application.ActiveProject.HomeDir) Set Path To .\Sample,.\bitmaps,\bitmaps\styles *set Class to navbar Public navbar navbar=Createobject("NavBar") * Optional Settings ******************************************* navbar.GroupExpandType=1 && 1=Animated , 0=Not Animated navbar.GroupSpace=5 && Space in pixels between NavBar Groups navbar.SideMargin=10 && Side Margin in pixels for NavBar Groups navbar.TopMargin=10 && Top Margin in pixels for NavBar Groups navbar.Width=200 * MenuFile to convert to Navigation Bar ******************************************* with navbar .MenuFile=".\Sample\Sample" &&here is the use custom menu file as mnx(it used as table in code) .TitleBar=1 .InitNavBar() .TitleBar=0 .ycollapse() .ScrollBars=0 &&2 if too containers endwith Bindevent(_Screen,"resize",navbar,"resize") If navbar.ShowWindow=0 &&0,1,2 0,1 for vfp environment screen 2 for desktop app _Screen.WindowState=1 Endi Read Events Retu *below is the complet class with some adds *user have just to build the custom menu for navigation. Define Class groupitem_footer As Container Width = 169 Height = 8 BackStyle = 0 BorderWidth = 0 itemorder = .F. Name = "groupitem_footer" Add Object imgbackgroundc1 As Image With ; Picture = "bitmaps\navbaritem_footerc1.bmp", ; Height = 4, ; Left = 0, ; Top = 0, ; Width = 27, ; Name = "imgBackgroundC1" Add Object imgbackgroundc2 As Image With ; Anchor = 10, ; Picture = "bitmaps\navbaritem_footerc2.bmp", ; Stretch = 2, ; Height = 4, ; Left = 27, ; Top = 0, ; Width = 134, ; Name = "imgBackgroundC2" Add Object imgbackgroundc3 As Image With ; Anchor = 8, ; Picture = "bitmaps\navbaritem_footerc3.bmp", ; Height = 4, ; Left = 161, ; Top = 0, ; Width = 8, ; Name = "imgBackgroundC3" Enddefine * *-- EndDefine: groupitem_footer * Define Class groupitem_label As Container Width = 169 Height = 23 itemorder = 0 Command = .F. Name = "groupitem_label" Add Object imgbackgroundc2 As Image With ; Anchor = 10, ; Picture = "bitmaps\navbaritem_labelc2.bmp", ; Stretch = 2, ; Height = 27, ; Left = 26, ; Top = 0, ; Width = 135, ; Name = "imgBackgroundC2" Add Object imgbackgroundc1 As Image With ; Picture = "bitmaps\navbaritem_labelc1.bmp", ; Height = 27, ; Left = 0, ; Top = 0, ; Width = 27, ; Name = "imgBackgroundC1" Add Object imgbackgroundc3 As Image With ; Anchor = 8, ; Picture = "bitmaps\navbaritem_labelc3.bmp", ; Height = 27, ; Left = 161, ; Top = 0, ; Width = 8, ; Name = "imgBackgroundC3" Add Object shape1 As Shape With ; Top = 3, ; Left = 28, ; Height = 19, ; Width = 137, ; Anchor = 10, ; BackStyle = 1, ; FillStyle = 0, ; Visible = .F., ; FillColor = Rgb(150,150,150), ; BorderColor = Rgb(100,100,100), ; Name = "Shape1" Add Object label1 As Label With ; FontName = "MS Sans Serif", ; Anchor = 10, ; BackStyle = 0, ; Caption = "Label1", ; Height = 17, ; Left = 33, ; MousePointer = 15, ; Top = 6, ; Width = 128, ; Name = "Label1" Add Object imgicon1 As Image With ; BackStyle = 0, ; Height = 16, ; Left = 5, ; Top = 5, ; Visible = .F., ; Width = 16, ; Name = "imgIcon1" Procedure label1.MouseEnter Lparameters nButton, nShift, nXCoord, nYCoord This.ForeColor=Rgb(255,255,255) This.Parent.shape1.Visible=.T. Endproc Procedure label1.MouseLeave Lparameters nButton, nShift, nXCoord, nYCoord This.ForeColor=Rgb(0,0,0) This.Parent.shape1.Visible=.F. Endproc Procedure label1.Click Execscript(This.Parent.Command) Endproc Enddefine * *-- EndDefine: groupitem_label * Define Class groupitem_seperator As Container Width = 169 Height = 12 BackStyle = 0 BorderWidth = 0 itemorder = 0 Name = "groupitem_seperator" Add Object imgbackgroundc1 As Image With ; Picture = "bitmaps\navbaritem_labelc1.bmp", ; Height = 27, ; Left = 0, ; Top = 0, ; Width = 27, ; Name = "imgBackgroundC1" Add Object imgbackgroundc2 As Image With ; Anchor = 10, ; Picture = "bitmaps\navbaritem_labelc2.bmp", ; Stretch = 2, ; Height = 27, ; Left = 27, ; Top = 0, ; Width = 134, ; Name = "imgBackgroundC2" Add Object imgbackgroundc3 As Image With ; Anchor = 8, ; Picture = "bitmaps\navbaritem_labelc3.bmp", ; Height = 27, ; Left = 161, ; Top = 0, ; Width = 8, ; Name = "imgBackgroundC3" Add Object line1 As Line With ; Anchor = 10, ; Height = 0, ; Left = 33, ; Top = 6, ; Width = 128, ; Name = "Line1" Enddefine * *-- EndDefine: groupitem_seperator * Define Class navbar As Form BorderStyle = 0 Top = 0 Left = 0 Height = 700 Width = 230 ShowWindow = 2 DoCreate = .T. Picture = "bitmaps\styles\v9.jpg" Caption = "Form" TitleBar = 0 AlwaysOnTop = .T. *-- DockSide L=Left,R=Right dockside = "L" normalwidth = 0 TopMargin = 10 SideMargin = 10 GroupSpace = 5 *-- 0=Instant Expand/Collapse, 1=Animated Expand/Collapse GroupExpandType = 1 navbarposy = -1 MenuFile = .F. ycount = 0 ScrollBars=2 Name = "navbar" Add Object groupcontainer As yGroupContainer With ; Top = 40, ; Left = 0, ; Width = 220, ; Height = 400, ; BackStyle = 0, ; Name = "GroupContainer" Add Object splittercontainer As ysplittercontainer With ; Top = 28, ; Left = 219, ; Width = 12, ; Height = 406, ; BackStyle = 0, ; Name = "SplitterContainer" Procedure groupposition ntop=This.TopMargin nWidth=This.Width-(This.SideMargin*2)-This.splittercontainer.Width For N=1 To This.oGroup.Count This.oGroup.Item[n].Top=ntop This.oGroup.Item[n].Left=This.SideMargin This.oGroup.Item[n].Width=nWidth ntop=ntop+This.oGroup.Item[n].Height+This.GroupSpace This.oGroup.Item[n].Anchor=10 Endfor This.groupcontainer.Height=ntop Endproc Procedure groupvposition * Group Vertical Position ntop=This.TopMargin For N=1 To This.oGroup.Count This.oGroup.Item[n].Top=ntop ntop=ntop+This.oGroup.Item[n].Height+This.GroupSpace Endfor This.groupcontainer.Height=ntop Endproc Procedure InitNavBar * NavBar This.menutonavbar() This.Top=0 This.Left=Iif(This.dockside="L",0,_Screen.Width-This.normalwidth) If Thisform.ShowWindow=2 This.Height=Sysmetric(2)-50 Else This.Height=_Screen.Height Endi This.normalwidth=This.Width This.BackColor=Rgb(240,240,240) With This.splittercontainer .command1.Top=-1 .command1.Width=14 .command1.Left=-1 .command1.Height=This.Height+2 .command1.Anchor=13 .Top=0 .Width=12 .Left=This.Width-This.splittercontainer.Width .Height=This.Height .BorderWidth=0 .Anchor=13 Endwith With This.groupcontainer .BorderWidth=0 .Left=0 .Top=0 .Width=This.Width-This.splittercontainer.Width .Anchor=10 Endwith * Navigation Bar Groups Thisform.AddObject("oGroup","Collection") For N=1 To This.groupcontainer.ControlCount For n1=1 To This.groupcontainer.ControlCount If Lower(This.groupcontainer.Controls(n1).Class)="navbar_group" And This.groupcontainer.Controls(n1).GroupOrder=N Thisform.oGroup.Add(This.groupcontainer.Controls(n1)) Exit Endif Endfor Endfor Thisform.groupposition() This.Visible=.T. This.splittercontainer.command1.SetFocus() Endproc Procedure menutonavbar * Menu To NavBar This.MenuFile=This.MenuFile+".mnx" If File(This.MenuFile)=.F. Messagebox("Menu File Not Found") Return .F. Endif nItem=1 nGroup=1 Use (This.MenuFile) In 0 Again Shared Alias menutonavbar Select menutonavbar Scan If menutonavbar.objcode=77 And menutonavbar.LevelName="_MSYSMENU" * Add NavBar Group cGroupName="NavBAr_Group"+Alltrim(Str(nGroup)) This.groupcontainer.AddObject(cGroupName,"NavBar_Group") This.groupcontainer.&cGroupName..GroupOrder=nGroup This.groupcontainer.&cGroupName..header1.label1.Caption=menutonavbar.Prompt Skip nItem=1 cLevelName=menutonavbar.LevelName Do While menutonavbar.LevelName=cLevelName Do Case Case menutonavbar.objcode=67 && Item cItemName="Item"+Alltrim(Str(nItem)) This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Label") This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem This.groupcontainer.&cGroupName..&cItemName..label1.Caption=menutonavbar.Prompt This.groupcontainer.&cGroupName..&cItemName..Command=menutonavbar.Command If !Empty(menutonavbar.resname) This.groupcontainer.&cGroupName..&cItemName..imgicon1.Picture=menutonavbar.resname This.groupcontainer.&cGroupName..&cItemName..imgicon1.Visible=.T. Endif This.groupcontainer.&cGroupName..&cItemName..Visible=.T. nItem=nItem+1 Case menutonavbar.objcode=78 && Seperator cItemName="Item"+Alltrim(Str(nItem)) This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Seperator") This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem This.groupcontainer.&cGroupName..&cItemName..Visible=.T. nItem=nItem+1 Endcase Skip Enddo * Add Footer If nItem>1 cItemName="Item"+Alltrim(Str(nItem)) This.groupcontainer.&cGroupName..AddObject(cItemName,"GroupItem_Footer") This.groupcontainer.&cGroupName..&cItemName..itemorder=nItem This.groupcontainer.&cGroupName..&cItemName..Visible=.T. Endif This.groupcontainer.&cGroupName..InitGroup() nGroup=nGroup+1 Skip -1 Endif Endscan Use In menutonavbar Thisform.ycount=This.groupcontainer.ControlCount Endproc Procedure yhelp Local m.myvar TEXT to m.myvar pretext 7 noshow The original class was downloaded from UT , adapted ,and added some requirements. *Author : Galanopoulos Emmanouil Its a great class i not seen in vfp namespace as equal in the same subject. this works as a sidebar or navigation bar embedding a complet menu ( as mnx mandatory here). the menu can be customized by user and the class does the rest. It can works inside vfp with showWIndow=0,1 or as application desktop (shoWindow=2). can enable vertical scroll with (form.scrollbars=2 ) but this is needed on particular cases when the container number items are great. Some limitations: menu accepts commands only (no procedure, no submenu).menu are mono items to avoid this i wrote some procedure called by the menu as command but in form class. collapse/expand (at left screen/desktop or right).i made the form to move by mousedown on.collapsing is in principe for the for at screen left.be aware if you move the form you collapse th form but inside the screen. form navbar can be showindow=0,1 or 2 (its a form). at design time 'readonly) form scrollbars can be set to 0 or 2 (vertical) at design time (readonly at runtime)- on need the form scrollbar appear at form right(if scrollbrs=2).this can be used only if the containers count is great. otherwise can navigate only with headers. no mpr but mnx to work. on rightclick on form...inbuilt submenu (hide or close) move the form by mousedown (if needed only) accepts picture background can stylize with other picture than native(gradients bmps...)i added 10 images styles built with previous gradients posts. the code below must work with images and custom menu manadatory.all is the below zip download. Yousfi Benameur El Bayadh saturday 29 of april 2017 ENDTEXT Local oshell oshell = Createobject('WScript.Shell') oshell.Popup(m.myvar,0, 'a Wscript.Shell big message', 0+32+4096) &&4,16,48,64... oshell=Null Endproc Procedure ycollapse Try With navbar.groupcontainer *.NavBAr_Group2.header1.shape1.click .NavBAr_Group2.header1.shape1.Click .NavBAr_Group3.header1.shape1.Click .NavBAr_Group4.header1.shape1.Click Endwith Catch Endtry Endproc Procedure ystyle Local m.x m.x=Int(Val(Inputbox("Apply style:0 native... 1-10","","1"))) If ! Between(m.x,0,10) m.x=1 Endi If m.x=0 For i=1 To Thisform.ycount m.y=Eval("navbar.GroupContainer.NavBAr_Group"+Trans(i)+".header1.imgHighLight") Y.Picture='bitmaps\navbarheader_highlight.bmp' Endfor Thisform.Picture="bitmaps\NavBarBackground.bmp" Else For i=1 To Thisform.ycount m.y=Eval("navbar.GroupContainer.NavBAr_Group"+Trans(i)+".header1.imgHighLight") Y.Picture='bitmaps\styles\h'+Trans(m.x)+'.jpg' Endfor Thisform.Picture='bitmaps\styles\v'+Trans(x)+".jpg" Endi Endproc Procedure Resize If Thisform.ShowWindow=2 This.Height=Sysmetric(2)-50 This.Height=_Screen.Height Endi * NavBar If This.groupcontainer.Top<0 ; and This.groupcontainer.Height+This.groupcontainer.Top<This.Height This.groupcontainer.Top=Min(This.Height-This.groupcontainer.Height,0) Endif Endproc Procedure RightClick Define Popup shortcut shortcut Relative From Mrow(),Mcol() Define Bar 1 Of shortcut Prompt "Hide" Define Bar 2 Of shortcut Prompt "\-" Define Bar 3 Of shortcut Prompt "Close" On Selection Bar 1 Of shortcut navbar.splittercontainer.command1.Click() On Selection Bar 3 Of shortcut navbar.Release() Activate Popup shortcut Endproc Procedure MouseDown Lparameters nButton, nShift, nXCoord, nYCoord Thisform.MousePointer=15 lnHandle = Thisform.HWnd param1 = 274 param2 = 0xF012 Declare Integer ReleaseCapture In WIN32API Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer bb=ReleaseCapture() bb=SendMessage(lnHandle, param1, param2,0) Thisform.MousePointer=0 Endproc Procedure Destroy Clea Events Endproc Enddefine * *-- EndDefine: navbar * Define Class navbar_group As Container Width = 180 Height = 180 BackStyle = 0 BorderWidth = 0 GroupOrder = 0 expandedheight = .F. Degrees = 80 groupexpanded = .T. timerresizestep = .F. timerdone = .F. timerlock = .F. Name = "navbar_group" Add Object header1 As yHeader1 With ; Top = 0, ; Left = 0, ; Width = 180, ; Height = 30, ; BackStyle = 0, ; BorderWidth = 0, ; Name = "Header1" Add Object timer1 As Timer With ; Tag = "expanded", ; Top = 39, ; Left = 6, ; Height = 23, ; Width = 23, ; Enabled = .F., ; Name = "Timer1" Procedure InitGroup With This.header1 .Top=0 .Left=0 .Width=This.Width .Anchor=11 .shape1.Top=4 .shape1.Left=0 .shape1.Width=This.header1.Width .shape1.Height=This.header1.Height-4 .shape1.BorderStyle=0 .shape1.Anchor=15 Endwith * Item Order This.AddObject("oItems","Collection") For N=1 To This.ControlCount For n1=1 To This.ControlCount If (Lower(This.Controls(n1).Class)="groupitem_label" ; or Lower(This.Controls(n1).Class)="groupitem_seperator" ; or Lower(This.Controls(n1).Class)="groupitem_footer") ; and This.Controls(n1).itemorder=N This.oItems.Add(This.Controls(n1)) Exit Endif Endfor Endfor * Item Position nHeight=This.header1.Height For N=1 To This.oItems.Count This.oItems.Item[n].Top=nHeight This.oItems.Item[n].Left=0 This.oItems.Item[n].Width=This.Width This.oItems.Item[n].Anchor=10 nHeight=nHeight+This.oItems.Item[n].Height Endfor This.Height=nHeight This.expandedheight=nHeight This.Visible=.T. Endproc Procedure paintbackground Endproc Procedure addgradient Endproc Procedure timer1.Init This.Parent.timerresizestep=16 This.Interval=12 Endproc Procedure timer1.Timer * Expand / Collapse If This.Parent.timerdone=.F. If This.Parent.groupexpanded=.T. * Collapse nHeight=This.Parent.Height-This.Parent.timerresizestep If This.Parent.Degrees>10 And This.Parent.Height<48+This.Parent.header1.Height This.Parent.Degrees=This.Parent.Degrees-5 Max(This.Parent.Degrees,10) This.Parent.timerresizestep=Ceiling(4*(1-Cos(Dtor(This.Parent.Degrees)))) Endif If nHeight<=This.Parent.header1.Height nHeight=This.Parent.header1.Height This.Parent.Degrees=80 This.Parent.timerresizestep=16 This.Parent.groupexpanded=.F. This.Parent.timerdone=.T. This.Enabled=.F. Endif Else * Expand nHeight=This.Parent.Height+This.Parent.timerresizestep If This.Parent.Degrees>10 And This.Parent.Height>This.Parent.expandedheight-48 This.Parent.Degrees=This.Parent.Degrees-5 Max(This.Parent.Degrees,10) This.Parent.timerresizestep=Ceiling(4*(1-Cos(Dtor(This.Parent.Degrees)))) Endif If nHeight>=This.Parent.expandedheight nHeight=This.Parent.expandedheight This.Parent.Degrees=80 This.Parent.timerresizestep=16 This.Parent.groupexpanded=.T. This.Parent.timerdone=.T. This.Enabled=.F. Endif Endif This.Parent.Height=nHeight Thisform.groupvposition() Endif Endproc Enddefine * *-- EndDefine: navbar_group Define Class yGroupContainer As Container Top = 40 Left = 0 Width = 220 Height = 400 BackStyle = 0 Name = "yGroupContainer" Procedure MouseEnter Lparameters nButton, nShift, nXCoord, nYCoord If This.Height>This.Parent.Height This.MousePointer=7 Else This.MousePointer=0 Endif Endproc Procedure MouseMove Lparameters nButton, nShift, nXCoord, nYCoord If This.Parent.navbarposy>-1 And Mrow(_Screen.Name,3)>0 nNavBarTop=Mrow(_Screen.Name,3)-This.Parent.navbarposy * Top Limit nNavBarTop=Min(nNavBarTop,0) * Bottom Limit If This.Height>This.Parent.Height If This.Height+nNavBarTop<This.Parent.Height nNavBarTop=This.Parent.Height-This.Height Endif Endif This.Top=nNavBarTop Endif Endproc *!*Procedure RightClick *!*Do navbar.mpr *!*Endproc Procedure MouseDown Lparameters nButton, nShift, nXCoord, nYCoord If This.MousePointer=7 And nButton=1 This.Parent.navbarposy=Mrow(Thisform.Name,3)-This.Top Endif Endproc Procedure MouseUp Lparameters nButton, nShift, nXCoord, nYCoord This.Parent.navbarposy=-1 Endproc Enddefine *-- EndDefine:yGroupContainer Define Class ysplittercontainer As Container Add Object image1 As Image With ; Anchor = 15, ; Picture = "bitmaps\navbarsplitterc2.bmp", ; Stretch = 2, ; Height = 398, ; Left = 0, ; Top = 0, ; Width = 12, ; Name = "Image1" Add Object command1 As CommandButton With ; Top = 8, ; Left = 1, ; Height = 27, ; Width = 9, ; Caption = "Command1", ; Style = 1, ; TabStop = .F., ; Name = "Command1" Procedure command1.Click If This.Parent.Parent.Width>This.Parent.Width This.Parent.Parent.Width=This.Parent.Width Else This.Parent.Parent.Width=This.Parent.Parent.normalwidth Endif Endproc Enddefine * *--EndDefine :ysplittercontainer Define Class yHeader1 As Container Add Object imgbackgroundt2a As Image With ; Anchor = 10, ; Picture = "bitmaps\navbarheadert2.bmp", ; Stretch = 2, ; Height = 30, ; Left = 16, ; Top = 0, ; Width = 148, ; Name = "ImgBackgroundT2A" Add Object imgbackgroundt1a As Image With ; Anchor = 2, ; Picture = "bitmaps\navbarheadert1.bmp", ; Height = 30, ; Left = 0, ; Top = 0, ; Width = 16, ; Name = "ImgBackGroundT1A" Add Object imgbackgroundt3a As Image With ; Anchor = 8, ; Picture = "bitmaps\navbarheadert3.bmp", ; Height = 30, ; Left = 164, ; Top = 0, ; Width = 16, ; Name = "ImgBackGroundT3A" Add Object imghighlight As Image With ; Anchor = 15, ; Picture = "bitmaps\navbarheader_highlight.bmp", ; Stretch = 2, ; Height = 30, ; Left = 1, ; Top = 0, ; Visible = .F., ; Width = 178, ; Name = "ImgHighLight" Add Object label1 As Label With ; FontBold = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Label1", ; Height = 17, ; Left = 6, ; Top = 11, ; Width = 167, ; Name = "Label1" Add Object shape1 As Shape With ; Top = 0, ; Left = 0, ; Height = 16, ; Width = 84, ; BackStyle = 0, ; BorderStyle = 1, ; MousePointer = 15, ; Name = "Shape1" Procedure shape1.Click Do Case Case This.Parent.Parent.Parent.Parent.GroupExpandType=0 * instant Expand / Collapse If This.Parent.Parent.groupexpanded=.T. This.Parent.Parent.Height=This.Parent.Height This.Parent.Parent.groupexpanded=.F. Else This.Parent.Parent.Height=This.Parent.Parent.expandedheight This.Parent.Parent.groupexpanded=.T. Endif Thisform.groupvposition() Case This.Parent.Parent.Parent.Parent.GroupExpandType=1 * Animated Groups This.Parent.Parent.timerdone=.F. This.Parent.Parent.timer1.Enabled=.T. Endcase Endproc Procedure shape1.MouseLeave Lparameters nButton, nShift, nXCoord, nYCoord This.Parent.imghighlight.Visible=.T. &&.f. This.Parent.label1.ForeColor=Rgb(0,0,0) Endproc Procedure shape1.MouseEnter Lparameters nButton, nShift, nXCoord, nYCoord This.Parent.imghighlight.Visible=.T. This.Parent.label1.ForeColor=Rgb(255,255,255) Endproc Enddefine * *EndDefine:yHeader1
see also http://yousfi.over-blog.com/2016/01/a-configurable-desktop-calendar.html adpated from same author.
Download the zip ,unzip and run ynavbar.prg-can build a project and compile an exe application as in the zip (ynavbar.exe)
Note : the zip above i updated with a complet project. 01 of may 2017.
Important:All Codes above are tested on VFP9SP2 & windows 10 pro.