A desktop application with subclassed pageframe and some effects

Published on by Yousfi Benameur

      

this code builds an application based on a subclassed pageframe tabs with an image.it give opportunity to write applications without digging in complex classes.
the pagecount=8 here (set always pageframe.pagecount as in image in container).
each page can embed any vfp control(s) or even olecontrols.
the main image is covered with transparent shapes binded to 3 events (mousedown,mouseEnter and mouseLeave).
the mousedown event can fire any  programme,form,report or external app(notepad,MSpaint,ie,firefox...).
i used the special shape effect with shape.drawmode property to have some native vfp transparency .there is a set of 23 clickable icons to fire any application ( as a similar toolbar).
i added the special  exit effect with also a shape and drawmode=9.
2 images are used in this code with no disc access (pictureVal property with internet connected of course)
the first image is duplicated in 3 versions (same image) and at each start its rendomly set (1 of 3).
the main form is movable by mousedown on image.
with this artifact can build any desktop application .

[post 232]


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



*1*created on 09 of may 2017. 
*updated on 10 of may 2017 (3 background images instead one previously).

Publi yform
yform=Newobject("ypgf")
yform.Show
Read Events
Retu
*
Define Class ypgf As Form
	BorderStyle = 0
	Height = 604
	Width = 984
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Form1"
	BackColor = Rgb(44,108,157)
	xleft = .F.
	xtop = .F.
	xwidth = .F.
	xheight = .F.
	Name = "Form1"

	Add Object container1 As ycont  With ;
		Top = 0, ;
		Left = 0, ;
		Width = 984, ;
		Height = 204, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		BackColor = Rgb(240,240,240), ;
		Name = "Container1"

	Add Object pageframe1 As PageFrame With ;
		ErasePage = .T., ;
		PageCount = 8, ;
		Anchor = 15, ;
		Top = 204, ;
		Left = -12, ;
		Width = 996, ;
		Height = 396, ;
		Tabs = .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", ;
		Page6.Caption = "Page6", ;
		Page6.Name = "Page6", ;
		Page7.Caption = "Page7", ;
		Page7.Name = "Page7", ;
		Page8.Caption = "Page8", ;
		Page8.Name = "Page8"

	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.Name,6)))
	If Between(x,1,8)
		Thisform.pageframe1.ActivePage=x
	Else
		Thisform.yactions(m.x)
	Endi
	Endproc

	Procedure my1
	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)))

	With loObject
		.ToolTipText=.Name
		.DrawMode=9
		.BackStyle=1
		If m.x<=8
			.BackColor=Rgb(0,255,0)
		Else
			.BackColor=255
		Endi
		.Curvature=15
*.fillcolor=rgb(0,255,0)
	Endwith
	Endproc

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

	Procedure yactions
	Lparameters x
	Messagebox("Shape"+Trans(x)+" clicked ...do some code from thisform.yactions() !",0+32+4096,'',1000)

