Simulating a metro menu as win8.1 & win10

Published on by Yousfi Benameur


This code  simulates a metro menu as win8.1 or win10.It creates a single class used for all  the animated controls and linking to do some vfp actions.
the class uses images located in some pointed folder and animates them in 4 directions by a timer with variable interval between 10 to 20 s.
When there is too  controls (13 in the code), VFP seems to be buzzy and gives the hand to a click event difficultly.
i made some large timer interval to permit to free resources and receive each click to fire an action from any class control.I guess this phenomena is due to mono task vfp behavior.
of course can make a project, add the 2 prg below +a config.fpw and compile an exe.
NB:To run some win10 UI Apps internet must be connected.
Warning: each ui APP is quite fond memory and consumes not less than 20 Mbytes see (in taskmanager).

-The second code simulates a collapsed menu with clickable images on form .
*tested on visual foxpro 9 sp2-windows 10

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


*from class ymetro0.vcx
*set before begin the images folder in this code(this.yrep=...).use exclusively jpg images as pointed in code.
*save this code mandatory as ymetro0.prg.its called from the main prg
Define Class ymetro As Container
    Width = 253
	Height = 216
	BorderColor = Rgb(0,0,0)
	yswap = 0
	gnbre = 0
	yrep = .F.
	Name = "asup"

	Add Object image1 As Image With ;
		Picture = "..\ybackg.jpg", ;
		Stretch = 2, ;
		BorderStyle = 1, ;
		Height = 217, ;
		Left = 0, ;
		Top = 0, ;
		Width = 253, ;
		Name = "Image1"

	Add Object image2 As Image With ;
		Picture = "..\yfennec.png", ;
		Stretch = 2, ;
		BorderStyle = 1, ;
		Height = 217, ;
		Left = 0, ;
		Top = 0, ;
		Width = 253, ;
		Name = "Image2"

	Add Object timer1 As Timer With ;
		Top = 12, ;
		Left = 24, ;
		Height = 23, ;
		Width = 23, ;
		Interval = 8000, ;
		Name = "Timer1"

	Add Object ylab As Label With ;
		FontBold = .T., ;
		FontSize = 9, ;
		Anchor = 768, ;
		Alignment = 2, ;
		BackStyle = 0, ;
		Caption = "YLABCaption", ;
		Height = 20, ;
		Left = -1, ;
		Top = 192, ;
		Width = 253, ;
		ForeColor = Rgb(0,255,0), ;
		Name = "ylab"

	Procedure yaction
	Messagebox("do something from this yaction()",0+22+4096,"",1000)
	Endproc

	Procedure Init
	Declare Integer Sleep In kernel32 Integer
	This.yswap=0

	This.yrep=Addbs("C:\USERS\YOUSFI\PICTURES")  &&set your images folder here
	This.gnbre=Adir(gabase,This.yrep+"*.jpg")

	If This.gnbre=0  &&no image jpg
		Messagebox("no images",16+4096,"error",1000)
		Return .F.
	Endi

	With This
		.ylab.Height=20

		With .image1
			.Stretch=2
			.Left=0
			.Top=0
			.Width=.Parent.Width
			.Height=.Parent.Height
			.MousePointer=15
			.ZOrder(0)
		Endwith

		With .image2
			.Stretch=2
			.Left=0
			.Top=0
			.Width=.Parent.Width
			.Height=.Parent.Height
			.MousePointer=15
			.ZOrder(1)
		Endwith
	Endwith

	With This.image2
		This.gnbre=Adir(gabase,This.yrep+"*.jpg")
		gnLower = 1
		gnUpper = This.gnbre
		Local i
		m.i= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)
		.Picture=This.yrep+gabase(i,1)
	Endwith

	With This.image1
		This.gnbre=Adir(gabase,This.yrep+"*.jpg")
		gnLower = 1
		gnUpper = This.gnbre
		Local i
		m.i= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)
		.Picture=This.yrep+gabase(i,1)
	Endwith

	With This.ylab
		.Left=0
		.Height=20
		.Top=.Parent.Height-.Height
		.Width=.Parent.Width
		.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.ZOrder(0)
	Endwith

	With This.timer1
		.Interval=Int((20000 - 8000 + 1) * Rand( ) + 8000)  &&between 8,20 sec
	Endwith

	DoDefault()
	Endproc

	Procedure image1.Click
	This.Parent.yaction()
	Endproc

	Procedure image2.Click
	This.Parent.yaction()
	Endproc

	Procedure timer1.Timer
	Local w,x
	m.w=This.Width
	This.Parent.yswap=This.Parent.yswap+1
	If This.Parent.yswap>2
		This.Parent.yswap=1
	Endi

	gnLower = 1
	gnUpper = 4
	m.x= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)

	Do Case
	Case  This.Parent.yswap=1

		With This.Parent.image2

			This.Parent.gnbre=Adir(gabase,This.Parent.yrep+"*.jpg")
			gnLower = 1
			gnUpper = This.Parent.gnbre
			Local i
			m.i= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)
			.Picture=This.Parent.yrep+gabase(i,1)
			.ZOrder(0)

			Do Case
			Case x=1
				.Left=-.Width-1
				Do While .Left<=0
					.Left=.Left+2
					Sleep(10)
				Enddo
				.Left=0

			Case x=2
				.Top=-.Height-1
				Do While .Top<=0
					.Top=.Top+2
					Sleep(10)
				Enddo
				.Top=0

			Case x=3
				.Left=.Width+1
				Do While .Left>=0
					.Left=.Left-2
					Sleep(10)
				Enddo
				.Left=0

			Case x=4
				.Top=.Height-1
				Do While .Top>=0
					.Top=.Top-2
					Sleep(10)
				Enddo
				.Top=0
			Endcase

		Endwith

	Case  This.Parent.yswap=2
		With This.Parent.image1

			This.Parent.gnbre=Adir(gabase,This.Parent.yrep+"*.jpg")
			gnLower = 1
			gnUpper = This.Parent.gnbre
			Local i
			m.i= Int((gnUpper - gnLower + 1) * Rand( ) + gnLower)
			.Picture=This.Parent.yrep+gabase(i,1)
			.ZOrder(0)

			Do Case
			Case x=1
				.Left=-.Width-1
				Do While .Left<=0
					.Left=.Left+2
					Sleep(10)
				Enddo
				.Left=0

			Case x=2
				.Top=-.Height-1
				Do While .Top<=0
					.Top=.Top+2
					Sleep(10)
				Enddo
				.Top=0

			Case x=3
				.Left=.Width+1
				Do While .Left>=0
					.Left=.Left-2
					Sleep(10)
				Enddo
				.Left=0

			Case x=4
				.Top=.Height-1
				Do While .Top>=0
					.Top=.Top-2
					Sleep(10)
				Enddo
				.Top=0
			Endcase

		Endwith

	Endcase

	With This.Parent.ylab
		.Left=0
		.Height=20
		.Top=.Parent.Height-.Height
		.Width=.Parent.Width
		.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.ZOrder(0)
	Endwith

	with this
