Simulating a metro menu as win8.1 & win10
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
**************************************************
*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
***********************************