*write code actions to run here
*	do case
*!*	case x= 9
*!*	case x= 10
*!*	case x= 11
*!*	case x= 12
*!*	case x= 13
*!*	case x= 14
*!*	case x= 15
*!*	case x= 16
*!*	case x= 17
*!*	case x= 18
*!*	case x= 19
*!*	case x= 20
*!*	case x= 21
*!*	case x= 22
*!*	case x= 23
*!*	case x= 24
*!*	case x= 25
*!*	case x= 26
*!*	case x= 27
*!*	case x= 28
*!*	case x= 29
*!*	case x= 30
*!*	case x= 31
*!*	endcase
	Endproc


	Procedure Init
	Thisform.TitleBar=0
	_Screen.WindowState=1
	Endproc

	Procedure QueryUnload
	With Thisform
		If .pageframe1.ActivePage=1
			.pageframe1.ActivePage=2  &&to avoid  olecontrol  in page1 always on top
		Endi
		Try
			.AddObject("zshape","shape")
		Catch
		Endtry

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

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

	Procedure Activate
	Thisform.WindowState=2
	Endproc

	Procedure Destroy
	Clea Events
	Endproc


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

		With .Page1
			.AddObject("olecontrol1","olecontrol", "shell.explorer.2")
			With .olecontrol1
				.Top = 0
				.Left = 0
				.Height = 397
				.Width = 997
				.Anchor = 15
				.Name = "Olecontrol1"
				Thisform.ybuild()
				.Visible=.T.
			Endwith
		Endwith

		With .Page2
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\buchstev.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith

			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\calllaur.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith

		With .Page3
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\bridjust.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith

			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\davonanc.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith

		With .Page4
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\kingrobe.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith

			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\dodsanne.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith

		With .Page5
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\fullandr.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith

			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\levejane.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith
		With .Page6
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\martxavi.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith
			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\pattcaro.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith

		With .Page7
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\calllaur.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith
			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\peacmarg.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith

		With .Page8
			.AddObject("image1","image")
			With .image1
				.Picture =Home(1)+ "samples\tastrade\bitmaps\pattcaro.bmp"
				.Height = 223
				.Left = 58
				.Top = 46
				.Width = 192
				.Name = "Image1"
				.Visible=.T.
			Endwith

			.AddObject("image2","image")
			With .image2
				.Picture = Home(1)+"samples\tastrade\bitmaps\peacmarg.bmp"
				.Height = 223
				.Left = 593
				.Top = 107
				.Width = 192
				.Name = "Image2"
				.Visible=.T.
			Endwith
		Endwith
	Endwith
	Endproc

	Procedure  ybuild
	With Thisform.pageframe1.Page1.olecontrol1
		.silent=.T.
		.Left=0
		.Top=0
		.Width =.Parent.Parent.Width
		.Height=.Parent.Parent.Height

		Local m.myvar
		TEXT to m.myvar noshow
		<!DOCTYPE html>
		<html>
		<head>
		  <meta http-equiv="content-type" content="text/html; charset=UTF-8">
		  <meta name="robots" content="noindex, nofollow">
		  <meta name="googlebot" content="noindex, nofollow">

		    <script type="text/javascript" src="http://code.jquery.com/jquery-1.5.2.js"></script>
		    <link rel="stylesheet" type="text/css" href="http://fiddle.jshell.net/css/normalize.css">
		    <link rel="stylesheet" type="text/css" href="http://fiddle.jshell.net/css/result-light.css">

		  <style type="text/css">
		    .image {
		    position:relative;
		}
		.image img {
		    width:100%;
		    vertical-align:top;
		}
		.image:after {
		    content:'\A';
		    position:absolute;
		    width:100%; height:100%;
		    top:0; left:0;
		    background:rgba(0,0,0,0.6);
		    opacity:0;
		    transition: all 0.5s;
		    -webkit-transition: all 0.5s;
		}
		.image:hover:after {
		    opacity:1;
		}
		  </style>

		  <title></title>

		  <script type='text/javascript'>//<![CDATA[
		$(window).load(function(){
		});//]]>
		</script>

		</head>

		<body>
		  <div class="image">
		    <img src="http://i.stack.imgur.com/Sjsbh.jpg" alt="" />
		</div>

		  <script>
		  // tell the embed parent frame the height of the content
		  if (window.parent && window.parent.parent){
		    window.parent.parent.postMessage(["resultsFrame", {
		      height: document.body.getBoundingClientRect().height,
		      slug: "s6q288sw"
		    }], "*")
		  }
		</script>
		</body>
		</html>
		ENDTEXT
		.Navigate("about:blank")
		.Document.Open()
		.Document.Write(m.myvar)
		.Document.Close()

	Endwith
*	.parent.refresh
	Endproc


Enddefine
*
*-- EndDefine: ypgf