.interval=INT((200000 - 10000 + 1) * RAND( ) + 10000)  &&between 10,20 sec
endwith

	Endproc

	Procedure ylab.Init
	With This
		.Left=0
		.Height=20
		.Top=.Parent.Height-.Height
		.Width=.Parent.Width
		.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.ZOrder(0)
	Endwith
	Endproc

Enddefine
*
*-- EndDefine: ymetro
**************************************************


 

 
this class is built here as ymetro0.prg but can rebuild it as ymetro0.vcx visual class simply by creating manually a container class, add it 2 images (image1,image2),  label ylab and a timer timer1.
copy the codes in the prg above in the specific methods of the class.init also the properties (gnbre,yrep,yswap).
and you can embed it manually (by dragging it on any form as any vfp control)...
of course,can accommodate the class to your tastes...

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



*Save this code as ymetro.prg

Set Proc To ymetro0.prg AddI
Publi yform
yform=Newobject("ymetrof")
Release Proc ymetro0
yform.Show
Read Events

Define Class ymetrof As Form
    Height = 657
	Width = 918
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Form1"
	AlwaysOnBottom = .T.
	BackColor = Rgb(0,0,0)
	Name = "Form1"

	Add Object asup1 As ymetro With ;
		Top = 119, ;
		Left = 276, ;
		Width = 312, ;
		Height = 252, ;
		Name = "Asup1", ;
		Image1.Picture = "..\150327.jpg", ;
		Image1.Name = "Image1", ;
		Image2.Picture = "..\weather.png", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Notepad", ;
		ylab.Name = "ylab"

	Add Object asup2 As ymetro With ;
		Top = 132, ;
		Left = 612, ;
		Width = 228, ;
		Height = 192, ;
		Name = "Asup2", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Explorer", ;
		ylab.Top = 160, ;
		ylab.Name = "ylab"

	Add Object asup3 As ymetro With ;
		Top = 156, ;
		Left = 24, ;
		Width = 180, ;
		Height = 132, ;
		Name = "Asup3", ;
		Image1.Picture = "..\yclipped_round.jpg", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "MSPAINT", ;
		ylab.Top = 110, ;
		ylab.Name = "ylab"

	Add Object asup4 As ymetro With ;
		Top = 300, ;
		Left = 48, ;
		Width = 144, ;
		Height = 84, ;
		Name = "Asup4", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Iexplore", ;
		ylab.Name = "ylab"

	Add Object asup5 As ymetro With ;
		Top = 396, ;
		Left = 72, ;
		Width = 672, ;
		Height = 156, ;
		Name = "Asup5", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "DateTime", ;
		ylab.Name = "ylab"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "BATAVIA", ;
		FontSize = 48, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "VFP Menu a la metro", ;
		Height = 90, ;
		Left = 84, ;
		Top = 12, ;
		Width = 781, ;
		ForeColor = Rgb(255,128,0), ;
		Name = "Label1"


	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "BATAVIA", ;
		FontSize = 48, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "VFP Menu a la metro", ;
		Height = 90, ;
		Left = 78, ;
		Top = 12, ;
		Width = 781, ;
		ForeColor = Rgb(0,255,255), ;
		Name = "Label2"

	Add Object asup6 As ymetro With ;
		Top = 588, ;
		Left = 98, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup6", ;
		Image1.Picture = "..\150330.jpg", ;
		Image1.Name = "Image1", ;
		Image2.Picture = "..\ymetro.jpg", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Firefox", ;
		ylab.Name = "ylab"


	Add Object asup7 As ymetro With ;
		Top = 588, ;
		Left = 190, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup7", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "ACROBAT", ;
		ylab.Name = "ylab"

	Add Object asup8 As ymetro With ;
		Top = 587, ;
		Left = 282, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup8", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Calculator", ;
		ylab.Name = "ylab"


	Add Object asup9 As ymetro With ;
		Top = 588, ;
		Left = 373, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup9", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Reader", ;
		ylab.Name = "ylab"


	Add Object asup10 As ymetro With ;
		Top = 588, ;
		Left = 464, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup10", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "News", ;
		ylab.Name = "ylab"

	Add Object asup11 As ymetro With ;
		Top = 587, ;
		Left = 556, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup11", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Sports", ;
		ylab.Name = "ylab"

	Add Object asup12 As ymetro With ;
		Top = 586, ;
		Left = 648, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup12", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Photos", ;
		ylab.Name = "ylab"


	Add Object asup13 As ymetro With ;
		Top = 585, ;
		Left = 740, ;
		Width = 90, ;
		Height = 48, ;
		Name = "Asup13", ;
		Image1.Name = "Image1", ;
		Image2.Name = "Image2", ;
		Timer1.Name = "Timer1", ;
		ylab.Caption = "Meteo", ;
		ylab.Name = "ylab"

	Procedure Destroy
	Clea Events
	Endproc

	Procedure Init
	_Screen.WindowState=1
	This.ShowTips=.T.
	Endproc

	Procedure asup1.yaction
	Run/N notepad
	Endproc


	Procedure asup2.yaction
	Run/N explorer
	Endproc

	Procedure asup3.yaction
	Run /N mspaint
	Endproc

	Procedure asup4.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="iexplore.exe"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc

	Procedure asup5.yaction
	Messagebox(Ttoc(Datetime()) ,0+32+4096,"",1000)
	Endproc

	Procedure asup6.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="firefox.exe"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


	Procedure asup7.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="acrord32.exe"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


	Procedure asup8.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="calc.exe"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc

	Procedure asup9.yaction
