A navBar (navigation bar) vfp class part2

Published on by Yousfi Benameur


This is the continuation of the previous part1 applied to a desktop app.
This Code builds a Top Level Form without TitleBar And Subclass it By a Container With Some Controls.
the navbar Is As Level Form (ShowWindow=1 inside the Main Form) And Docked To Left (can be At Right In Code)
the navbar Is arranged To be positioned inside the Form And At Bottom Of the TitleBar.
the TitleBar have more than What Native can give(can Move the Form By MouseDown, reduce,maximize,restore,Close..)
i added also Some Controls As
-playing Some Screen savers(3 the First 0--20s, the Second 21-40Sec the third 41-59s Of one Minute calculated
In Datetime() Function).Of course bubbles.scr,ribbons.scr,ssText3d.scr must be On Windows System Otherwise Change By others.
-settings one Of 10 styles (TitleBar And Form imags)
-increase/decrease the TitleBar Height by a Spinner
-playing With Tabs (1-5) To fire another PageFrame On Form With Some web demo images (no disc Access).internet must be
connected here.
-drawing a vfp Grid (Hide/Show)
-embedding a monthview (draggable By MouseDown On Form)--hide/show by click on red circular  shape.
the Code Runs a Child Form From shape On TitleBar.it can stylized As well With 10 images styles.its movale And can desserve To embed any vfp Controls (Or olecontrols).its Movable By MouseDown And Resizable.
warning: this code below must run in its context (ynavbar_class.prg,images, menu...) as in the zip attached.there is a complet project and a compiled exe as desktop application.Can customize all objects here.

[post231]


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


*1* created on tuesday 02 of may 2017
*must run in its context(ynavbar_class.prg,images,menu...)-work with the zip below.

If !_vfp.StartMode=0
	On Shutdown Quit
Endi

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
	Top = 0
	Left = 0
	Height = 576
	Width = 976
	ShowWindow = 2
	ShowTips = .T.
	Picture = "bitmaps\styles\v1.jpg"
	Caption = "Form1"
	navbar = .F.
	xleft = .F.
	xtop = .F.
	xwidth = .F.
	xheight = .F.
	yto = 0
	ocap=.F.
	Name = "YMAIN"

	Add Object container1 As ycont With ;
		Anchor = 768, ;
		Top = -4, ;
		Left = 1, ;
		Width = 937, ;
		Height = 76, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "Container1"

	Add Object grid1 As Grid With ;
		Height = 348, ;
		Left = 288, ;
		Top = 144, ;
		Width = 624, ;
		Name = "Grid1"

	Add Object olecontrol1 As ycalendar
	Name="olecontrol1"

	Add Object pageframe1 As ypframe With ;
		PageCount = 5, ;
		Top = 84, ;
		Left = 198, ;
		Width = 768, ;
		Height = 540, ;
		SpecialEffect = 2, ;
		Tabs = .F., ;
		Visible = .F., ;
		Themes = .F., ;
		Name = "Pageframe1", ;
		Page1.Caption = "Page1", ;
		Page1.Name = "Page1", ;
		Page2.Caption = "Page2", ;
		Page2.Name = "Page2", ;
		Page3.Caption = "Page3", ;
		Page3.Name = "Page3", ;
		Page4.Caption = "Page4", ;
		Page4.Name = "Page4", ;
		Page5.Caption = "Page5", ;
		Page5.Name = "Page5"

	Procedure ypgf
	Lparameters x
	Thisform.pageframe1.Visible=.T.
	Thisform.grid1.Visible=.F.
	Thisform.pageframe1.ActivePage=x

	If !Vartype(Thisform.pageframe1.Pages(x).image1)="O"
		Thisform.pageframe1.Pages(x).AddObject("image1","image")
	Endi
	With Thisform.pageframe1.Pages(x).image1
		.Visible=.T.
		.Left=10
		.Top=10
		.Width=.Parent.Parent.Width-20
		.Height=.Parent.Parent.Height-20

		Sele yhm
		Try
			Skip
		Catch
			Locate
		Endtry
		If Empty(ximage)
			Locate
		Endi
		.Stretch=2
		.PictureVal=Thisform.yloadImg(ximage)
		.Parent.Refresh
	Endwith
	Endproc

	Procedure yloadImg