*
Define Class ycont As Container
	Top = 0
	Left = 0
	Width = 984
	Height = 204
	BackStyle = 0
	BorderWidth = 0
	BackColor = Rgb(240,240,240)
	Name = "Container1"

	Add Object image1 As Image With ;
		Picture = "_template_pgf1.png", ;
		Height = 204, ;
		Left = 0, ;
		Top = 0, ;
		Width = 984, ;
		Name = "Image1"

	Add Object shape1 As Shape With ;
		Top = 90, ;
		Left = 12, ;
		Height = 44, ;
		Width = 84, ;
		Name = "Shape1"

	Add Object shape2 As Shape With ;
		Top = 91, ;
		Left = 108, ;
		Height = 39, ;
		Width = 97, ;
		Name = "Shape2"

	Add Object shape3 As Shape With ;
		Top = 86, ;
		Left = 224, ;
		Height = 49, ;
		Width = 112, ;
		Name = "Shape3"

	Add Object shape4 As Shape With ;
		Top = 84, ;
		Left = 346, ;
		Height = 49, ;
		Width = 170, ;
		Name = "Shape4"

	Add Object shape5 As Shape With ;
		Top = 84, ;
		Left = 527, ;
		Height = 50, ;
		Width = 104, ;
		Name = "Shape5"

	Add Object shape6 As Shape With ;
		Top = 84, ;
		Left = 641, ;
		Height = 51, ;
		Width = 139, ;
		Name = "Shape6"

	Add Object shape7 As Shape With ;
		Top = 84, ;
		Left = 785, ;
		Height = 49, ;
		Width = 67, ;
		Name = "Shape7"

	Add Object shape8 As Shape With ;
		Top = 89, ;
		Left = 858, ;
		Height = 43, ;
		Width = 109, ;
		Name = "Shape8"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 36, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "Hello World!", ;
		Height = 60, ;
		Left = 36, ;
		Top = 12, ;
		Width = 282, ;
		ForeColor = Rgb(255,255,0), ;
		Name = "Label1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 36, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "Hello World!", ;
		Height = 60, ;
		Left = 32, ;
		Top = 13, ;
		Width = 282, ;
		ForeColor = Rgb(0,255,0), ;
		Name = "Label2"

	Add Object image2 As Image With ;
		Picture = "_applications-office.png", ;
		Stretch = 2, ;
		Height = 65, ;
		Left = 810, ;
		MousePointer = 15, ;
		Top = 11, ;
		Width = 65, ;
		Name = "Image2"

	Add Object text1 As TextBox With ;
		BorderStyle = 0, ;
		Height = 25, ;
		Left = 658, ;
		Top = 136, ;
		Width = 215, ;
		Name = "Text1"

	Add Object shape9 As Shape With ;
		Top = 168, ;
		Left = 185, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape9"

	Add Object shape10 As Shape With ;
		Top = 168, ;
		Left = 217, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape10"

	Add Object shape11 As Shape With ;
		Top = 168, ;
		Left = 249, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape11"

	Add Object shape12 As Shape With ;
		Top = 168, ;
		Left = 281, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape12"

	Add Object shape13 As Shape With ;
		Top = 168, ;
		Left = 314, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape13"

	Add Object shape14 As Shape With ;
		Top = 168, ;
		Left = 348, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape14"

	Add Object shape15 As Shape With ;
		Top = 168, ;
		Left = 379, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape15"

	Add Object shape16 As Shape With ;
		Top = 168, ;
		Left = 412, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape16"

	Add Object shape17 As Shape With ;
		Top = 168, ;
		Left = 446, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape17"

	Add Object shape18 As Shape With ;
		Top = 168, ;
		Left = 481, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape18"

	Add Object shape19 As Shape With ;
		Top = 168, ;
		Left = 515, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape19"

	Add Object shape20 As Shape With ;
		Top = 168, ;
		Left = 550, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape20"

	Add Object shape21 As Shape With ;
		Top = 168, ;
		Left = 584, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape21"

	Add Object shape22 As Shape With ;
		Top = 168, ;
		Left = 616, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape22"

	Add Object shape23 As Shape With ;
		Top = 168, ;
		Left = 652, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape23"

	Add Object shape24 As Shape With ;
		Top = 168, ;
		Left = 686, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape24"

	Add Object shape25 As Shape With ;
		Top = 168, ;
		Left = 720, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape25"


	Add Object shape26 As Shape With ;
		Top = 168, ;
		Left = 759, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape26"

	Add Object shape27 As Shape With ;
		Top = 168, ;
		Left = 799, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape27"

	Add Object shape28 As Shape With ;
		Top = 168, ;
		Left = 840, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape28"

	Add Object shape29 As Shape With ;
		Top = 168, ;
		Left = 878, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape29"

	Add Object shape30 As Shape With ;
		Top = 168, ;
		Left = 914, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape30"

	Add Object shape31 As Shape With ;
		Top = 168, ;
		Left = 950, ;
		Height = 32, ;
		Width = 32, ;
		BackStyle = 0, ;
		Name = "Shape31"

	Add Object command1 As CommandButton With ;
		Top = 11, ;
		Left = 958, ;
		Height = 20, ;
		Width = 20, ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 768, ;
		Caption = "X", ;
		MousePointer = 15, ;
		SpecialEffect = 2, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object command2 As CommandButton With ;
		Top = 11, ;
		Left = 912, ;
		Height = 20, ;
		Width = 20, ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 768, ;
		Caption = "-", ;
		MousePointer = 15, ;
		SpecialEffect = 2, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command2"

	Add Object command3 As CommandButton With ;
		Top = 11, ;
		Left = 935, ;
		Height = 20, ;
		Width = 20, ;
		FontBold = .T., ;
		FontName = "Webdings", ;
		FontSize = 9, ;
		Anchor = 768, ;
		Caption = "1", ;
		MousePointer = 15, ;
		SpecialEffect = 2, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command3"


	Procedure Init
	With This
		Rand(-1)   &&set a random background picture (1 of 3)
		Local  rr
		rr=Int((3) * Rand( ) + 1)
		Try
			Do Case
			Case rr=1
				.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_d85cdb_template-pgf1.png")
				.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
				Thisform.BackColor=Rgb(44,108,157)

			Case rr=2
				.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170510/ob_563011_template-pgf2.png")
				.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
				Thisform.BackColor=0

			Case rr=3
				.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170510/ob_6f63c8_template-pgf3.png")
				.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
				Thisform.BackColor=Rgb(255,242,0)
			Endcase

		Catch
		Endtry

		.Left=0
		.Top=0
		.SetAll("backstyle",0,"shape")
		.SetAll("borderstyle",0,"shape")
		.SetAll("mousepointer",15,"shape")
		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="shape"
				Bindevent(.Controls(i),"mousedown",Thisform,"my")
				Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
				Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
			Endi
		Endfor
	Endwith
	Endproc

	Procedure image1.Init
	With This
		.Left=0
		.Top=0
		.Stretch=0
		.ZOrder(1)
	Endwith
	Endproc

	Procedure image2.Click
	Local m.myvar
	TEXT to m.myvar pretext 7 noshow
	this code builds an application based on a subclassed pageframe tabs with an image.it give opportunity to write applications without digging in complex classes.