*this code launches the modern ui reader app with shellEXECUTE API as command line parameter
&&shellexecute
	Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
		STRING cOperation,;
		STRING cFileName,;
		STRING cParameters,;
		STRING cDirectory,;
		INTEGER nShowWindow

	Local m.x
	m.x=" shell:Appsfolder\Microsoft.Reader_8wekyb3d8bbwe!Microsoft.Reader"
	result = ShellExecute(0, "open", Addbs(Getenv('windir'))+"explorer.exe ",m.x,"",3)
	Endproc


	Procedure asup10.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="BingNews://"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


	Procedure asup11.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="BingSports://"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


	Procedure asup12.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="ms-Photos://"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


	Procedure asup13.yaction
	Local loshell,m.winappName
	loshell=Newobject("wscript.shell")
	m.winappName="BingWeather://"
	Try
		loshell.Run(m.winappName)
	Catch
		Messagebox("An error was occured !",16+4096)
	Endtry
	Endproc


Enddefine
*
*-- EndDefine: ymetrof
**************************************************


 

Simulating a metro menu as win8.1 &amp; win10
Simulating a metro menu as win8.1 &amp; win10
Simulating a metro menu as win8.1 &amp; win10
Simulating a metro menu as win8.1 &amp; win10

*2-this code below is updated on Friday 28 august 2015 11:06
*this code simulates a collapsed menu on a form with clicked images.There is not timer to change the picture as first code.