*internet must be connected
	Lparameters lcURl
	Local loRequest
	m.loRequest = Createobject('MsXml2.XmlHttp')
	m.loRequest.Open("GET",lcURl,.F.)
	m.loRequest.Send()
	Return(m.loRequest.ResponseBody	)
	m.loRequest=Null
	Endproc

	Procedure Destroy
	navbar=Null
	Release navbar
	ychild1=Null
	Release ychild1
	ymain=Null
	Release ymain
	Clea Events
	Endproc

	Procedure Activate
	If Thisform.yto=1
		Return .F.
	Endi

	Set Path To .\Sample,.\bitmaps,.\bitmaps\styles
*set Class to navbar
*set classlib to locfile("navbar.vcx","vcx") addi
	Set Proc To ynavbar_class AddI
	Public navbar
	Thisform.navbar=Createobject("NavBar")
	navbar=Thisform.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")

	Release Proc ynavbar_class
	Thisform.yto=1
	Thisform.WindowState=2
	Endproc

	Procedure Init
	Set Defa To Addbs(Justpath(Sys(16,1)))
	_Screen.WindowState=1
	Publi ymain,ychild1 As Form

	With Thisform
		.TitleBar=0
		.xleft=.Left
		.xtop=.Top
		.xwidth=.Width
		.xheight=.Height
	Endwith
	Endproc

	Procedure Resize
	With This.container1
		.Left=0
		.Top=0
		.Width=.Parent.Width
		.ZOrder(0)
	Endwith

	Try
		navbar.Top=Thisform.container1.Top+Thisform.container1.Height
	Catch
	Endtry
	Endproc

	Procedure Load
	Close Data All
	If _vfp.StartMode=0
		Sele * From Home(1)+"samples\data\customer" Into Cursor ucurs
	Else
		Create Cursor ucurs (xfield1 c(20),xfield2 c(30),xfield3 c(60))  &&security access to customer.dbf in exe !
		For i=1 To 30
			Insert Into ucurs Values ("azezrerrrerererererdsds","gghghghhghhghghggg2030", Repli("Wsd12",15))
		Endfor
	Endi

	Create Cursor yhm (ximage c(200))
	Insert Into yhm Values("https://lh3.googleusercontent.com/F2wrS38HmZz5hmKl7fWKbgx5xnVmwbCj-8cNbOd3JqnKj2y9kKVwK3N4ncaHr7R4VXrAtzmqwFbA5FM4q1hG6_ClLOoMuhCq=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/OtT3A1-Z7ljqlnVdFc20gHl_Fp37qmhwu0N_gFYajzS6wQ_0393FFA6bbQ76Dsrq4sG2GWrfqzfujOpFnE1g4v65W6n2rVJb=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/yvBTsFA9q2Ahxv6QT24CWzYuisyk_G9zAmzDH3Tv5WPKbL9WCyYPgmafl-pnP2Ccz8iLmGHSdrD_FWKIdZFqxHhIo1fwMujG=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/UA9TO-BnbRXfSLNvfDB--VRR6t9-zYukvIxXqwfs1tBdqO8jK4PKmZ9rwFhZdcsF6X05nq-6tPFF9rPhb59HPbeuJggW677s=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/eWp1G7UtJLHkgAm4rRWKLCY3uPoa8S9L-UJ6GIrVdLcDld-SZSJc2LHwzJbHLGKNWzajV7OwQVffA9654DmhxMPy2aEeUBBK=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/YzL0sxgqjh0fPHiXADB_-7Y8d1BvC5AGAN6Qk6W3ytvFJrB0Hfjq2y_2kpxpl5A6BzaK7tLiHjdoClFzmuC9x7INfKSHkiYN=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/oeVq3QdGMiD44xvfuU80yvnTN0AoJPfMok47bjYHsjOADrNOQC3hCjC6Jd5zSr1CZl3cQvijK1xxk72jOFJYYBi0IYnZYqYo=w293-h220")
	Insert Into yhm Values("https://lh3.googleusercontent.com/c5q_4_7dUZ0zbmTF_QtWIvgoCHNxKvguT3SGDBQ3lkl9Z6ZwtOyW3JParpyZbrEjpnQO1jahmwpV9fnA1hlh9tZdb5wBaKzP=w293-h220")
	Sele yhm
	Locate
	Sele ucurs
	Locate
	Endproc

	Procedure grid1.Init
	With This
		Sele ucurs
		.RecordSource=""
		.RecordSource="ucurs"
		.RecordSourceType=1
		.DeleteMark=.F.
		.GridLines=0
		.FontBold=.T.
		For i=1 To .ColumnCount
			.Columns(i).header1.BackColor=0
			.Columns(i).header1.ForeColor=255
			.Columns(i).header1.FontSize=12
		Endfor
		.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(145,55,105)  , RGB(100,175,40))", "Column")
		Sele ucurs
		Locate
		.Refresh
	Endwith
	Endproc

	Procedure pageframe1.Init
	With This
		For i=1 To .PageCount
			.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endfor
	Endwith
	Endproc

	Procedure yfo
	Thisform.container1.shape2.Click()
	Endproc