the pagecount=8 here.
each page can embed any vfp control(s) or even olecontrols.
the main image is covered with transparent shapes binded to 3 events (mousedown,mouseEnter 	and mouseLeave).
the mousedown event can fire any  programme,form,report or external app(notepad,MSpaint,ie,firefox...).
i used the special shape effect with shape.drawmode property to have some native vfp transparency .there is a set of 23 clickable icons to fire any application ( as a similar toolbar).
i added the special  exit effect with also a shape and drawmode=9.
2 images are used in this code with no disc access (pictureVal property with internet connected of course)
with this artifact can build any desktop application .

	ENDTEXT
*Messagebox(m.myvar,0+32+4096)
	Local oshell
	oshell = Createobject('WScript.Shell')
	oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096)  &&4,16,48,64...
	oshell=Null
	Endproc

	Procedure command1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=255
	Endproc

	Procedure command1.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=Rgb(0,255,0)
	Endproc

	Procedure command1.Click
	Thisform.QueryUnload()      &&release or not
	Endproc

	Procedure command2.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=Rgb(0,255,0)
	Endproc


	Procedure command2.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=255
	Endproc

	Procedure command2.Click
	Try
		yaerot.WindowState=1
	Catch
	Endtry
	Thisform.WindowState=1
	Endproc

	Procedure command3.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=255
	Endproc

	Procedure command3.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.BackColor=Rgb(0,255,0)
	Endproc

	Procedure command3.Click
	Do Case
	Case This.Caption=="1"
		This.Caption="2"

		With Thisform
			.xleft=.Left
			.xtop=.Top
			.xwidth=.Width
			.xheight=.Height
			.Left=0
			.Top=0
			.Width=Sysmetric(1)
			.Refresh
		Endwith

	Case This.Caption=="2"
		This.Caption="1"
		With Thisform
			.Left=.xleft
			.Top=.xtop
			.Width=.xwidth
		Endwith
	Endcase
	Endproc