*before running the code,initialize the images folder as m.yrep variable in code.make the images count up to 14 preferently.
clicking any image can run any code or app you want.Can code this in method form.my .


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


*2-Updated on Friday 28 august 2015 11:06
*this code simulate a collapsed menu on a form with clicked images.
*before running the code,initialize   the images folder as m.yrep
Publi yform
yform=Newobject("ycollapse")
yform.Show
Read Events
Retu
*
Define Class ycollapse As Form
    Top = 7
	Left = 71
	Height = 521
	Width = 733
	ShowWindow = 2
	Caption = "yCollapsed menu"
	BackColor = Rgb(0,0,0)
	ycl = 0
	Name = "Form1"

	Add Object container1 As Container With ;
		Top = 0, ;
		Left = 23, ;
		Width = 588, ;
		Height = 432+72, ;
		BackStyle = 1, ;
		BorderWidth = 0, ;
		BackColor = Rgb(0,0,0), ;
		Name = "Container1"


	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+ " clicked- Can launch any code from this event in my method!",0+32+4096,"",1200)
    
	&&code the action you want to do  below...
	do case
	case lower(loobject.name)="image1"
	case lower(loobject.name)="image2"
	case lower(loobject.name)="image3"
	case lower(loobject.name)="image4"
	case lower(loobject.name)="image5"
	case lower(loobject.name)="image6"
	case lower(loobject.name)="image7"
	case lower(loobject.name)="image8"
	case lower(loobject.name)="image9"
	case lower(loobject.name)="image10"
	case lower(loobject.name)="image11"
	case lower(loobject.name)="image12"
	case lower(loobject.name)="image13"
	case lower(loobject.name)="image14"
	endcase
	
	Endproc

	Procedure Load
	Declare Integer Sleep In kernel32 Integer
	Endproc

	Procedure Init
	With Thisform
		.Left=0
		.Top=0
		.Width=Sysmetric(1)-10
		.Height=700
	Endwith

	With This.container1
		.AddObject( "image1","image")
		With .image1
			.Stretch = 2
			.Height = 100
			.Left = 17
			.MousePointer = 15
			.Top = 0
			.Width = 133
			.Visible=.T.
			.Name = "Image1"
		Endwith

		.AddObject( "image2","image")
		With .image2
			.Stretch = 2
			.Height = 100
			.Left = 151
			.MousePointer = 15
			.Top = 0
			.Width = 133
			.Visible=.T.
			.Name = "Image2"
		Endwith

		.AddObject("image3","image")
		With .image3
			.Stretch = 2
			.Height = 100
			.Left = 288
			.MousePointer = 15
			.Top = 1
			.Width = 133
			.Visible=.T.
			.Name = "Image3"
		Endwith

		.AddObject( "image4","image")
		With .image4
			.Stretch = 2
			.Height = 53
			.Left = 437
			.MousePointer = 15
			.Top = 24
			.Width = 83
			.Visible=.T.
			.Name = "Image4"
		Endwith

		.AddObject( "command1","commandbutton")
		With .command1
			.Top = 185
			.Left = 558
			.Height = 37
			.Width = 30
			.FontBold = .T.
			.FontName = "Webdings"
			.FontSize = 20
			.Caption = "4"
			.MousePointer = 15
			.ForeColor = Rgb(255,128,0)
			.Visible=.T.
			.Name = "Command1"
		Endwith

		.AddObject( "image5" ,"image")
		With .image5
			.Stretch = 2
			.Height = 100
			.Left = 15
			.MousePointer = 15
			.Top = 108
			.Width = 190
			.Visible=.T.
			.Name = "Image5"
		Endwith

		.AddObject( "image6" ,"image")
		With .image6
			.Stretch = 2
			.Height = 72
			.Left = 207
			.MousePointer = 15
			.Top = 122
			.Width = 79
			.Visible=.T.
			.Name = "Image6"
		Endwith

		.AddObject("image7" ,"image")
		With .image7
			.Stretch = 2
			.Height = 100
			.Left = 288
			.MousePointer = 15
			.Top = 109
			.Width = 133
			.Visible=.T.
			.Name = "Image7"
		Endwith

		.AddObject( "image8","image")
		With .image8
			.Stretch = 2
			.Height = 100
			.Left = 422
			.MousePointer = 15
			.Top = 109
			.Width = 133
			.Visible=.T.
			.Name = "Image8"
		Endwith

		.AddObject( "image9" ,"image")
		With .image9
			.Stretch = 2
			.Height = 100
			.Left = 14
			.MousePointer = 15
			.Top = 215
			.Width = 133
			.Visible=.T.
			.Name = "Image9"
		Endwith

		.AddObject( "image10" ,"image")
		With .image10
			.Stretch = 2
			.Height = 100
			.Left = 149
			.MousePointer = 15
			.Top = 215
			.Width = 133
			.Visible=.T.
			.Name = "Image10"
		Endwith

		.AddObject( "image11" ,"image")
		With .image11
			.Stretch = 2
			.Height = 64
			.Left = 311
			.MousePointer = 15
			.Top = 228
			.Width = 85
			.Visible=.T.
			.Name = "Image11"
		Endwith

		.AddObject( "image12" ,"image")
		With .image12
			.Stretch = 2
			.Height = 100
			.Left = 422
			.MousePointer = 15
			.Top = 216
			.Width = 133
			.Visible=.T.
			.Name = "Image12"
		Endwith

		.AddObject( "image13" ,"image")
		With .image13
			.Stretch = 2
			.Height = 100
			.Left = 22
			.MousePointer = 15
			.Top = 326
			.Width = 261
			.Visible=.T.
			.Name = "Image13"
		Endwith

		.AddObject("image14" ,"image")
		With .image14
			.Stretch = 2
			.Height = 100
			.Left = 335
			.MousePointer = 15
			.Top = 324
			.Width = 191
			.Visible=.T.
			.Name = "Image14"
		Endwith

    .addobject("label2","label")
	with .label2
	.AutoSize = .T.
	.FontBold = .T.
	.FontName = "BATAVIA"
	.FontSize = 28
	.BackStyle = 0
	.Caption = "yCollapsed menu"
	.Height = 53
	.Left = 69
	.Top = 435
	.Width = 377
	.ForeColor = RGB(255,255,0)
	.visible=.t.
	.Name = "Label2"
    endwith
    
	.addobject("label1","label")
	with .label1
	.AutoSize = .T.
	.FontBold = .T.
	.FontName = "BATAVIA"
	.FontSize = 28
	.BackStyle = 0
	.Caption = "yCollapsed menu"
	.Height = 53
	.Left = 69+2
	.Top = 435-2
	.Width = 377
	.ForeColor = RGB(0,255,0)
	.visible=.t.
	.Name = "Label1"
    endwith
      
	endwith


	With Thisform.container1
		.SetAll("mousepointer",15,"image")
		.SetAll("Stretch",2,"image")
		.SetAll("visible",.T.,"image")


		Local gnbre,yrep
		m.yrep=Addbs("E:\____YMEDIA\YICONES\___YICONES_PNG")  &&must contains images count>= container images controls
		gnbre=Adir(gabase,m.yrep+"*.png")

		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="image"
				.Controls(i).Picture=m.yrep+gabase(i,1)
			Endi
		Endfor



		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="image"
				Bindevent(.Controls(i),"mousedown",Thisform,"my")
			Endi
		Endfor

		Bindevent(.command1,"mousedown",Thisform,"my1")
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure container1.Init
	With This
		.Left=-.Width+30
		.BackColor=.Parent.BackColor
	Endwith
	Endproc

	Procedure my1
	Lparameters nButton, nShift, nXCoord, nYCoord

	With Thisform
		.ycl=Iif(.ycl=1,0,1)
	Endwith

	Thisform.container1.command1.Visible=.F.

	Do Case
	Case Thisform.ycl=1
		Thisform.container1.command1.Caption="3"
		With Thisform.container1
			Do While .Left<=0
				.Left=.Left+10
				Sleep(5)
			Enddo
			.Left=-30
		Endwith

	Case Thisform.ycl=0
		Thisform.container1.command1.Caption="4"
		With Thisform.container1
			Do While .Left>=-.Width+30
				.Left=.Left-10
				Sleep(2)
			Enddo
			.Left=-.Width+30
		Endwith
	Endcase
	Thisform.container1.command1.Visible=.T.
	Endproc

Enddefine
*
*-- EndDefine: ycollapse
***********************************


 

Simulating a metro menu as win8.1 &amp; win10

Published on visual foxpro, metro apps, menu

To be informed of the latest articles, subscribe:
Comment on this post