Enddefine
*
*-- EndDefine: asup
*
Define Class ycont As Container
	Anchor = 768
	Top = -4
	Left = 1
	Width = 937
	Height = 76
	BackStyle = 0
	BorderWidth = 0
	Name = "Container1"

	Add Object image1 As Image With ;
		Anchor = 15, ;
		Picture = "bitmaps\styles\h5.jpg", ;
		Stretch = 2, ;
		Height = 73, ;
		Left = 0, ;
		Top = 0, ;
		Width = 973, ;
		BorderColor = Rgb(255,255,255), ;
		Name = "Image1"

	Add Object command1 As CommandButton With ;
		AutoSize = .T., ;
		Top = 4, ;
		Left = 907, ;
		Height = 27, ;
		Width = 28, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "X", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object command2 As CommandButton With ;
		AutoSize = .F., ;
		Top = 4, ;
		Left = 850, ;
		Height = 27, ;
		Width = 27, ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 768, ;
		Caption = "-", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command2"

	Add Object command3 As CommandButton With ;
		AutoSize = .F., ;
		Top = 4, ;
		Left = 878, ;
		Height = 27, ;
		Width = 27, ;
		FontBold = .T., ;
		FontName = "Webdings", ;
		FontSize = 10, ;
		Anchor = 768, ;
		Caption = "1", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command3"

	Add Object YMEN As  CommandGroup With ;
		AutoSize = .T. , ;
		ButtonCount = 3, ;
		BorderStyle = 0, ;
		Value = 1, ;
		Height = 37, ;
		Left = 79, ;
		Top = 5, ;
		Width = 42, ;
		BackColor = Rgb(255,128,64), ;
		Name = "ymen", ;
		command1.Top = 5, ;
		command1.Left = 5, ;
		command1.Height = 10, ;
		command1.Width = 32, ;
		command1.Caption = "", ;
		command1.ToolTipText="Collapse/expand navbar",;
		command1.Name = "Command1", ;
		command2.Top = 13, ;
		command2.Left = 5, ;
		command2.Height = 10, ;
		command2.Width = 32, ;
		command2.Caption = "", ;
		command2.ToolTipText="Collapse/expand navbar",;
		command2.Name = "Command2", ;
		command3.Top = 22, ;
		command3.Left = 5, ;
		command3.Height = 10, ;
		command3.Width = 32, ;
		command3.Caption = "", ;
		command3.ToolTipText="Collapse/expand navbar",;
		command3.Name = "Command3"


	Add Object optiongroup1 As OptionGroup With ;
		AutoSize = .T., ;
		ButtonCount = 10, ;
		BackStyle = 0, ;
		Value = 1, ;
		Height = 27, ;
		Left = 143, ;
		Top = 8, ;
		Width = 222, ;
		Name = "Optiongroup1", ;
		Option1.Caption = "", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Style = 0, ;
		Option1.Top = 5, ;
		Option1.Width = 68, ;
		Option1.AutoSize = .F., ;
		Option1.Name = "Option1", ;
		Option2.Caption = "", ;
		Option2.Height = 17, ;
		Option2.Left = 25, ;
		Option2.Style = 0, ;
		Option2.Top = 5, ;
		Option2.Width = 68, ;
		Option2.AutoSize = .F., ;
		Option2.Name = "Option2", ;
		Option3.Caption = "", ;
		Option3.Height = 17, ;
		Option3.Left = 47, ;
		Option3.Style = 0, ;
		Option3.Top = 5, ;
		Option3.Width = 68, ;
		Option3.AutoSize = .F., ;
		Option3.Name = "Option3", ;
		Option4.Caption = "", ;
		Option4.Height = 17, ;
		Option4.Left = 70, ;
		Option4.Style = 0, ;
		Option4.Top = 5, ;
		Option4.Width = 68, ;
		Option4.AutoSize = .F., ;
		Option4.Name = "Option4", ;
		Option5.Caption = "", ;
		Option5.Height = 17, ;
		Option5.Left = 89, ;
		Option5.Style = 0, ;
		Option5.Top = 5, ;
		Option5.Width = 68, ;
		Option5.AutoSize = .F., ;
		Option5.Name = "Option5", ;
		Option6.Caption = "", ;
		Option6.Height = 17, ;
		Option6.Left = 110, ;
		Option6.Style = 0, ;
		Option6.Top = 5, ;
		Option6.Width = 68, ;
		Option6.AutoSize = .F., ;
		Option6.Name = "Option6", ;
		Option7.Caption = "", ;
		Option7.Height = 17, ;
		Option7.Left = 131, ;
		Option7.Style = 0, ;
		Option7.Top = 5, ;
		Option7.Width = 68, ;
		Option7.AutoSize = .F., ;
		Option7.Name = "Option7", ;
		Option8.Caption = "", ;
		Option8.Height = 17, ;
		Option8.Left = 149, ;
		Option8.Style = 0, ;
		Option8.Top = 5, ;
		Option8.Width = 68, ;
		Option8.AutoSize = .F., ;
		Option8.Name = "Option8", ;
		Option9.Caption = "", ;
		Option9.Height = 17, ;
		Option9.Left = 171, ;
		Option9.Style = 0, ;
		Option9.Top = 5, ;
		Option9.Width = 18, ;
		Option9.AutoSize = .T., ;
		Option9.Name = "Option9", ;
		Option10.Caption = "", ;
		Option10.Height = 17, ;
		Option10.Left = 193, ;
		Option10.Style = 0, ;
		Option10.Top = 5, ;
		Option10.Width = 18, ;
		Option10.AutoSize = .T., ;
		Option10.Name = "Option10"

	Add Object image2 As Image With ;
		Picture = Home(1)+ "graphics\icons\misc\face05.ico", ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 35, ;
		Left = 8, ;
		MousePointer = 15, ;
		Top = 5, ;
		Width = 35, ;
		ToolTipText = "ScreenSavers", ;
		Name = "Image2"

	Add Object pageframe1 As PageFrame With ;
		PageCount = 5, ;
		TabStyle = 0, ;
		Top = 6, ;
		Left = 448, ;
		Width = 289, ;
		Height = 27, ;
		MousePointer = 15, ;
		Themes = .F., ;
		Name = "Pageframe1", ;
		Page1.Caption = "Page1", ;
		Page1.Name = "Page1", ;
		Page2.Caption = "Page2", ;
		Page2.Name = "Page2", ;
		Page3.Caption = "Page3", ;
		Page3.Name = "Page3", ;
		Page4.Caption = "Page4", ;
		Page4.Name = "Page4", ;
		Page5.Caption = "Page5", ;
		Page5.Name = "Page5"

	Add Object spinner1 As Spinner With ;
		Height = 27, ;
		KeyboardHighValue = 73, ;
		KeyboardLowValue = 40, ;
		Left = 387, ;
		MousePointer = 15, ;
		SpinnerHighValue =  73.00, ;
		SpinnerLowValue =  40.00, ;
		Top = 7, ;
		Width = 21, ;
		Value = 73, ;
		Name = "Spinner1"

	Add Object Shape3 As Shape With ;
		Top = 12,;
		Left = 741,;
		Height = 17,;
		Width = 16,;
		Anchor = 0,;
		Curvature = 99,;
		MousePointer = 15,;
		ToolTipText = "Calendar Movable",;
		BackColor = Rgb(255,0,0),;
		BorderColor = Rgb(0,255,0),;
		Name = "Shape3"

	Add Object shape1 As Shape With ;
		Top = 8, ;
		Left = 760, ;
		Height = 25, ;
		Width = 49, ;
		BackStyle = 1, ;
		Curvature = 15, ;
		MousePointer = 15, ;
		ToolTipText = "Hide/show grid", ;
		BackColor = Rgb(128,255,0), ;
		Name = "Shape1"

	Add Object image3 As Image With ;
		Anchor = 768, ;
		Picture = "sample\hlp.bmp", ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 25, ;
		Left = 819, ;
		MousePointer = 15, ;
		Top = 6, ;
		Width = 25, ;
		ToolTipText = "Summary help", ;
		Name = "Image3"

	Add Object shape2 As Shape With ;
		Top = 8, ;
		Left = 414, ;
		Height = 27, ;
		Width = 27, ;
		Curvature = 15, ;
		MousePointer = 15, ;
		SpecialEffect = 0, ;
		BackColor = Rgb(128,0,255), ;
		BorderColor = Rgb(255,255,255), ;
		tooltiptext="run child form", ;
		Name = "Shape2"

	Procedure Init
	With This
		.Left=0
		.Top=0
		.Width=.Parent.Width
		.Height=73
		.ZOrder(0)
	Endwith
	Endproc

	Procedure Resize
	Thisform.Resize
	Endproc

	Procedure image1.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 image1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.Parent.SetFocus  &&to fire tooltiptexts
	Endproc

	Procedure command1.Click
	Thisform.Release
	Endproc

	Procedure command2.Click
	Thisform.WindowState=1
	Endproc

	Procedure command3.Click
	With Thisform
		Do Case
		Case This.Caption="1"
			This.Caption="2"
			.xleft=.Left
			.xtop=.Top
			.xwidth=.Width
			.xheight=.Height
			.WindowState=2

		Case This.Caption="2"
			This.Caption="1"
			.Left=.xleft
			.Top=.xtop
			.Height=.xheight
			.Width=.xwidth

		Endcase

		.Resize
	Endwith
	Endproc

	Procedure optiongroup1.Init
	DoDefault()
	With This
		.AutoSize=.T.
		.SetAll("backstyle",0,"Optionbutton")
		.SetAll("mousepointer",15,"Optionbutton")
		For i=1 To .ButtonCount
			.Buttons(i).ForeColor=0
			.Buttons(i).Caption=""
			.Buttons(i).AutoSize=.T.
			.Buttons(i).ToolTipText="Style"+Trans(i)
		Endfor
		.Value=1
		.InteractiveChange()
	Endwith
	Endproc

	Procedure optiongroup1.InteractiveChange
	Rand(-1)
	Try
		This.Parent.image1.Picture="bitmaps\styles\h"+Trans(Int(10*Rand()+1))+".jpg"
		Thisform.Picture="bitmaps\styles\v"+Trans(Int(10*Rand()+1))+".jpg"
	Catch
		This.Parent.image1.Picture="bitmaps\h5.jpg"
		This.Parent.image1.Picture="bitmaps\v5.jpg"
	Endtry
	Endproc

	Procedure image2.Click
	Do Case
	Case Between( Sec(Datetime()),1,20)
		Run/N explorer  "c:\windows\system32\bubbles.scr"

	Case Between( Sec(Datetime()),21,40)
		Run/N explorer  "c:\windows\system32\Ribbons.scr"

	Case Between( Sec(Datetime()),41,59)
		Run/N explorer  "c:\windows\system32\ssText3d.scr

	Endcase
	Endproc

	Procedure pageframe1.Init
	With This
		.Themes=.F.
		For i=1 To .PageCount
			.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endfor
	Endwith
	Endproc

	Procedure pageframe1.Page1.Click
	m.x=Int(Val(Substr(This.Name,5)))
	Thisform.ypgf(m.x)
	Endproc

	Procedure pageframe1.Page2.Click
	m.x=Int(Val(Substr(This.Name,5)))
	Thisform.ypgf(m.x)
	Endproc

	Procedure pageframe1.Page3.Click
	m.x=Int(Val(Substr(This.Name,5)))
	Thisform.ypgf(m.x)
	Endproc

	Procedure pageframe1.Page4.Click
	m.x=Int(Val(Substr(This.Name,5)))
	Thisform.ypgf(m.x)
	Endproc

	Procedure pageframe1.Page5.Click
	m.x=Int(Val(Substr(This.Name,5)))
	Thisform.ypgf(m.x)
	Endproc

	Procedure spinner1.InteractiveChange
	This.Parent.Height=This.Value
	This.Parent.Refresh
	Endproc

	Procedure shape1.Click
	Thisform.grid1.Visible     =!Thisform.grid1.Visible
	Thisform.pageframe1.Visible=.F.
	Endproc

	Procedure image3.Click
	Local m.myvar
	TEXT to m.myvar pretext 7 noshow
		this code builds a top level form without titlebar and subclass it by a container with some controls.
		the navbar is as level form (showWindow=1 inside the main form) and docked to left (can be at right in code)
		the navbar is arranged to be positioned inside the form and at bottom of the titlebar.
		the titlebar have more than what native can give(can move the form by mousedown, reduce,maximizenrestore,close..)
		i added also some controls as
		  -playing some screen savers(3 the first 0--20s, the second 21-40sec the third 41-59s of one minute calculated
		    in dateTime() function).of course bubbles.scr,ribbons.scr,ssText3d.scr must be on system otherwise change by others.
		  -settings one of 10 styles (titlebar and form imags)
		  -increase/decrease the titlebar height buy a spinner
		  -playing with tabs (1-5) to fire another pageframe on form with some web demo images (no disc access).internet must be
		   connected here.
		  -drawing a vfp grid (hide/show)
		  -embedding a monthview (draggable by mousedown on form)
		the code run a child form form menu or from titlebar.it can stylized as well with 10 images styles.its movale and can
		desserve to embed any vfp controls (or olecontrols).its movable by mousedown and resizable.
	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 shape2.Click
	Thisform.pageframe1.Visible=.F.
	Thisform.grid1.Visible=.F.
	Local m.x
	m.x=0
	With _Screen
		For i=1 To .FormCount
			If Lower(.Forms(i).Name)=="ychild1"
				m.x=m.x+1
			Endi
		Endfor
	Endwith

	If m.x=0
		ychild1=Newobject("ychild")
		ychild1.Left=navbar.Left+navbar.Width+50
		ychild1.Show
	Endi
	Endproc

	Procedure Shape3.Click
	With Thisform.olecontrol1
		.Left=(Thisform.Width-.Width)/2
		.Top=(Thisform.Height-.Height)/2
		.Visible=!.Visible
	Endwith
	Endproc


	Procedure YMEN.Click
	Try
		navbar.SplitterContainer.command1.Click()
	Catch
	Endtry
	Endproc

	Procedure YMEN.Init
	With This
		.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
		.SetAll("mousepointer",15,"commandbutton")
	Endwith
	Endproc