Enddefine
*
*-- EndDefine: ycont

Function yloadImg
Lparameters lcURL
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcURL,.F.)
m.loRequest.Send()
local m.x
m.x=m.loRequest.ResponseBody
m.loRequest=Null
Return m.x
Endfunc



if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !
if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !
if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !
if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !
if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !
if change the shipped  web images by images on disc  dont omit to change pictureVal to picture !

if change the shipped web images by images on disc dont omit to change pictureVal to picture !

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


*2*  created on saturday 10 of june 2017
*this code uses only the tabs of a pageframe to align as clickable buttons to run some custom codes.it looks like a dockable toolbar.
*the themes must be set to .f. -here the pagecount=10 (10 buttons)
*the tabOrienttion tweaked with some code below, makes the buttons in 4 sides of the form (change the spinner value and click on any tab).

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
	BorderStyle = 3
	Top = 0
	Left = 0
	Height = 522
	Width = 1007
	ShowWindow = 2
	ScrollBars = 2
	Caption = "Using a pageframe as buttons toolbar"
	Name = "Form1"

	Add Object pageframe1 As PageFrame With ;
		ErasePage = .T., ;
		PageCount = 10, ;
		Top = 0, ;
		Left = 0, ;
		Width = 1009, ;
		Height = 32, ;
		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", ;
		Page6.Caption = "Page6", ;
		Page6.Name = "Page6", ;
		Page7.Caption = "Page7", ;
		Page7.Name = "Page7", ;
		Page8.Caption = "Page8", ;
		Page8.Name = "Page8", ;
		Page9.Caption = "Page9", ;
		Page9.Name = "Page9", ;
		Page10.Caption = "Page10", ;
		Page10.Name = "Page10"

	Add Object spinner1 As Spinner With ;
		Height = 37, ;
		KeyboardHighValue = 3, ;
		KeyboardLowValue = 0, ;
		Left = 384, ;
		SpinnerHighValue =   3.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 144, ;
		Width = 85, ;
		Name = "Spinner1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontSize = 12, ;
		BackStyle = 0, ;
		Caption = "Taborientation (0-1-2-3)", ;
		Height = 21, ;
		Left = 369, ;
		Top = 185, ;
		Width = 167, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Procedure my
	*--- aevent create an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	Messagebox(loObject.Caption +" clicked....can run some code from here!",0+32+4096,'',1200)
	Endproc

	Procedure Resize
	Thisform.spinner1.InteractiveChange()
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure pageframe1.Init
	With This
		.Themes=.F.
		Rand(-1)
		For i=1 To .PageCount
			.Pages(i).BackColor=Rgb( 255*Rand(),255*Rand(),255*Rand())
			.MousePointer=15
			.Height=30
			.Pages(i).Caption="MyCaption"+Trans(i)
      .pages(i).fontbold=.t.
			Bindevent(.Pages(i),"click",Thisform,"my")
		Endfor
	Endwith
	Endproc

	Procedure spinner1.InteractiveChange
	Do Case
	Case This.Value=0
		With Thisform.pageframe1
			.Height=30
			.Top=0
			.Width=0.9*.Parent.Width
			.Left=0
		Endwith

	Case This .Value=1
		With Thisform.pageframe1
			.Height=30
			.Top=Thisform.Height-30
			.Width=0.9*.Parent.Width
			.Left=0
		Endwith

	Case This.Value=2
		With Thisform.pageframe1
			.Top=0
			.Height=0.9*Thisform.Width
			.Width=30
			.Left=0
		Endwith

	Case This.Value=3
		With Thisform.pageframe1
			.Top=0
			.Height=0.9*Thisform.Width
			.Width=30
			.Left=.Parent.Width-30
		Endwith

	Endcase
	With Thisform.pageframe1
		.TabOrientation=This.Value
		.Refresh
    .parent.refresh
	Endwith
	Endproc


Enddefine
*
*-- EndDefine: asup


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

Comment on this post