Playing with vfp pageframes and subclassing

Published on by Yousfi Benameur

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

     

this is an exercice of pageframe styles.
to make the pageframe without its tabs can choose in PEM sheet its properties :themes=.f. and tabs=.f.
i present a variety of methods to subclass the pageframe tabs particulary with :
  -containers tab with a number=the pageframe.pagecount
  -commandgroup control with a number of buttons=the pageframe.pagecount
  -optionGroup control with a number of buttons (options)= the pageframe.pagecount
using bindevent with a mousedown event replaces the tab pageframe  tab action.
of course can populate the pages with  any vfp controls.
the code *2* below downloads some images for tabs (from Bernard Bout pageframe post: http://weblogs.foxite.com/bernardbout/2006/06/07/recreating-onenotetabs-in-vfp9/)
In codes 3* and *4* i present method to build images with gradients with vfp9 native gdiplus class...can customize random colors used.

 To keep certain white areas of your .bmp white, create a mask for it that will override the default.To create a mask for a .bmp:
-Open the .bmp file in Paint or another bitmap utility.
-Blacken all areas of the picture that you want to be displayed exactly as they are in the .bmp file. 
Leave the areas you want to be transparent as white.
-Save the file in the same directory and with the same name as the .bmp file but with an .msk extension.
can also use transparent gif or png for this purpose.

[post 229]


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


*1* created on  thursday 27 of april 2017
*!*	the code creates a pageframe with subclassed tabs by containers (image+label).
*!*	the tab class is coded in the ycont class below
*!*the tabs are created by the pageframe.pagecount property(number of tabs)
*!*	the image is encoded to hexBinay64 and retrieved as blob in pictureVal image control property.
*!* the pageframe play a diaporama with 8 web images:internet must be connected
*!*	the timer1 is (_screen.ydiapo=.t.): this makes a cycling diaporama of web pictures (can disable it:timer1.enabled=.f.)
*!*	the pages can embed any vfp control.
*!* bindevent is coded in my procedure.it locates the tab concerned by click and do the consequent job.


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

_screen.windowstate=1
_screen.addproperty("ydiapo",.t.)   &&.f. for no automatic diaporama	

Publi yform
yform=Newobject("ypgf")
yform.Show
Read Events
Retu
*
Define Class ypgf As Form
Height = 600
Width = 890	
ShowWindow = 2
AutoCenter = .T.
Caption = "Form1"
Name = "Form1"
jj=0     &&custom counter

Add Object pageframe1 As PageFrame With ;
	ErasePage = .T., ;
	PageCount = 10, ;
	Top = 61, ;
	Left = 12, ;
	Width = 216, ;
	Height = 503, ;
	Name = "Pageframe1"

Add Object ycnt As Container With ;
	Top = 20, ;
	Left = 12, ;
	Width = 840, ;
	Height = 49, ;
	Name = "yCNT"
	
Add Object timer1  As timer With ;
	 enabled=.f.,;
	 interval=3000,;
	 name="timer1"

procedure timer1.timer
thisform.jj=thisform.jj+1
if thisform.jj>thisform.pageframe1.pagecount
thisform.jj=1
endi
x=eval("thisform.ycnt.container"+trans(thisform.jj)+".label1")
x.mousedown(1)
endproc
		
Procedure ycnt.Init
Local m.delta
m.delta=5

With This
	Local ncount
	ncount=This.Parent.pageframe1.PageCount
	.BackColor=0
	Local x
	For j=1 To ncount
		.AddObject("container"+Trans(j),"zcont")
		x=Eval(".container"+Trans(j))
		x.Width=0.90*Floor(.Parent.Width/ncount)
		x.label1.Left=(x.Width-x.label1.Width)/2
		If j=1
			x.Left=4
		Else
			Y=Eval(".container"+Trans(j-1))
			x.Left=Y.Left+Y.Width+m.delta
		Endi
		x.Top=1
		x.Visible=.T.
	Endfor
	.Refresh
Endwith

With Thisform.pageframe1
	.Left=This.Left
	.Top=This.Top+This.Height-2
	.Width=This.Width
	.Themes=.F.
	.Tabs=.F.
	.ZOrder(1)

	For i=1 To .PageCount
		.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.Pages(i).AddObject("image1","image")
		With .Pages(i).image1
			.Anchor=0
			.Left=10
			.Top=10
			.Width=.Parent.Parent.Width-20
			.Height=.Parent.Parent.Height-20
			.Stretch=2
			.Visible=.T.
			.Name="image1"
			.Picture=""
		Endwith
	Endfor
	.Refresh
Endwith
Endproc

procedure init
sele yhm	
thisform.ycnt.container1.label1.mousedown(1)
thisform.timer1.enabled=_screen.ydiapo    &&.f. for no diaporama
endproc

Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
DoDefault()
local i
i=Int(Val(Substr(loObject.Parent.Name,10)))  &&containerX
loObject.Parent.Parent.SetAll("visible",.F.,"image")
loObject.Parent.Parent.SetAll("forecolor",Rgb(255,255,255),"label")
loObject.ForeColor=255

loObject.Parent.image1.Visible=.T.
Thisform.pageframe1.ActivePage=i
With Thisform.pageframe1.Pages(i).image1
	.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
.PictureVal=yloadImg(ximage)
Endwith
Endproc

Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: ypgf
*
Define Class zcont As Container
Top = 10
Left = 0
Width = 180
Height = 48
BackColor = Rgb(0,0,0)
Name = "Container1"

Add Object image1 As Image With ;
	Picture = "", ;
	Stretch = 2, ;
	BackStyle = 0, ;
	Height = 38, ;
	Left = -1, ;
	Top = 6, ;
	Width = 59, ;
	Name = "Image1"

Add Object label1 As Label With ;
	AutoSize = .T., ;
	FontBold = .T., ;
	BackStyle = 0, ;
	Caption = "Page1", ;
	Height = 17, ;
	Left = 8, ;
	Top = 14, ;
	Width = 38, ;
	ForeColor = Rgb(255,255,255), ;
	Name = "Label1"

Procedure Init
local m.myvar
text to m.myvar noshow
R0lGODlhOwAmAHCSACH/C05FVFNDQVBFMi4wAwEAAAAh+QQFCgCSACwAAAAAOwAmAIcAAAAAADMAAGYAAJkAAMwAAP8AKwAAKzMAK2YAK5kAK8wAK/8AVQAAVTMAVWYAVZkAVcwAVf8AgAAAgDMAgGYAgJkAgMwAgP8AqgAAqjMAqmYAqpkAqswAqv8A1QAA1TMA1WYA1ZkA1cwA1f8A/wAA/zMA/2YA/5kA/8wA//8zAAAzADMzAGYzAJkzAMwzAP8zKwAzKzMzK2YzK5kzK8wzK/8zVQAzVTMzVWYzVZkzVcwzVf8zgAAzgDMzgGYzgJkzgMwzgP8zqgAzqjMzqmYzqpkzqswzqv8z1QAz1TMz1WYz1Zkz1cwz1f8z/wAz/zMz/2Yz/5kz/8wz//9mAABmADNmAGZmAJlmAMxmAP9mKwBmKzNmK2ZmK5lmK8xmK/9mVQBmVTNmVWZmVZlmVcxmVf9mgABmgDNmgGZmgJlmgMxmgP9mqgBmqjNmqmZmqplmqsxmqv9m1QBm1TNm1WZm1Zlm1cxm1f9m/wBm/zNm/2Zm/5lm/8xm//+ZAACZADOZAGaZAJmZAMyZAP+ZKwCZKzOZK2aZK5mZK8yZK/+ZVQCZVTOZVWaZVZmZVcyZVf+ZgACZgDOZgGaZgJmZgMyZgP+ZqgCZqjOZqmaZqpmZqsyZqv+Z1QCZ1TOZ1WaZ1ZmZ1cyZ1f+Z/wCZ/zOZ/2aZ/5mZ/8yZ///MAADMADPMAGbMAJnMAMzMAP/MKwDMKzPMK2bMK5nMK8zMK//MVQDMVTPMVWbMVZnMVczMVf/MgADMgDPMgGbMgJnMgMzMgP/MqgDMqjPMqmbMqpnMqszMqv/M1QDM1TPM1WbM1ZnM1czM1f/M/wDM/zPM/2bM/5nM/8zM////AAD/ADP/AGb/AJn/AMz/AP//KwD/KzP/K2b/K5n/K8z/K///VQD/VTP/VWb/VZn/Vcz/Vf//gAD/gDP/gGb/gJn/gMz/gP//qgD/qjP/qmb/qpn/qsz/qv//1QD/1TP/1Wb/1Zn/1cz/1f///wD//zP//2b//5n//8z///8AAAAAAAAAAAAAAAAI/wDtCRxIsKDBgwgTKiwIz17Dhw4jQpwosSLFixYzNhS4MSLHgR1Dghz5saTHkyIJblzpkSXLii1jwnRZEiLJjjJrqjSZM+fLlDRj/pRpM6hRnUSRJvWJ9OXSpUOhfowaVarVqk6vNmV4c6tUoF5/Fg1LVqvVrmWppg079ilOrErdHoQrFK3ToDpdtlVr1ibKnidN8h0sWCtNwn2nov0b2KvZwoqTIgb7NbLfqj2HYk4Z+G3lukz/arbM+GhjwpQdp07MeKva13FL51W6dzHno3wlk/xsGvJj0ap5op4N2q/c4lxl2wa+lmht5DBJjz4L+a7wzjurVwfAvbv37+C5Ty1vGL68+fPouYeGl769e/Nb38ufr14m/fvu7ePfj74k///nbQTggOXZQ2B3AQEAOw==
endtext

With This
local i
	i=Substr(This.Name,10)
	With .label1
		.FontBold=.T.
		.fontname="Tahoma"
		.fontsize=8
		.Alignment=0
		.BackStyle=0
		.AutoSize=.T.
		.Left=4
		.MousePointer=15
		.Caption="Page"+i
		.ForeColor=Rgb(255,255,255)
		.ZOrder(0)
	Endwith
	.Width=.label1.Width+10
	.BackStyle=0
	.Width=0.90*Floor(Thisform.ycnt.Width/Thisform.pageframe1.PageCount)  &&already set as real value
	
	With .image1
		.pictureVal=strconv(m.myvar,14)
		.Left=0
		.Top=0
		.Width=.Parent.Width
		.Height=.Parent.Height
		.Visible=.F.
		.ZOrder(1)
	Endwith
	.Refresh
Endwith
Bindevent(This.label1,"mousedown",Thisform,"my")
Endproc

Procedure image1.Init
This.ZOrder(1)
Endproc
Enddefine
*
*-- EndDefine: zcont


*internet must be connected
Function yloadImg
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
Endfunc


the image tab is a transparent gif encoded with _cliptext=strconv(filetostr(getpict('gif'),13) and restitued as pictureval with strconv(string,14)
the image tab is a transparent gif encoded with _cliptext=strconv(filetostr(getpict('gif'),13) and restitued as pictureval with strconv(string,14)
the image tab is a transparent gif encoded with _cliptext=strconv(filetostr(getpict('gif'),13) and restitued as pictureval with strconv(string,14)

the image tab is a transparent gif encoded with _cliptext=strconv(filetostr(getpict('gif'),13) and restitued as pictureval with strconv(string,14)

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


*2*
*this code subclasses the tabs of a native pageframe with 2 methods
*1-a container with image+label+icon in each tab (make sure imlages are downloaded for this purpose).
*2-an optionGroup control
*3-a commandGroup control

Local m.ydownl
m.ydownl=.T.    &&use it once to download images and change to .f.
Set Defa To Addbs(Justpath(Sys(16,1)))


If m.ydownl=.t.
*******begin downloads************
*images are from Bernard Bout foxite blog (pageframe post)
	Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
	Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
	Local lcUrl,lcDownloadLoc
	For i=1 To 15
		Do Case
		Case i=1
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_ccbd36_aquagrad.bmp"
			lcDownloadLoc="aquagrad.bmp"
		Case i=2
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_99b305_aquagrad1.jpg"
			lcDownloadLoc="aquagrad1.jpg"
		Case i=3
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_45b772_aquatab.bmp"
			lcDownloadLoc="aquatab.bmp"
		Case i=4
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_55cc94_bluegrad.bmp"
			lcDownloadLoc="bluegrad.bmp"
		Case i=5
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_55cc94_bluegrad.bmp"
			lcDownloadLoc="fonds.jpg"
		Case i=6
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_e49447_bluetab.bmp"
			lcDownloadLoc="blueTab.bmp"
		Case i=7
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_14a179_greengrad.bmp"
			lcDownloadLoc="greenGrad.bmp"
		Case i=8
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_2ce8d0_greentab.bmp"
			lcDownloadLoc="greenTab.bmp"
		Case i=9
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_c8faa6_majentagrad.bmp"
			lcDownloadLoc="majentaGrad.bmp"
		Case i=10
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_6b0a10_majentatab.bmp"
			lcDownloadLoc="majentaTab.bmp"
		Case i=11
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_6e6515_orangegrad.bmp"
			lcDownloadLoc="orangeGrad.bmp"
		Case i=12
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_83c7e3_orangetab.bmp"
			lcDownloadLoc="orangeTab.bmp"
		Case i=13
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_3c2589_purplegrad.bmp"
			lcDownloadLoc="purpleGrad.bmp"
		Case i=14
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_224d84_purpletab.bmp"
			lcDownloadLoc="purpleTab.bmp"
		Case i=15
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_edc782_tealgrad.bmp"
			lcDownloadLoc="tealgradbmp"
		Case i=16
			lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20170427/ob_f2621a_tealtab.bmp"
			lcDownloadLoc="tealTab.bmp"
 	Endcase
		lnResult = DeleteUrlCacheEntry(lcUrl)
		lnResult = URLDownloadToFile(0, lcUrl, lcDownloadLoc , 0,0)
		If lnResult = 0
			Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
*Else
*!*  Messagebox("Download fails")
		Endi
		Inke(1)
	Endfor
**********end downloads****************
Endi

Publi yform
yform=Newobject("ypgf")
yform.Show
Read Events
Retu
*
Define Class ypgf As Form
	Height = 600
	Width = 750
	ShowWindow = 2
	BackColor=0
	AutoCenter = .T.
	Caption = "3 external methods to command and stylize a pageframe."
	Name = "Form1"

	Add Object pageframe1 As PageFrame With ;
		PageCount = 5, ;
		Top = 60, ;
		Left = 48, ;
		Width = 624, ;
		Height = 500, ;
		Tabs = .F., ;
		Themes = .F., ;
		Name = "Pageframe1", ;
		Page1.Caption = "Page1", ;
		Page1.Picture = "aquagrad.bmp", ;
		Page1.Name = "Page1", ;
		Page2.Caption = "Page2", ;
		Page2.Picture = "majentagrad.bmp", ;
		Page2.Name = "Page2", ;
		Page3.Caption = "Page3", ;
		Page3.Name = "Page3", ;
		Page4.Caption = "Page4", ;
		Page4.Name = "Page4", ;
		Page5.Caption = "Page5", ;
		Page5.Name = "Page5"

	Add Object optiongroup1 As OptionGroup With ;
		ButtonCount = 1, ;
		Value = 0, ;
		Height = 26, ;
		Left = 159, ;
		Top = 57, ;
		Width = 322, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Optiongroup1", ;
		Option1.Caption = "Option1", ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Top = 5, ;
		Option1.Width = 61, ;
		Option1.Name = "Option1"

	Add Object commandgroup1 As CommandGroup With ;
		AutoSize = .F., ;
		ButtonCount = 1, ;
		Value = 0, ;
		Height = 48, ;
		Left = 84, ;
		SpecialEffect = 0, ;
		Top = 8, ;
		Width = 444, ;
		BackColor = Rgb(255,215,196), ;
		Name = "Commandgroup1", ;
		Command1.Top = 5, ;
		Command1.Left = 5, ;
		Command1.Height = 27, ;
		Command1.Width = 84, ;
		Command1.Caption = "Command1", ;
		Command1.Name = "Command1"

	Add Object ycont As Container With ;
		Top = 24, ;
		Left = 84, ;
		Width = 537, ;
		Height = 37, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "ycont"

	Add Object optiongroup2 As OptionGroup With ;
		AutoSize = .F., ;
		ButtonCount = 4, ;
		Value = 1, ;
		Height = 36, ;
		Left = 180, ;
		Top = 568, ;
		Width = 300, ;
		Name = "Optiongroup2", ;
		Option1.Caption = "Style1", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Style = 0, ;
		Option1.Top = 5, ;
		Option1.Width = 67, ;
		Option1.AutoSize = .T., ;
		Option1.Name = "Option1", ;
		Option2.Caption = "Style2", ;
		Option2.Height = 17, ;
		Option2.Left = 82, ;
		Option2.Style = 0, ;
		Option2.Top = 5, ;
		Option2.Width = 67, ;
		Option2.AutoSize = .T., ;
		Option2.Name = "Option2", ;
		Option3.Caption = "Style3", ;
		Option3.Height = 17, ;
		Option3.Left = 156, ;
		Option3.Style = 0, ;
		Option3.Top = 5, ;
		Option3.Width = 67, ;
		Option3.AutoSize = .T., ;
		Option3.Name = "Option3", ;
		Option4.Caption = "Native", ;
		Option4.Height = 17, ;
		Option4.Left = 230, ;
		Option4.Top = 6, ;
		Option4.Width = 61, ;
		Option4.Name = "Option4"


	Procedure pageframe1.Init
	With This.Page1
		.AddObject("image1","image")
		With .image1
			.Picture = Home(1)+"graphics\metafiles\business\apptbook.wmf"
			.Stretch = 2
			.Height = .Parent.Parent.Height-20
			.Left = 10
			.Top = 10
			.Width = .Parent.Parent.Width-20
			.RotateFlip = 1
			.Name = "Image1"
			.Visible=.T.
		Endwith

		.AddObject("edit1","editbox")
		With .edit1
			.Height = 203
			.Left = 322
			.Top = 82
			.Width = 186
			.Name = "Edit1"
			.Visible=.T.
		Endwith

		With .edit1
			.FontSize=8
			TEXT to .value pretext 7 noshow
		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.
			ENDTEXT
		Endwith
	Endwith

	With This.Page2
		.AddObject("image1","image")
		With .image1
			.Picture = Home(1)+"graphics\metafiles\business\laptop2.wmf"
			.Stretch = 2
			.Height = 190
			.Left = 34
			.Top = 22
			.Width = 298
			.Name = "Image1"
			.Visible=.T.
		Endwith
	Endwith

	With This.Page3
		.AddObject("edit1","editbox")
		With .edit1
			.Height =200
			.Left = 99
			.Top = 69
			.Width = 379
			.Name = "Edit1"
			.Visible=.T.
			Try
				.Value=.Parent.Parent.Pages(1).edit1.Value
			Catch
			Endtry
		Endwith
	Endwith

	With This.Page4
		.AddObject("label1" ,"label")
		With .label1
			.AutoSize = .T.
			.FontBold = .T.
			.BackStyle=0
			.FontName = "Segoe Script"
			.FontSize = 42
			.Caption = "Hello World"
			.Height = 96
			.Left = 91
			.Top = 45
			.Width = 364
			.Name = "Label1"
			.Visible=.T.
		Endwith

		.AddObject("list1","listbox")
		With .list1
			.Height = 133
			.Left = 72
			.Top = 156
			.Width = 289
			.Name = "List1"
			.Visible=.T.
		Endwith

		.AddObject("label2","label")
		With .label2
			.AutoSize = .T.
			.FontBold = .T.
			.FontName = "Segoe Script"
			.FontSize = 42
			.BackStyle = 0
			.Caption = "Hello World"
			.Height = 96
			.Left = 85
			.Top = 48
			.Width = 364
			.ForeColor = Rgb(0,255,0)
			.Name = "Label2"
			.Visible=.T.
		Endwith
	Endwith

	With This.Page5
		.AddObject("image1","image")
		With .image1
			.Picture = Home(1)+"graphics\metafiles\business\answmach.wmf"
			.Stretch = 2
			.Height = 85
			.Left = 38
			.Top = 68
			.Width = 121
			.Name = "Image1"
			.Visible=.T.
		Endwith

		.AddObject("image2","image")
		With .image2
			.Picture =Home(1)+ "graphics\metafiles\business\digitnum.wmf"
			.Stretch = 2
			.Height = 126
			.Left = 252
			.Top = 126
			.Width = 198
			.Name = "Image2"
			.Visible=.T.
		Endwith
	Endwith
	Endproc

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
*messagebox(loObject.name)
	N= Int(Val(Substr(loObject.Name,7)))
	With Thisform.pageframe1
		.ActivePage=N
		.Refresh
	Endwith
	Endproc

	Procedure my1
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
*messagebox(loObject.name)
	N= Int(Val(Substr(loObject.Name,8)))
	With Thisform.pageframe1
		.ActivePage=N
		.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]
*messagebox(loObject.parent.name)
	Local N,x
	m.n= Int(Val(Substr(loObject.Parent.Name,10)))
	m.x=loObject.Parent
	m.x.ZOrder(0)
	With Thisform.pageframe1
		.ActivePage=N
		.Refresh
	Endwith
	Endproc

	Procedure Init
	With Thisform.pageframe1
		.Width=.PageCount*(Thisform.ycont.container1.Width+10)
		.Top=Thisform.ycont.Top+Thisform.ycont.Height-4
	Endwith

	With Thisform.optiongroup1
		.Left=Thisform.pageframe1.Left+2
		.Width=Thisform.pageframe1.Width
		.SetAll("picture",Home(1)+"gtaphics\icons\misc\misc015.ico","commandbutton")
		.SetAll("picturePosition",1,"commandbutton")
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure optiongroup1.Init
	With This
		.ButtonCount=Thisform.pageframe1.PageCount
		.Refresh
		For i=1 To .ButtonCount
			With .Buttons(i)
				If i=1
					.Left=0
				Else
					.Left=Eval("thisform.optionGroup1.option"+Trans(i-1)+".left")+ Eval("thisform.optionGroup1.option"+Trans(i-1)+".width+5")
				Endi
				.Top=1
				.Width=Int(Thisform.pageframe1.Width/Thisform.pageframe1.PageCount)
				.Height=27
				.SpecialEffect=2
				.MousePointer=15
				.BackStyle=0
				.Caption="Page"+Trans(i)
			Endwith
			Bindevent(.Buttons(i),"mousedown",Thisform,"my")
		Endfor
	Endwith
	Endproc

	Procedure commandgroup1.Init
	Local gnbre
	gnbre=Adir(gabase,Home(1)+"graphics\icons\win95\*.ico")


	With This
		.ButtonCount=Thisform.pageframe1.PageCount
		.Refresh
		For i=1 To .ButtonCount
			With .Buttons(i)
				If i=1
					.Left=0
				Else
					.Left=Eval("thisform.commandGroup1.command"+Trans(i-1)+".left")+ Eval("thisform.commandGroup1.command"+Trans(i-1)+".width+5")
				Endi

				.Top=7
				.Width=Int(Thisform.pageframe1.Width/Thisform.pageframe1.PageCount)-10
				.Height=34
				.SpecialEffect=2
				.MousePointer=15
				.BackColor=Rgb(0,255,0)
				.Caption="Page"+Trans(i)
				Local ra
				ra=Int((gnbre)*Rand()+1)
				.Picture=Home(1)+"graphics\icons\win95\"+gabase(ra,1)
				.PicturePosition=1
			Endwith
			Bindevent(.Buttons(i),"mousedown",Thisform,"my1")
		Endfor
		.Width=.ButtonCount*(.Buttons(1).Width)	+20
	Endwith
	Endproc

	Procedure ycont.Init
	Local m.ysep
	m.ysep=12
	With  This
		For i=1 To Thisform.pageframe1.PageCount
			.AddObject("container"+Trans(i),"ycnt")
			With Eval(".container"+Trans(i))
				If i=1
					.Left=5
				Else
					.Left=Eval("thisform.ycont.container"+Trans(i-1)+".left")+Eval("thisform.ycont.container"+Trans(i-1)+".width")-m.ysep
				Endi
				.Top=Thisform.ycont.container1.Top

				Do Case
				Case i=1
					.image1.Picture="aquatab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\face05.ico"
					.label1.Caption="Page1"
					Thisform.pageframe1.Pages(1).Picture="aquaGrad.bmp"

				Case i=2
					.image1.Picture="bluetab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\misc05.ico"
					.label1.Caption="Page2"
					Thisform.pageframe1.Pages(2).Picture="blueGrad.bmp"

				Case i=3
					.image1.Picture="greentab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\misc15.ico"
					.label1.Caption="Page3"
					Thisform.pageframe1.Pages(3).Picture="greenGrad.bmp"

				Case i=4
					.image1.Picture="Majentatab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\clock02.ico"
					.label1.Caption="Page4"
					Thisform.pageframe1.Pages(4).Picture="MajentaGrad.bmp"

				Case i=5
					.image1.Picture="orangetab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\win95\audio.ico"
					.label1.Caption="Page5"
					Thisform.pageframe1.Pages(5).Picture="orangeGrad.bmp"

				Case i=6
					.image1.Picture="orangetab.bmp"
					.image2.Picture=Home(1)+"graphics\icons\win95\audio.ico"
					.label1.Caption="Page6"
					Thisform.pageframe1.Pages(6).Picture="orangeGrad.bmp"
				Endcase
				.Visible=.T.
			Endwith
		Endfor
		.Left=Thisform.pageframe1.Left+2
		.Width=Thisform.pageframe1.PageCount*(Thisform.ycont.container1.Width-12)+20
	Endwith
	Endproc

	Procedure optiongroup2.InteractiveChange
	Do Case
	Case This.Value=1
		With Thisform
			.ycont.Visible=.T.
			.commandgroup1.Visible=.F.
			.optiongroup1.Visible=.F.
			.pageframe1.Tabs=.F.
		Endwith

	Case This.Value=2
		With Thisform
			.ycont.Visible=.F.
			.commandgroup1.Visible=.F.
			.optiongroup1.Visible=.T.
			.optiongroup1.Top=Thisform.pageframe1.Top-.optiongroup1.Height+4
			.optiongroup1.Left=Thisform.ycont.Left
			.pageframe1.Tabs=.F.
		Endwith

	Case This.Value=3
		With Thisform
			.ycont.Visible=.F.
			.commandgroup1.Visible=.T.
			.optiongroup1.Visible=.F.
			.pageframe1.Tabs=.F.
			.commandgroup1.Top=Thisform.ycont.Top-14
			.commandgroup1.Left=Thisform.ycont.Left
		Endwith

	Case This.Value=4
		With Thisform
			.ycont.Visible=.F.
			.commandgroup1.Visible=.F.
			.optiongroup1.Visible=.F.
			.pageframe1.Tabs=.T.
			.pageframe1.SetAll("forecolor",Rgb(255,255,255),"page")
			.pageframe1.SetAll("backcolor",0,"page")
			.pageframe1.SetAll("fontbold",.T.,"page")

			.Refresh
		Endwith
	Endcase
	Endproc

	Procedure optiongroup2.Init
	This.InteractiveChange()
	Endproc

Enddefine
*
*-- EndDefine: ypgf

* tabs container class for option 1
Define Class ycnt As Container
	Top = 12
	Left = -3
	Width = 120
	Height = 27
	Picture = Home(1)+"graphics\icons\misc\misc05.ico"
	BackStyle = 0
	BorderWidth = 0
	MousePointer = 15
	Name = "Container1"

	Add Object image1 As Image With ;
		Picture = "aquatab.bmp", ;
		Height = 20, ;
		Left = 4, ;
		Top = 3, ;
		Width = 112, ;
    backstyle=0, ;
		Name = "Image1"

	Add Object Command1 As CommandButton With ;
		Top = -2, ;
		Left = 84, ;
		Height = 25, ;
		Width = 37, ;
		Caption = "", ;
		Style = 1, ;
		Name = "Command1"

	Add Object label1 As Label With ;
		FontSize = 8, ;
		BackStyle = 0, ;
		Caption = "Caption1", ;
		Height = 25, ;
		Left = 42, ;
		Top = 6, ;
		Width = 61, ;
		Name = "Label1"

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

	Procedure Init
	With This.Command1
		.Left=-10
		.Top=-10
		.Width=.Parent.Width+20
		.Height=.Parent.Height+20
		.ZOrder(0)
		.MousePointer=15
	Endwith
	Bindevent(This.Command1,"mousedown",Thisform,"my2")
	Endproc

Enddefine
*
*-- EndDefine: asup


Playing with vfp pageframes and subclassing
Playing with vfp pageframes and subclassing
Playing with vfp pageframes and subclassing
Playing with vfp pageframes and subclassing

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


*3* created on friday 28 of april 2017
*create 2 bmp images horizontal and vertical  with linear gradient 2 color randomly   for each pageframe tab
*uses vfp9 native class gdiplus
*set the n to the pageframe.pagecount to create the consequent number of images in the subFolder gimages.

Clea All
Clea Resources
Set Safe Off
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
If !Directory (m.yrep+"gimages")
	Md m.yrep+"Gimages")
Endi
Local nWidth,lnHeight As Integer

Set Classlib To Locfile (Home(1)+"ffc\_gdiplus.vcx")
Local N
N=7     &&5 images H and 5 images V
For j=1 To N
	Local    OBitmap, oGraphics, Open, NY,NX, cFileName1,cFilename2
*hoprizontal
	lnWidth= 130
	lnHeight= 30
	m.cFileName1 =m.yrep+"Gimages\H"+Trans(j)+".bmp"

	m.OBitmap = Createobject ("gpBitmap")
	m.OBitmap. Create (lnWidth, lnHeight)
	m.oGraphics = Createobject ("gpGraphics")
	m.oGraphics.CreateFromImage (m.OBitmap)
	Local tnRed, tnGreen, tnBlue, tnAlpha,xcolor
	tnRed=Int(255*Rand())
	tnGreen=Int(255*Rand())
	tnBlue=Int(255*Rand())
	m.xcolor=rgb2html(Rgb(tnRed,tnGreen,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.cFileName1, "image/bmp")
  
*!*	*format saved with vfp9 gdiplus class can be for ex.
*!*	image/jpeg", "quality=80"
*!*	image/bmp
*!*	image/png
*!*	image/gif....

	m.oPen=Null
	m.oGraphics=Null
	m.OBitmap=Null
	Inke(1)

*vertical
	lnWidth= 2
	lnHeight= 600
	m.cFilename2 =m.yrep+"Gimages\V"+Trans(j)+".bmp"
	m.OBitmap = Createobject ("gpBitmap")
	m.OBitmap. Create (lnWidth, lnHeight)
	m.oGraphics = Createobject ("gpGraphics")
	m.oGraphics.CreateFromImage (m.OBitmap)
	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.cFilename2, "image/bmp")

	m.oPen=Null
	m.oGraphics=Null
	m.OBitmap=Null

Endfor
Set Classlib To

Local m.OO
m.OO=m.yrep+"Gimages"
Run/N explorer &OO

Function 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


Playing with vfp pageframes and subclassing

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


*4* created on friday 28 of april 2017
*this code tests the gradients images created by previous code *3* on a pageframe with subclassed tabs.

Set Defa To Addbs(Justpath(Sys(16,1)))

Publi yform
yform=Newobject("ypgf")
yform.Show
Read Events
Retu
*
Define Class ypgf As Form
	Height = 512
	Width = 702
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "stylisze a pageframe."
	Name = "Form1"

	Add Object pageframe1 As PageFrame With ;
		ErasePage = .T., ;
		PageCount = 6, ;
		Top = 60, ;
		Left = 48, ;
		Width = 624, ;
		Height = 382, ;
		Tabs = .F., ;
		Themes = .F., ;
		Name = "Pageframe1"

	Add Object ycont As Container With ;
		Top = 12, ;
		Left = 48, ;
		Width = 624, ;
		Height = 49, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "ycont"

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
*messagebox(loObject.name)
	N= Int(Val(Substr(loObject.Name,7)))
	With Thisform.pageframe1
		.ActivePage=N
		.Refresh
	Endwith
	Endproc

	Procedure my1
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
*messagebox(loObject.name)
	N= Int(Val(Substr(loObject.Name,8)))
	With Thisform.pageframe1
		.ActivePage=N
		.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 N,x
	m.n= Int(Val(Substr(loObject.Parent.Name,10)))
	m.x=loObject.Parent
	m.x.ZOrder(0)
	With Thisform.pageframe1
		.ActivePage=N
		.Refresh
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc


	Procedure ycont.Init
	With  This
		For i=1 To Thisform.pageframe1.PageCount
			.AddObject("container"+Trans(i),"asup")
			With Eval(".container"+Trans(i))
				If i=1
					.Left=5
				Else
					.Left=Eval("thisform.ycont.container"+Trans(i-1)+".left")+Eval("thisform.ycont.container"+Trans(i-1)+".width")-12
				Endi
				.Top=10
				Do Case
				Case i=1
					.image1.Picture="h1.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\face05.ico"
					.label1.Caption="Caption1"
					Thisform.pageframe1.Pages(1).Picture="v1.bmp"

				Case i=2
					.image1.Picture="h2.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\misc05.ico"
					.label1.Caption="Caption2"
					Thisform.pageframe1.Pages(2).Picture="v2.bmp"

				Case i=3
					.image1.Picture="h3.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\misc15.ico"
					.label1.Caption="Caption3"
					Thisform.pageframe1.Pages(3).Picture="v3.bmp"

				Case i=4
					.image1.Picture="h4.bmp"
					.image2.Picture=Home(1)+"graphics\icons\misc\clock02.ico"
					.label1.Caption="Caption4"
					Thisform.pageframe1.Pages(4).Picture="v4.bmp"

				Case i=5
					.image1.Picture="h5.bmp"
					.image2.Picture=Home(1)+"graphics\icons\win95\audio.ico"
					.label1.Caption="Caption5"
					Thisform.pageframe1.Pages(5).Picture="v5.bmp"

				Case i=6
					.image1.Picture="h6.bmp"
					.image2.Picture=Home(1)+"graphics\icons\win95\audio.ico"
					.label1.Caption="Caption6"
					Thisform.pageframe1.Pages(6).Picture="v6.bmp"
				Endcase
				.Visible=.T.
			Endwith

		Endfor

		.Left=Thisform.pageframe1.Left+2
		.Width=Thisform.pageframe1.PageCount*(Thisform.ycont.container1.Width-12)+20
	Endwith
	Endproc

	Procedure Init
	With Thisform.pageframe1
		.Width=.PageCount*(Thisform.ycont.container1.Width)
		.Top=Thisform.ycont.Top+Thisform.ycont.Height-12
		.ZOrder(1)
	Endwith
	Endproc

Enddefine
*
*-- EndDefine: ypgf


Define Class asup As Container
	Top = 12
	Left = -3
	Width = 120
	Height =30
	Picture = Home(1)+"graphics\icons\misc\misc05.ico"
	BackStyle = 0
	BorderWidth = 0
	MousePointer = 15
	Name = "asup"

	Add Object image1 As Image With ;
		Picture = "aquatab.bmp", ;
		Height = 40, ;
		Left = 4, ;
		Top = 0, ;
		Width = 112, ;
		stretch=2, ;
		borderstyle=1,;
		Name = "Image1"

	Add Object command1 As CommandButton With ;
		Top = -2, ;
		Left = 84, ;
		Height = 40, ;
		Width = 37, ;
		Caption = "", ;
		Style = 1, ;
		Name = "Command1"

	Add Object label1 As Label With ;
		FontSize = 8, ;
		BackStyle = 0, ;
		Caption = "Caption1", ;
		Height = 25, ;
		Left = 42, ;
		Top = 6, ;
		Width = 61, ;
		Name = "Label1"

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

	Procedure Init

	With This.command1
		.Left=-10
		.Top=-10
		.Width=.Parent.Width+20
		.Height=.Parent.Height+20
		.ZOrder(0)
		.MousePointer=15
	Endwith
	Bindevent(This.command1,"mousedown",Thisform,"my2")
	Endproc

Enddefine
*
*-- EndDefine: asup


Playing with vfp pageframes and subclassing

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

*5* created on sunday 30 of april 2017
*subclassing tabs with shapes and polypoint

 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

_Screen.WindowState=1
_Screen.AddProperty("act",1)   &&used to save the active atcual tab

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
	Top = 0
	Left = 0
	Height = 420
	Width = 700
	ShowWindow=2
	AutoCenter = .T.
	Caption = "Form1"
	Name = "Form1"

	Add Object pageframe1 As PageFrame With ;
		anchor=15,;
		PageCount = 7, ;
		Top = 32, ;
		Left = 24, ;
		Width = 493, ;
		Height = 197, ;
		Tabs = .F., ;
		Themes = .F., ;
		Name = "Pageframe1"


	Add Object ycont0 As Container With ;
		Top = 12, ;
		Left = 24, ;
		Width = 637, ;
		Height = 24, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "ycont0"


	Procedure pageframe1.Init
	With This
		.Width=500
		.Height=350
		For i=1 To .PageCount
			.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endfor

		.ZOrder(1)
		For i=1 To .PageCount
			.Pages(i).AddObject("image1","image")
			With .Pages(i).image1
				.Left=20
				.Top=20
				.Width=.Parent.Parent.Width-40
				.Height=.Parent.Parent.Height-40
				.Stretch=2

				Try
					Skip
				Catch
					Locate
				Endtry
				If Empty(ximage)
					Locate
				Endi
				.PictureVal=yloadImg(ximage)

				.Visible=.T.
			Endwith
		Endfor
		.Refresh
	Endwith
	Endproc


	Procedure ycont0.Init
	Local N
	N=Thisform.pageframe1.PageCount

	With This
		For i=1 To N
			.AddObject("ytab"+Trans(i),"ytab")
			With Eval(".ytab"+Trans(i))
				.Width=Int(Floor(Thisform.pageframe1.Width/(N)))
				.shape1.Width=.Width
				.label1.Caption="Page"+Trans(i)
				If i=1
					.Left=1
				Else
					.Left= Eval("thisform.ycont0.ytab"+Trans(i-1)+".left")+Eval("thisform.ycont0.ytab"+Trans(i-1)+".width")-7
				Endi
				.Top=0
				.Height=Thisform.ycont0.Height+10
				.ZOrder(1)
				Bindevent(.shape1,"mousedown",Thisform,"my")
				Bindevent(.label1,"mousedown",Thisform,"my")
				.Refresh
				.Visible=.T.
			Endwith
		Endfor
	Endwith
	Thisform.pageframe1.ActivePage=1
	This.ytab1.shape1.MouseDown(1)
	Endproc

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

	x=Int(Val(Substr(loObject.Parent.Name,5)))
	_Screen.act=m.x
	Thisform.pageframe1.ActivePage=m.x
	For i=1 To Thisform.pageframe1.PageCount
		o=Eval("thisform.ycont0.ytab"+Trans(i))
		o.shape1.FillColor=Rgb(0,255,0)

	Endfor
	loObject.Parent.shape1.FillColor=Thisform.pageframe1.Pages(x).BackColor

	With loObject.Parent.Parent.Parent.pageframe1.Pages(x).image1
		.Left=20
		.Top=20
		.Width=.Parent.Parent.Width-40
		.Height=.Parent.Parent.Height-40
	Endwith
	Endproc

	Procedure Resize
	u="thisform.ycont0.ytab"+Trans(_Screen.act)+".shape1.mousedown(1)"
	&u
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: asup

Define Class ytab As Container
	Top = 288
	Left = 204
	Width = 105
	Height = 24
	BackStyle = 0
	BorderWidth = 0
	Name = "Container2"


	Add Object shape1 As Shape With ;
		Top = 2, ;
		Left = 3, ;
		Height = 20, ;
		Width = 100, ;
		DrawMode = 13, ;
		FillStyle = 0, ;
		BackColor = Rgb(255,255,255), ;
		FillColor = Rgb(255,255,255), ;
		BorderColor = Rgb(0,0,0), ;
		mousepointer=15  , ;
		backstyle=1,;
		Name = "Shape1"

	Add Object label1 As Label With ;
		top=4,;
		left=10,;
		width=80,;
		height=20,;
		autosize=.T.,;
		forecolor=0,;
		mousepointer=15,;
		backstyle=0,;
		name="label1"

	Procedure Init
	Thisform.DrawWidth=4
	With This.shape1
		.AddProperty("Points[4,2]")
		Dimension .Points[4,2]
		.Points[1,1] = 0
		.Points[1,2] = 0
		.Points[2,1] = 100
		.Points[2,2] = 0
		.Points[3,1] = 90
		.Points[3,2] = 100
		.Points[4,1] = 10
		.Points[4,2] = 100
		.Polypoints = "this.Points"
		.Rotation=180
		.SpecialEffect=2
		.FillColor=Rgb(0,255,0)
		.BorderWidth=2
		.FillStyle=0    &&7
		.Height=.Parent.Height+5
	Endwith
	This.label1.Left=10
	Endproc

	Procedure shape1.Click
	N=Int(Val(Substr(This.Name,6)))
	Thisform.pageframe1.ActivePage=N
	Endproc

Enddefine
*
*-- EndDefine: ytab
*internet must be connected
Function yloadImg
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
Endfunc


can play with polypoint shape property and draw advanced tabs with Beziers curves...can overlap container class to make some visual effects.
can play with polypoint shape property and draw advanced tabs with Beziers curves...can overlap container class to make some visual effects.
can play with polypoint shape property and draw advanced tabs with Beziers curves...can overlap container class to make some visual effects.

can play with polypoint shape property and draw advanced tabs with Beziers curves...can overlap container class to make some visual effects.

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


*6* created on sunday 30 of april 2017
*its the same code as previous one but with native shapes objects in tabs.the shape curvature is used to round the shape corners.

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

_Screen.WindowState=1
_Screen.AddProperty("act",1)   &&used to save the active atcual tab


Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
	Top = 0
	Left = 0
	Height = 420
	Width = 700
	AutoCenter = .T.
	ShowWindow=2
	Caption = "Form1"
	Name = "Form1"

	Add Object pageframe1 As PageFrame With ;
		Anchor=15, ;
		PageCount = 7, ;
		Top = 32, ;
		Left = 24, ;
		Width = 600, ;
		Height = 197, ;
		Tabs = .F., ;
		Themes = .F., ;
		Name = "Pageframe1"

	Add Object ycont0 As Container With ;
		Top = 12, ;
		Left = 24, ;
		Width = 637, ;
		Height = 24, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		Name = "ycont0"

	Procedure pageframe1.Init
	DoDefault()
	With This
		.Width=500
		.Height=350
		For i=1 To .PageCount
			.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endfor
		.ZOrder(1)
		For i=1 To .PageCount
			.Pages(i).AddObject("image1","image")
			With .Pages(i).image1
				.Left=20
				.Top=20
				.Width=.Parent.Parent.Width-40
				.Height=.Parent.Parent.Height-40
				.Stretch=2
				Try
					Skip
				Catch
					Locate
				Endtry
				If Empty(ximage)
					Locate
				Endi
				.PictureVal=yloadImg(ximage)

				.Visible=.T.
			Endwith
		Endfor
		.Refresh
	Endwith
	Endproc

	Procedure ycont0.Init
	Local N
	N=Thisform.pageframe1.PageCount
	With This
		Local m.delta
		m.delta=0
		For i=1 To N
			.AddObject("ytab"+Trans(i),"ytabsh")

			With Eval(".ytab"+Trans(i))
				.Width=Int(Floor(Thisform.pageframe1.Width/(N)))
				.shape1.Width=.Width
				.shape1.BackColor=Thisform.pageframe1.Pages(i).BackColor
				.label1.Caption="Page"+Trans(i)
				If i=1
					.Left=3
				Else
					.Left= Eval("thisform.ycont0.ytab"+Trans(i-1)+".left")+Eval("thisform.ycont0.ytab"+Trans(i-1)+".width")-m.delta
				Endi
				.Top=0
				.Height=Thisform.ycont0.Height+15  &&to hide the bottom shape draw with container
				.ZOrder(1)

				Bindevent(.shape1,"mousedown",Thisform,"my")
				Bindevent(.label1,"mousedown",Thisform,"my")
				.Refresh
				.Visible=.T.
			Endwith

		Endfor
		Thisform.pageframe1.Top=This.Top+This.Height-2
	Endwith
	Thisform.pageframe1.ActivePage=1
	This.ytab1.shape1.MouseDown(1)

	Endproc


	Procedure Resize
	u="thisform.ycont0.ytab"+Trans(_Screen.act)+".shape1.mousedown(1)"
	&u
	Endproc

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

	x=Int(Val(Substr(loObject.Parent.Name,5)))
	Thisform.pageframe1.ActivePage=m.x
	With loObject.Parent.Parent.Parent.pageframe1.Pages(x).image1
		.Left=20
		.Top=20
		.Width=.Parent.Parent.Width-40
		.Height=.Parent.Parent.Height-40
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc
Enddefine
*
*-- EndDefine: asup

*
Define Class ytabsh As Container
	Top = 227
	Left = 30
	Width = 40
	Height = 27
	Name = "Container3"

	Add Object shape1  As Shape With ;
		anchor = 15,;
		left=0, ;
		top=0, ;
		width = 40, ;
		height = 27, ;
		curvature=30, ;
		backcolor = Rgb(255,0,0), ;
		borderwidth=0, ;
		visible = .T., ;
		mousepointer=15,;
		name="shape1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		Alignment = 2, ;
		Caption = "Page1", ;
		Height = 17, ;
		Left = 46, ;
		Top = 12, ;
		Width = 38, ;
		ForeColor = 0, ;
		mousepointer=15,;
		Name = "Label1"

	Procedure Init
	With This
		.BorderWidth=0
		.BackStyle=0

		With .shape1
			.Width=.Parent.Width
		Endwith

		With .label1
			.AutoSize=.T.
			.Left=10  &&(.parent.width-.width)/2
			.Top=(.Parent.Height-.Height)/2
			.ZOrder(0)
			.BackStyle=0
		Endwith

	Endwith
	Endproc

	Procedure shape1.Click
	N=Int(Val(Substr(This.Name,6)))
	Thisform.pageframe1.ActivePage=N
	Endproc

Enddefine
*
*-- EndDefine: ytabsh

*internet must be connected
Function yloadImg
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
Endfunc



Playing with vfp pageframes and subclassing
Playing with vfp pageframes and subclassing

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

                  


*7* created on saturday 20 of may 2017

*!*	A vfp pageframe  can be decorated as well as modern ones (as that we see on web apps).
*!*	this code uses 2 methods
*!*	1.a container with a background image .Each zone can be overlapped with 1 transparent shape.
*!*	  choose a relevant image as the one i made here with 10 buttons.
*!*	  the pageframe is then instancied with 8 buttons.

*!*	2.a container with labels only and one shape (as web Bootstrap does)
*!*	  in 2 cases the shape control is created for the purpose at mouseEnter  and destroyed at mouseLeave event.
*!*	  i used the great vfp function bindevent to bind all controls with 3 events:
*!*				  -mouseEnter
*!*				  -mouseLeave
*!*				  -MouseDown
*!*	 Of course in the page frame can fill with any vfp control or even olecontrols.Rightclick on any page to fire a demo contextuem menu.
*!* -on button item10 rightclick can fire the same menu(can customize)
*!*	-can show or hide the form titlebar.
*!* Press ESC to exit form (i made also in each page a png button exit)
*!* tweaking the ytbar1 or ytbar2 in method "my" can use only as main menu (without refrering to the pageframe).
*!*the demo uses 2 themed toolbars as container (can keep one only for use or build equivalent ones).

set defa to addbs(justpath(sys(16,1)))
*download one image  used in code(can change on PEM 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
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20170521/ob_18d2cb_1.png"
lcDownloadLoc ="1.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

Local m.myvar
TEXT to m.myvar pretext 7 noshow
					A vfp pageframe  can be decorated as well as modern ones (as that we see on web apps).
					this code uses 2 methods
					1.a container with a background image .Each zone can be overlapped with 1 transparent shape.
					  choose a relevant image as the one i made here with 10 buttons.
					  the pageframe is then instancied with 8 buttons.
					2.a container with labels only and one shape (as web Bootstrap does)
					in 2 cases the shape control is created for the purpose at mouseEnter  and destroyed at mouseLeave event.
					i used the great vfp function bindevent to bind all controls with 3 events:
					  -mouseEnter
					  -mouseLeave
					  -MouseDown
					Of course in the page frame can fill with any vfp control or even olecontrols.Rightclick on any page to fire a demo contextuem menu.
	   -on button item9 rightclick can fire the same menu(can customize)
					-can show or hide the form titlebar.
		-Press ESC key to exit form.(i made also in each page a png button exit)
		-on button item10 rightclick can fire the same menu(can customize)
		-tweaking the ytbar1 or ytbar2 in method "my" can use only as main menu (without refering to the pageframe).
    the demo uses 2 themed toolbars as container (can keep one only for use or build equivalent ones).
ENDTEXT
_Screen.AddProperty("yhelp",m.myvar)

Publi yform
yform=Newobject("ybars")
yform.Show
Read Events
Retu
*
Define Class ybars As Form
Height = 730
Width = 1009
ShowWindow = 2
ShowTips=.T.
AutoCenter = .T.
KeyPreview=.t.
Caption = "Modern use of vfp pageframes"
BackColor = Rgb(0,0,0)
Sign = 1
ybackc_shape = 255
yforec_label = (Rgb(0,0,255))
Name = "Form1"

Add Object ytbar1 As ytbar1 With ;
	Top = 1, ;
	Left = 0, ;
	Width = 1010, ;
	Height = 47, ;
	Name = "ytbar1"

Add Object pageframe1 As PageFrame With ;
	PageCount = 7, ;
	BorderWidth = 0, ;
	Top = 60, ;
	Left = 12, ;
	Width = 996, ;
	Height = 600, ;
	Tabs = .F., ;
	Themes = .F., ;
	Name = "Pageframe1"

Add Object ytbar2 As ytbar2 With ;
	Top = 676, ;
	Left = 5, ;
	Width = 982, ;
	Height = 48, ;
	BackStyle = 1, ;
	BorderWidth = 1, ;
	BackColor = Rgb(0,0,0), ;
	Name = "ytbar2"

PROCEDURE KEYPRESS   && esc to release the form here
LPARAMETERS nKeyCode, nShiftAltCtrl
if nkeycode=27
thisform.release
endi
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 my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.ForeColor=Thisform.yforec_label
loObject.FontBold=.T.
loObject.FontUnderline=.T.
loObject.MousePointer=15

With loObject.Parent
	Try
		.AddObject("yshp","shape")
	Catch
	Endtry

	With .yshp
		.BackColor=Thisform.ybackc_shape
		.ZOrder(0)
		.Curvature=15
		.Left=loObject.Left-5
		.Top=4
		.Width=loObject.Width+10
		.Height=loObject.Parent.Height-8
		.Curvature=15
		.MousePointer=15
		.Visible=.T.
	Endwith
Endwith
loObject.ZOrder(0)
Endproc


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

With loObject.Parent
	.RemoveObject("yshp")
	.Refresh
Endwith

With loObject
	.ForeColor=Rgb(255,255,255)
	.FontBold=.F.
	.FontUnderline=.F.
Endwith
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.Name,6)))
	
Do Case
Case  Lower(loObject.Parent.Name)=="ytbar1"
	If x<=Thisform.pageframe1.PageCount
		Thisform.pageframe1.ActivePage=m.x
		Thisform.ydrawL("Hello World",x)
	Endi

Case  Lower(loObject.Parent.Name)=="ytbar2"
	If x<=9
		Thisform.pageframe1.ActivePage=m.x
		Thisform.ydrawL("Hello World",x)
	Endi
Endcase

if m.x=9 &&fire contextuel menu in button10
thisform.yedMenu()
endi

if m.x=10
With Thisform
	.TitleBar=Iif(.TitleBar=1,0,1)
	If .TitleBar=0
		.Height=.Height+33
	Else
		.Height=.Height-33
	Endi
	.refresh
Endwith
endi

if x=11  &&help
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(_Screen.yhelp,0, 'summary help', 0+32+4096)  &&4,16,48,64...
oshell=Null
endi
Endproc

Procedure ydrawL   &&draw "hello world"
Lparameters xcaption,i
Local m.delta,Sign
Rand(-1)
Thisform.Sign=Iif(Thisform.Sign=1,-1,1)
m.delta=Thisform.Sign*Int(3 * Rand( ) + 3)

With Thisform.pageframe1.Pages(i)
	Try
 .AddObject("yim","yexit")
 .yim.visible=.t.
		.AddObject("yhello","label")
		.AddObject("yhello1","label")
	Catch
	Endtry

	With Eval (".yhello")
		.FontSize=72
		.FontBold=.T.
		.FontItalic=.T.
		.AutoSize=.T.
		.Alignment=0
		.Caption=xcaption+" page "+Trans(i)
		.Left=60
		.Top=180
		.BackStyle=0
		Rand(-1)
		.ForeColor=0
		.ZOrder(1)
		.Visible=.T.
	Endwith

	With Eval (".yhello1")
		.FontSize=72
		.FontBold=.T.
		.FontItalic=.T.
		.AutoSize=.T.
		.Alignment=0
		.Caption=xcaption+" page "+Trans(i)
		.Left=60+m.delta
		.Top=180+m.delta
		.BackStyle=0
		Rand(-1)
		.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.ZOrder(0)
		.Visible=.T.
	Endwith
	.Refresh
Endwith
Endproc

Procedure Activate
Thisform.ytbar1.label1.MouseDown(1)
Endproc

Procedure Init
Thisform.pageframe1.PageCount=Thisform.ytbar1.ypagecount
Thisform.ybackc_shape=255    &&rgb(0,255,0)   &&..
Thisform.yforec_label=Rgb(0,0,255)

With This.pageframe1
	.Anchor=15
	.Left=0
	.Top=.Parent.ytbar1.Top+.Parent.ytbar1.Height-1
	.Width=.Parent.Width
	.ZOrder(1)
	Rand(-1)
	For i=1 To .PageCount
		.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
  bindevent(.pages(i),"rightclick",thisform,"yedmenu")
	Endfor
Endwith

This.Resize
This.WindowState=2
Endproc

Procedure Resize
With Thisform
	With .ytbar1
		.Top=0
		.Left=0
		.Width=.Parent.Width
	Endwith

	With .pageframe1
		.Left=0
		.Top=.Parent.ytbar1.Top+.Parent.ytbar1.Height-2
		.Width=.Parent.Width
	Endwith

	With .ytbar2
		.Left=5
		.Top=.Parent.pageframe1.Top+.Parent.pageframe1.Height+30
		.Width=.Parent.Width-10
	Endwith
Endwith
Endproc

Procedure Destroy
yform=Null
Release yform
_Screen.yhelp=Null
Release _Screen.yhelp
Clea Events
Endproc

Enddefine
*
*-- EndDefine: ybars
*
*
DEFINE CLASS yTbar1 AS container
	Top = 0
	Left = 0
	Width = 996
	Height = 55
	Name = "ytBar1"
	ypagecount=11


	ADD OBJECT image1 AS image WITH ;
		Picture = "1.png", ;
		Height = 54, ;
		Left = 0, ;
		Top = 0, ;
		Width = 995, ;
		Name = "Image1"

	ADD OBJECT label1 AS label WITH ;
		Caption = "Item1", ;
		Height = 25, ;
		Left = 14, ;
		Top = 11, ;
		Width = 73, ;
		Name = "Label1"


	ADD OBJECT label2 AS label WITH ;
		Caption = "Item2", ;
		Height = 25, ;
		Left = 102, ;
		Top = 11, ;
		Width = 73, ;
		Name = "Label2"


	ADD OBJECT label3 AS label WITH ;
		Caption = "Item3", ;
		Height = 25, ;
		Left = 192, ;
		Top = 11, ;
		Width = 73, ;
		Name = "Label3"


	ADD OBJECT label4 AS label WITH ;
		Caption = "Item4", ;
		Height = 25, ;
		Left = 282, ;
		Top = 12, ;
		Width = 73, ;
		Name = "Label4"


	ADD OBJECT label5 AS label WITH ;
		Caption = "Item5", ;
		Height = 25, ;
		Left = 383, ;
		Top = 9, ;
		Width = 73, ;
		Name = "Label5"


	ADD OBJECT label6 AS label WITH ;
		Caption = "Item6", ;
		Height = 25, ;
		Left = 471, ;
		Top = 9, ;
		Width = 73, ;
		Name = "Label6"


	ADD OBJECT label7 AS label WITH ;
		Caption = "Item7", ;
		Height = 25, ;
		Left = 563, ;
		Top = 8, ;
		Width = 73, ;
		Name = "Label7"


	ADD OBJECT label8 AS label WITH ;
		Caption = "Item8", ;
		Height = 25, ;
		Left = 654, ;
		Top = 9, ;
		Width = 73, ;
		Name = "Label8"


	ADD OBJECT label9 AS label WITH ;
		Caption = "Item9", ;
		Height = 25, ;
		Left = 743, ;
		Top = 9, ;
		Width = 73, ;
		Name = "Label9"


	ADD OBJECT label10 AS label WITH ;
		Caption = "Titlebar", ;
		Height = 25, ;
		Left = 828, ;
		Top = 7, ;
		Width = 73, ;
		Name = "Label10"


	ADD OBJECT label11 AS label WITH ;
		Caption = "Help", ;
		Height = 25, ;
		Left = 911, ;
		Top = 8, ;
		Width = 73, ;
		Name = "Label11"


PROCEDURE Init
		With This
			.BackStyle=0
			.BorderWidth=0
			.Left=0
			.Top=0
			.Width=.Parent.Width
			.Anchor=0

			With .image1
				.Anchor=15
				.Left=0
				.Top=0
			Endwith

			.SetAll("backstyle",0,"label")
			.SetAll("mousepointer",15,"label")
			.SetAll("forecolor",Rgb(255,255,255),"label")
			.SetAll("alignment",2,"label")
			.SetAll("top",20,"label")

			j=0
			For i=1 To .ControlCount
					If Lower(.Controls(i).Class)=="label"
				j=j+1

					Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
					Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
					Bindevent(.Controls(i),"mouseDown",Thisform ,"my")
				Endi
			Endfor
			This.ypagecount=j
		Endwith

ENDPROC

ENDDEFINE
*
*-- EndDefine: ytbar1

*
Define Class ytbar2 As Container
Top = 676
Left = 5
Width = 982
Height = 48
BackStyle = 1
BorderWidth = 1
BackColor = Rgb(0,0,0)
Name = "ytbar2"

Add Object shape1 As Shape With ;
	Top = 0, ;
	Left = -17, ;
	Height = 48, ;
	Width = 980, ;
	Anchor = 15, ;
	Curvature = 15, ;
	BackColor = Rgb(0,0,0), ;
	Name = "Shape1"

Add Object label1 As Label With ;
	Caption = "Item1", ;
	Height = 35, ;
	Left = 8, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label1"	

Add Object label2 As Label With ;
	Caption = "Item2", ;
	Height = 25, ;
	Left = 96, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label2"

Add Object label3 As Label With ;
	Caption = "Item3", ;
	Height = 25, ;
	Left = 185, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label3"

Add Object label4 As Label With ;
	Caption = "Item4", ;
	Height = 25, ;
	Left = 278, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label4"

Add Object label5 As Label With ;
	Caption = "Item5", ;
	Height = 25, ;
	Left = 367, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label5"

Add Object label6 As Label With ;
	Caption = "Item6", ;
	Height = 25, ;
	Left = 460, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label6"

Add Object label7 As Label With ;
	Caption = "Item7", ;
	Height = 25, ;
	Left = 548, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label7"

Add Object label8 As Label With ;
	Caption = "Item8", ;
	Height = 25, ;
	Left = 640, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label8"

Add Object label9 As Label With ;
	Caption = "Item9", ;
	Height = 25, ;
	Left = 734, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label9"

Add Object label10 As Label With ;
	Caption = "TITLEBAR", ;
	Height = 25, ;
	Left = 821, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label10"
	
Add Object label11 As Label With ;
	Caption = "Help", ;
	Height = 25, ;
	Left = 908, ;
	Top = 2, ;
	Width = 73, ;
	Name = "Label11"	

Procedure Init
With This
	.Anchor=0
	.BackStyle=0
	.Left=5
	.BorderWidth=0
	.Top=.Parent.pageframe1.Top+.Parent.pageframe1.Height+1
	.Width=.Parent.Width-10

	.SetAll("backstyle",0,"label")
	.SetAll("mousepointer",15,"shape")
	.SetAll("Forecolor",Rgb(255,255,255),"label")
	.SetAll("height",30,"label")
	.setall("top",10,"label")
	.SetAll("alignment",2,"label")

	j=0		
	For i=1 To .ControlCount
	
		If Lower(.Controls(i).Class)=="label"			
	j=j+1

			Bindevent(.Controls(i),"mouseEnter",Thisform ,"my1")
			Bindevent(.Controls(i),"mouseLeave",Thisform ,"my2")
			Bindevent(.Controls(i),"mouseDown",Thisform ,"my")
		Endi
	Endfor
.refresh
Endwith
Endproc

Procedure shape1.Init
With This
	.Anchor=15
	.backstyle=0
	.Left=0
	.Top=0
	.ZOrder(1)
Endwith
Endproc
Enddefine
*
*-- EndDefine: ytbar2


define class yexit as image
left=800
top=540
mousepointer=15
backstyle=0
stretch=0
name="yim"

procedure init
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAEQAAAAkCAYAAAAw55zoAAAFCElEQVRoge2ae1BUZRiHn7O7riywIBcBUa6CYupAYOXkhKmICSUoKVNOg2nZxUmzxdTGFE2zJs2srLEMR0eb0RxExzJtzLsyoGLihUzipgRykW1XFtjdc/pjhWB1sj/OujXsM/PO7L7fznt+8+7v+84533yCJEkAnCupSt3/88U3Kqob4/QGUyA9AG+tpi4i1K94Skr8ypiooJMAgiRJfLu7cPXZoz8smjFgJ1Ee5WiUrc7W+kBosWooNUaxuTqTcSmpi9KfivtQOHuhMnX7ptx970W/j1owO1ujU2gR3Vh8Ncf6lm7mSGVYTPL6dPW66ABVHaJIjwylZEGrNCiO3xzmpfq9qj4hNKAcS880RycD1Vf5rqx2lOpPQ2uAyr8Vs+hsSc5Fyy0ab90OUQFYLM6W899BBWDu4dOlKy6H2OFyiB0uh9jhcogdDnFIWNZWfEe+cFe+rbGCy0si7l9AUDJk6SXUfmFU5E5Hfz5PXoH/gEMc0ssv8p75PwyQug3yM+9TQCGAUk27FRYeFBmhh+dmZxOSsZqGgm2Ub35RXsEdKEEBNofIGXdeoFm7di2CIHRGREQEkvQvarRbKNRFEtlXw978fCQRFG59EJQqTjX4sPyI/Jo7ZolDHNLREIBpMfB6fPdxv1GzGDTrK9r1dZxdHIvZUE//ifMZ+PxH3Dy9g9IvppOw+gLXcwdzcc0kQp5ZiM/QMQCkpaWRlibRcCafS+smyyu8t4MdotPp2HFFYvR2W2gHj8VigRtHttFYU05vn36Uxi/HoAwgfEoOoigx9uWVrDgBKk9fFCo1q85p0Zusd2k/ViXyzhH5HaIAm0PkjK4O6crbxwSKaqDd1EbZ5jcByJo1m34vbUXl7sWXGz6ntPQKmdHAnRqiBF/PGc+mdasA2LNnD4IgkJGRgdzawUF3ma5rSHZ2drexJ0farldftI+rp/Yz6PGJJCROoLmpkSXLcng6HILdO/tha4oVRvf/+/tjgbDkUdtnubU7fA2ZFA4zYrqPm82AQklgUHBnzkPrRVRoMFMD9LbxLjUsVrB2mTWi5LhnJ4c6BGwbMPeqH5U+B+/IWC7+UkyT3kBiYiIffPwpJUvH09uj+29FK1jNtiLh4eGo3dxRemppa66TVzgOdohOp0On03XmW5vryUsPwM0nkKFZKwCYO1+Hh8XAE0cLSUpKYt+WKQRW53VrqsUK+uprAMTGxnKi8jY3in5i77xkvNXyarfdZczyhuFG+T0vZrQIvHoSBk9bQC8PL/J27eLw4cMMbTpD8e5vEEWRmQuWUVAL7UY9VqsVo9GI1QJlB3ZwOm8Lzc3NtLS0kPtjARsuy6sbQJg6e6M04fwr8rYZ2FQGBY135z1V8Ek87KyCg7WQ4AOvRdvGtpTDiXror4Gc4fDuBahthbmDYHgfsIiwtQKKb4FVguQgSB8gn+YDcRttDRlXJH9D/o8cemTjnTXE9frfiWs/xA7XfogdLofY4XKIHS6H2KHy1mrq2tAEKswmZ2txKhZ3P/x9PStVA8P7nrnuE5WqqSlxtianYvSP4aHooOOqyRPj3l9+KjOlb81vgmDuGedC7BHdtBgefrY9IyV+pfKz9WuqVZ5epsK2kDFSi1EhtZqgzeT0IwoPIswaP0yh8RiS5rRnZSXPixsWckDoOFJVVlE/4vtDJfNLr9WOamgyhjn5T3sg+Pt6Vg6JDjqekRK/Mjioz68AfwFylycUM2AeIQAAAABJRU5ErkJggg==
endtext
this.PictureVal=strconv(m.myvar,14)
endproc

procedure click
thisform.release
endproc

enddefine


the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).
the demo uses 2 themed  toolbars as container (can keep one only for use).

the demo uses 2 themed toolbars as container (can keep one only for use).

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

Comment on this post