Enddefine
*
*-- EndDefine: ycont
*
Define Class ypframe As PageFrame
	PageCount = 5
	Top = 84
	Left = 198
	Width = 768
	Height = 540
	SpecialEffect = 2
	Tabs = .F.
	Visible = .F.
	Themes = .F.
	Name = "ypframe"
	Page1.Caption = "Page1"
	Page1.Name = "Page1"
	Page2.Caption = "Page2"
	Page2.Name = "Page2"
	Page3.Caption = "Page3"
	Page3.Name = "Page3"
	Page4.Caption = "Page4"
	Page4.Name = "Page4"
	Page5.Caption = "Page5"
	Page5.Name = "Page5"


	Procedure Init
	With This
		Messagebox(PageCount)
		For i=1 To .PageCount
			With .Pages(i)
				.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())

				Messagebox(.Pages(i).Name)
				.AddObject("image1","image")
				With .image1
					.Height = 421
					.Left = 11
					.Top = 11
					.Width = 649
					.Name = "Image1"
					.strecth=2
					.Picture=""
					.Visible=.T.
				Endwith
			Endwith
		Endfor

	Endwith
	Endproc

Enddefine
*
*-- EndDefine: asup1

*
Define Class ychild As Form
	BorderStyle = 3
	Height = 451
	Width = 648
	ShowWindow = 1
	ShowTips = .T.
	AutoCenter = .T.
	Picture = "bitmaps\styles\v3.jpg"
	Caption = "Form1"
	xleft = .F.
	xtop = .F.
	xwidth = .F.
	xheight = .F.
	Name = "YCHILD1"

	Add Object shape1 As Shape With ;
		Top = 2, ;
		Left = 6, ;
		Height = 106, ;
		Width = 185, ;
		BackStyle = 0, ;
		BorderWidth = 10, ;
		BorderColor = Rgb(0,0,160), ;
		Name = "Shape1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 48, ;
		BackStyle = 0, ;
		Caption = "Hello World!", ;
		Height = 79, ;
		Left = 120, ;
		Top = 113, ;
		Width = 380, ;
		BackColor = Rgb(192,192,192), ;
		Name = "Label1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 48, ;
		BackStyle = 0, ;
		Caption = "Hello World!", ;
		Height = 79, ;
		Left = 110, ;
		Top = 115, ;
		Width = 380, ;
		ForeColor = Rgb(0,255,0), ;
		BackColor = Rgb(192,192,192), ;
		Name = "Label2"

	Add Object optiongroup1 As OptionGroup With ;
		AutoSize = .T., ;
		ButtonCount = 10, ;
		BackStyle = 0, ;
		Value = 1, ;
		Height = 27, ;
		Left = 206, ;
		Top = 24, ;
		Width = 222, ;
		ToolTipText = "10  styles", ;
		Name = "Optiongroup1", ;
		Option1.Caption = "", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Style = 0, ;
		Option1.Top = 5, ;
		Option1.Width = 68, ;
		Option1.AutoSize = .F., ;
		Option1.Name = "Option1", ;
		Option2.Caption = "", ;
		Option2.Height = 17, ;
		Option2.Left = 25, ;
		Option2.Style = 0, ;
		Option2.Top = 5, ;
		Option2.Width = 68, ;
		Option2.AutoSize = .F., ;
		Option2.Name = "Option2", ;
		Option3.Caption = "", ;
		Option3.Height = 17, ;
		Option3.Left = 47, ;
		Option3.Style = 0, ;
		Option3.Top = 5, ;
		Option3.Width = 68, ;
		Option3.AutoSize = .F., ;
		Option3.Name = "Option3", ;
		Option4.Caption = "", ;
		Option4.Height = 17, ;
		Option4.Left = 70, ;
		Option4.Style = 0, ;
		Option4.Top = 5, ;
		Option4.Width = 68, ;
		Option4.AutoSize = .F., ;
		Option4.Name = "Option4", ;
		Option5.Caption = "", ;
		Option5.Height = 17, ;
		Option5.Left = 89, ;
		Option5.Style = 0, ;
		Option5.Top = 5, ;
		Option5.Width = 68, ;
		Option5.AutoSize = .F., ;
		Option5.Name = "Option5", ;
		Option6.Caption = "", ;
		Option6.Height = 17, ;
		Option6.Left = 110, ;
		Option6.Style = 0, ;
		Option6.Top = 5, ;
		Option6.Width = 68, ;
		Option6.AutoSize = .F., ;
		Option6.Name = "Option6", ;
		Option7.Caption = "", ;
		Option7.Height = 17, ;
		Option7.Left = 131, ;
		Option7.Style = 0, ;
		Option7.Top = 5, ;
		Option7.Width = 68, ;
		Option7.AutoSize = .F., ;
		Option7.Name = "Option7", ;
		Option8.Caption = "", ;
		Option8.Height = 17, ;
		Option8.Left = 149, ;
		Option8.Style = 0, ;
		Option8.Top = 5, ;
		Option8.Width = 68, ;
		Option8.AutoSize = .F., ;
		Option8.Name = "Option8", ;
		Option9.Caption = "", ;
		Option9.Height = 17, ;
		Option9.Left = 171, ;
		Option9.Style = 0, ;
		Option9.Top = 5, ;
		Option9.Width = 18, ;
		Option9.AutoSize = .T., ;
		Option9.Name = "Option9", ;
		Option10.Caption = "", ;
		Option10.Height = 17, ;
		Option10.Left = 193, ;
		Option10.Style = 0, ;
		Option10.Top = 5, ;
		Option10.Width = 18, ;
		Option10.AutoSize = .T., ;
		Option10.Name = "Option10"

	Add Object command1 As CommandButton With ;
		AutoSize = .T., ;
		Top = 4, ;
		Left = 596, ;
		Height = 27, ;
		Width = 28, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "X", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object command2 As CommandButton With ;
		AutoSize = .F., ;
		Top = 4, ;
		Left = 539, ;
		Height = 27, ;
		Width = 27, ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 768, ;
		Caption = "-", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command2"

	Add Object command3 As CommandButton With ;
		AutoSize = .F., ;
		Top = 4, ;
		Left = 567, ;
		Height = 27, ;
		Width = 27, ;
		FontBold = .T., ;
		FontName = "Webdings", ;
		FontSize = 10, ;
		Anchor = 768, ;
		Caption = "1", ;
		MousePointer = 15, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command3"

	Add Object grid1 As Grid With ;
		Height = 228, ;
		Left = 72, ;
		Top = 204, ;
		Width = 516, ;
		Themes = .F., ;
		Name = "Grid1"

	Add Object container1 As ytim With ;
		Top = 13, ;
		Left = 14, ;
		Width = 168, ;
		Height = 85, ;
		Picture = "bitmaps\styles\pattern_u.png", ;
		BackStyle = 1, ;
		BorderWidth = 0, ;
		SpecialEffect = 1, ;
		Name = "Container1"

	Procedure Init
	This.TitleBar=0
	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 optiongroup1.Init
	DoDefault()
	With This
		.AutoSize=.T.
		.SetAll("backstyle",0,"Optionbutton")
		.SetAll("mousepointer",15,"Optionbutton")
		For i=1 To .ButtonCount
			.Buttons(i).ForeColor=0
			.Buttons(i).Caption=""
			.Buttons(i).AutoSize=.T.
			.Buttons(i).ToolTipText="Style"+Trans(i)
		Endfor
	Endwith
	Endproc

	Procedure optiongroup1.InteractiveChange
	Rand(-1)
	Try
		Thisform.Picture="bitmaps\styles\v"+Trans(Int(10*Rand()+1))+".jpg"
	Catch
		This.Parent.image1.Picture="bitmaps\v5.jpg"
	Endtry
	Endproc

	Procedure command1.Click
	Thisform.Release
	Endproc

	Procedure command2.Click
	Thisform.WindowState=1
	Endproc

	Procedure command3.Click
	With Thisform
		Do Case
		Case This.Caption="1"
			This.Caption="2"
			.xleft=.Left
			.xtop=.Top
			.xwidth=.Width
			.xheight=.Height
			.WindowState=2

		Case This.Caption="2"
			This.Caption="1"
			.Left=.xleft
			.Top=.xtop
			.Height=.xheight
			.Width=.xwidth

		Endcase

		.Resize
	Endwith
	Endproc

	Procedure grid1.Init
	If _vfp.StartMode=0
		Sele company,address,fax,contact From Home(1)+"samples\data\customer" Into Cursor ycurs
	Else
		Create Cursor ycurs ( yfield1 c(30),yfield2 c(30))
		For i=1 To 40
			Insert Into ycurs Values ("SDSDSDinsert145ESlqwozizzenejkii","nshsgstgaztatyatsdfdgd40125")
		Endfor
	Endi

	With This
		Sele ycurs
		.RecordSource=""
		.RecordSource="ycurs"
		.RecordSourceType=1
		.Themes=.F.
		.DeleteMark=.F.
		.GridLines=0
		.FontBold=.T.
		For i=1 To .ColumnCount
			.Columns(i).header1.BackColor=0
			.Columns(i).header1.ForeColor=255
			.Columns(i).header1.FontSize=12
		Endfor
		.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(115,65,125)  , RGB(180,125,40))", "Column")
		Sele ycurs
		Locate
		.Refresh
	Endwith
	Endproc

Enddefine
*
*-- EndDefine: ychild
Define Class ytim As Container
	Top = 13
	Left = 14
	Width = 168
	Height = 85
	Picture = "bitmaps\styles\pattern_u.png"
	BackStyle = 1
	BorderWidth = 0
	SpecialEffect = 1
	Name = "Container1"

	Add Object label1 As Label With ;
		FontBold = .T., ;
		FontSize = 28, ;
		Alignment = 2, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 58, ;
		Left = -2, ;
		Top = 17, ;
		Width = 168, ;
		ForeColor = Rgb(0,0,160), ;
		Name = "Label1"

	Add Object timer1 As Timer With ;
		Top = 0, ;
		Left = 72, ;
		Height = 23, ;
		Width = 23, ;
		Interval = 60000, ;
		Name = "Timer1"

	Procedure timer1.Init
	This.Parent.label1.Caption=Substr(Time(),1,5)
	Endproc

	Procedure timer1.Timer
	This.Parent.label1.Caption=Substr(Time(),1,5)
	Endproc

Enddefine
*
*-- EndDefine: ytim
*
Define Class ycalendar As OleControl
	OleClass="MSComCtl2.MonthView.2"
	Top = 156
	Left = 444
	Height = 276
	Width = 217
	Visible = .F.
	Name = "Olecontrol1"

	Procedure Init
	Thisform.ocap=.F.
	With This
		.BackColor=65408
		.BorderStyle=0
		.MonthBackcolor=16776960
		.titleBackcolor=255
	Endwith
	Endproc

	Procedure MouseDown
	Lparameters Button, Shift, x, Y
	Thisform.ocap=.T.
	Endproc

	Procedure MouseMove
	Lparameters Button, Shift, x, Y
	If Thisform.ocap=.T. And Button=1
		With This
			.Left=.Left+x
			.Top=.Top+Y
		Endwith
	Endi
	Endproc

	Procedure MouseUp
	Lparameters Button, Shift, x, Y
	Thisform.ocap=.F.
	Endproc

Enddefine
*
*-- EndDefine: ole


Note :
if want a vertical scrollbar for navbar change this line in code above:
.ScrollBars=2 &&0   if no scrollbar

A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2
A navBar (navigation bar) vfp class part2

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

Comment on this post