Visual Foxpro and design time working

Published on by Yousfi Benameur


Working with vfp objects at design time is completely diffrent with the runtime.
At design time there is some usefull functions  as:
 -aselobj
 -GetPEm
 -ReadMethod
 -WriteMethod
 -Saveas
 -collections (for each obj in ...foxObject)
 -.....
Must retain that all what is made by the vfp designers (form,class) can be done programmatly.
Vfp have implemented a great quantity of specific windows (see vfp menu and vfp toolbars).i made a menu in a class combo with 26 maners to fire these windows but warning some windows as "document view","form designer","class designer" are localized( depends on language set on the machine).
can navigate at design time in form , class or prg code with buttons, fire the document view and navigate also in codes.
each code have its information points at the begining.



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


*1* add a small toolbar to work at design time on forms,classes and prg editor.save this code as a prg and run.
*this code works with the yinfo.prg in code *1.1* below

*issue modi form ?,modi class? or modi comm? on command window.

With _Screen
If Type(".oToolbar")="O" And !Isnull(.oToolbar)
Else
    .AddProperty("otoolbar",.F.)
Endif
.oToolbar=Create("zlistener_form")
.oToolbar.Show
Endwith
*

DEFINE CLASS zlistener_form AS toolbar
    Caption = "Toolbar1"
	Height = 38
	Left = 0
	Top = 0
	Width = 260
	lx = .F.
	ycount = .F.

	ADD OBJECT image1 AS image WITH ;
		Picture = home(1)+"graphics\icons\writing\book02.ico", ;
		Stretch = 0, ;
		Height = 32, ;
		Left = 5, ;
		MousePointer = 15, ;
		Top = 3, ;
		Width = 32, ;
		Name = "Image1"

	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 3, ;
		Left = 36, ;
		Height = 23, ;
		Width = 23, ;
		FontBold = .T., ;
		FontName = "Webdings", ;
		FontSize = 11, ;
		Caption = "5", ;
		MousePointer = 15, ;
		ToolTipText = "Back", ;
		ForeColor = RGB(255,0,0), ;
		BackColor = RGB(128,255,0), ;
		Name = "Command1"

	ADD OBJECT command2 AS commandbutton WITH ;
		Top = 3, ;
		Left = 58, ;
		Height = 22, ;
		Width = 23, ;
		FontBold = .T., ;
		FontName = "Webdings", ;
		FontSize = 11, ;
		Caption = "6", ;
		MousePointer = 15, ;
		ToolTipText = "Forward", ;
		ForeColor = RGB(255,0,0), ;
		BackColor = RGB(128,255,0), ;
		Name = "Command2"

	ADD OBJECT separator10 AS separator WITH ;
		Top = 3, ;
		Left = 88, ;
		Height = 0, ;
		Width = 0, ;
		Name = "Separator10"

	ADD OBJECT command8 AS commandbutton WITH ;
		Top = 3, ;
		Left = 88, ;
		Height = 22, ;
		Width = 36, ;
		Caption = "View", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command8"

	ADD OBJECT separator2 AS separator WITH ;
		Top = 3, ;
		Left = 131, ;
		Height = 0, ;
		Width = 0, ;
		Name = "Separator2"

	ADD OBJECT combo1 AS combobox WITH ;
		FontBold = .T., ;
		FontSize = 8, ;
		Height = 24, ;
		Left = 131, ;
		Top = 3, ;
		Width = 80, ;
		ForeColor = RGB(128,0,64), ;
		Name = "Combo1"

	ADD OBJECT separator1 AS separator WITH ;
		Top = 3, ;
		Left = 218, ;
		Height = 0, ;
		Width = 0, ;        
		Name = "Separator1"
        
     Add Object command10 As CommandButton With ;
    	Top = 3, ;
		Left = 234, ;
		Height = 22, ;
		Width = 32, ;
		Caption = "PEM", ;
		Name = "Command10"   

	Add Object separator5 As Separator With ;
    	Top = 3, ;
		Left = 295, ;
		Height = 0, ;
		Width = 0, ;
		Name = "Separator5"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 14, ;
		Caption = "X", ;
		Height = 25, ;
		Left = 295, ;
		MousePointer = 15, ;
		Top = 3, ;
		Width = 15, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	ADD OBJECT timer1 AS timer WITH ;
		Top = 3, ;
		Left = 232, ;
		Height = 23, ;
		Width = 23, ;
		Interval = 1000, ;
		Name = "Timer1"
        
  Procedure yr
    	Declare Integer SetCursorPos In WIN32API Integer, Integer
		Declare mouse_event In user32.Dll Long,Long,Long,Long,Long
		#Define MOUSEEVENTF_RIGHTDOWN  8
		#Define MOUSEEVENTF_RIGHTUP  16
		*move the cursor where you need it, I guessed at 200,200
		=SetCursorPos(200,200)
		*send a down+up event
		=mouse_event(MOUSEEVENTF_RIGHTDOWN,0,0,0,0)
		=mouse_event(MOUSEEVENTF_RIGHTUP,0,0,0,0)
		sleep(50)
		Local oshell
		oshell=Newobject("wscript.shell")
		oshell.sendkeys("{j}")
		oshell=Null
	Endproc        

	PROCEDURE Init
		this.dock(0)
		declare integer Sleep in kernel32 integer
		this.lx=""
		this.setall("mousepointer",15,"commandbutton")
		**to run this class make a prg xith this code
		*With _Screen
		*	If Type(".oToolbar")="O" And !Isnull(.oToolbar)
		*	Else
		*		.AddProperty("otoolbar",.F.)
		*	Endif
		*set classlib to yview2.vcx additive
		*	.oToolbar=Create("yview2")
		*release classlib yview2
		*	.oToolbar.Show
		*Endwith
	ENDPROC

	Procedure image1.Click
    	Local m.myvar
		TEXT to m.myvar noshow
this class works on form designer with design mode.
it detects the form opened and can navigate into its
method (back or forward).
it does anything if there is no form opened.
a timer controls if there is a form opend in designer with
an interval :1 second.it alert for its name if form changed.
it docked as toolbar on the main vfp window.
if any form opened with form designer the 2 buttons are disabled.
they are enabled in inverse.
simply execute the code to launch it and issue
modi form ? modi class ? or modi comm ? in command window
The button View lauches the document view (activated if for/class/prg opened)
The button PEM is a code to gather methods\events for any object on a form
or the form itself.It displays only the filled methods\events for any selected control
at design time.a form yinfo used as  viewer.
added 26 vfp internal windows in combo and diffrent maners to play with.
someones must be fired in context(ex intellisence-quicjinfo-members list)
		ENDTEXT
		Messagebox(m.myvar,0+32+4096,"Help")
	Endproc

	PROCEDURE command1.Click
		Try
		if ! Empty(This.Parent.lx)
				Keyboard("{PGUP}")
				Sleep(20)
				Keyboard("{PGUP}")
				Endi
		Catch
		Endtry
	ENDPROC

	PROCEDURE command2.Click
		Try
		If ! Empty(This.Parent.lx)
			Keyboard("{PGDN}")
			Sleep(20)
			Keyboard("{PGDN}")
		Endi
		Catch
		Endtry
	ENDPROC

	PROCEDURE command8.Click
*document view is localized  "document" in english and "vue" in french....
*better is to launch it with sys(1500...see the combo sample)

DECLARE SHORT GetSystemDefaultLangID IN kernel32
if GetSystemDefaultLangID()=1036  &&french
activate window vue
else
activate window document
endi
 
mouse click at 100,100 pixels
	ENDPROC

	PROCEDURE combo1.Click
		do case
		case this.value=1
		activate window properties

		case this.value=2
		activate window calculator

		case this.value=3
		activate window calendar

		case this.value=4
		keyboard "{F1}"

		case this.value=5
		activate window view

		case this.value=6
		DO (_BROWSER)

		case this.value=7
		 DO (_OBJECTBROWSER)
		
		case this.value=8
		do (_toolbox)

		case this.value=9
		activate window command

		case this.value=10
		do (_taskpane)

		case this.value=11
		do (_tasklist)

		case this.value=12
        wait window (" a selection must be made before") timeout 1
		Sys(1500,'_MED_BEAUT','_MTOOLS')

		case this.value=13
		Sys(1500,'_MTL_OPTNS','_MTOOLS')

		case this.value=14
		SYS(1500,'_MST_ABOUT','_MSYSTEM')
        
        Case This.Value=15
    			If !Empty(Thisform.lx)
					This.Parent.yr()
				Endi
case this.value=16
SYS(1500,'_MED_LISTMEMBERS','_MEDIT')        
 
case this.value=17
SYS(1500,'_MED_SLCTA','_MEDIT')

case this.value=18
SYS(1500,'_MED_QUICKINFO','_MEDIT')    

case this.value=19
SYS(1500,'_MED_PREF','_MEDIT')

case this.value=20 
 SYS(1500,'_MVI_TOOLB','_MVIEW')
 

case this.value=21
SYS(1500,'_MTL_GALLERY','_MTOOLS')
  
case this.value=22
SYS(1500,'_MTI_DOCVIEW','_MTOOLS')

case this.value=23
sys(1500,'_MTL_DEBUGGER','_MTOOLS')

CASE this.Value=24
SYS(1500,'_MTI_FOXCODE','_MTOOLS')

CASE this.Value=25
SYS(1500,'_MTL_COVERAGE','_MTOOLS')

case this.value=26
DO(_FOXREF)

endcase
endproc

procedure combo1.init
	with this
.additem("1. Properties")
.additem("2. Calc")
.additem("3. Calendar")
.additem("4. vfp help")
.additem("5. View")
.additem("6. class explorer")
.additem("7. object explorer")
.additem("8. Tool box")
.additem("9. command Window")
.additem("10. Taskpane")
.additem("11. taskList")
.additem("12. Beautify")
.additem("13. options")
.additem("14. About vfp")
.additem("15. Objects list ")
.additem("16. List Members ")
.additem("17. Select All ")
.additem("18. QuickInfo  ")
.additem("19. Properties  ")
.additem("20. Toolbars ")
.additem("21. Component Gallery ")
.additem("22. Document View(bis) ")
.additem("23. Debugger")
.additem('24. Intellisence manager')
.AddItem("25. Coverage profiler")
.Additem("26. Lookup reference")

.listindex=1
.value=1
.style=2
endwith

	PROCEDURE label1.Click
		This.Parent.timer1.Enabled=.F.
		_Screen.oToolbar=Null
	ENDPROC
    
    Procedure command10.Click
    	If  Empty(This.Parent.lx)
			Messagebox("no designer form/class")
			Return .F.
		Endi

		Local Array la1[1]
        try
		Aselobj(la1)
		Local obj
		toObject=la1(1)  && form.object selected
		If !Vartype(toObject)="O"
			Aselobj(la1,1)   && form selected
			toObject=la1(1)
		Endi

		N=Amembers(laMembers, toObject,3)
		Messagebox(toObject.Name+"  members n="+Trans(N),0+32+4096,'',1000)

		Create Cursor ocurs (Method c(15),Type c(10),Param c(20), Help m,Code m)
		For i = 1 To Alen(laMembers)
			Try
				If Inlist(Lower(laMembers(i,2)),"method","event")
					x=Getpem(toObject, laMembers(i,1))
					If ! Empty(m.x)
						Insert Into ocurs Values (laMembers(i,1),laMembers(i,2),laMembers(i,3),laMembers(i,4),m.x)
					Endi
				Endi
			Catch
			Endtry
		Endfor
		Sele ocurs
		*brow title toObject.name+ " filled="+trans(reccount())+"/"+trans(n)

		xtitle="  Object:"+toObject.Name+"  Methods/events filled:"+Trans(Reccount())+"\"+Trans(N)
		Do yinfo.prg  With xtitle
  catch
  endtry
	Endproc


	PROCEDURE timer1.Timer
				*ASELOBJ( ArrayName, [ 1 | 2 | 3 ] )   &&*2  Full path and name of .scx or .vcx file
				Local gnObjects
				gnObjects=Aselobj(myArray,3)
				*3 Creates three-element array containing information in context with the currently active code editing window:
				* object reference to a container object, the full path and name of the .scx or .vcx file, and
				*the full path and name of the #INCLUDE file, if available.

				If gnObjects>=1
					This.Parent.command1.Enabled=.T.
					This.Parent.command2.Enabled=.T.

					Y=myArray(2,2)

					If !Lower(This.Parent.lx)==Lower(m.y)
						This.Parent.ycount=0
						This.Parent.lx=m.y
					Endi

					If This.Parent.ycount=0
						Messagebox(This.Parent.lx,0+32+4096,'Alert- form changed in designer !',2000)
						This.Parent.ycount=1
					Endi
				Else
					This.Parent.command1.Enabled=.F.
					This.Parent.command2.Enabled=.F.

		      endi
	ENDPROC

ENDDEFINE
*
*-- EndDefine: zlistener_form



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


*code *1.1* 
*save this code as yinfo.prg.it  works with the toolbar class above (code *1*)

Lparameters xpar
yinfo=Newobject("yinfo")
If Pcount()=0
    yinfo.Caption="   [click help or Coded to display contents]"
Else
	yinfo.Caption=xpar+"   [click help or Code to display contents]"
Endi

yinfo.Show(1)
*
Define Class yinfo As Form
	Height = 490
	Width = 640
	AutoCenter = .T.
	Caption = "Form1"
	MaxButton = .F.
	MinButton = .F.
	WindowType = 1
	BackColor = Rgb(212,208,200)
	Name = "Form1"

	Add Object edit1 As EditBox With ;
		FontBold = .T., ;
		FontSize = 10, ;
		Anchor = 15, ;
		BorderStyle = 1, ;
		Height = 300, ;
		Left = 6, ;
		ReadOnly = .T., ;
		ScrollBars = 0, ;
		Top = 180, ;
		Width = 630, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Edit1"

	Add Object grid1 As Grid With ;
		FontSize = 8, ;
		Anchor = 768, ;
		Height = 156, ;
		Left = 4, ;
		RowHeight = 17, ;
		ScrollBars = 0, ;
		Top = 8, ;
		Width = 632, ;
		Name = "Grid1"

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

	Procedure Init


		Sele ocurs
		With Thisform.grid1
			.RecordSource="ocurs"
			.DeleteMark=.F.
			.GridLines=0
			.SetAll("fontbold",.T.,"header")
			.SetAll("fontsize",11,"header")
			.column1.Width=150
			.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(215,225,255) , RGB(255,235,220))", "Column")
			For i=3 To .ColumnCount  &&col3,4
				Bindevent(.Columns(i).text1,"mouseDown",Thisform,"my")
			Endfor
			Locate
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: yinfo


Visual Foxpro and design time working

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


*2*
*create a form programmatly (without the form designer-could be same thing with class without class designer..
*use aselobj,writeMethod,saveas
*this makes a replacement of designer.all creation form is made programmatly.

Clea All

Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yform"+Sys(2015) &&unique form in temp

Create Form (m.lcdest) Nowait
Local Array la1[1]
Aselobj(la1, 1)
Local oform
oform=la1(1)
With   oform
    .Width=800
	.Height=600
	.AutoCenter=.T.
	.Caption="this is a aselobj test"
	.ShowWindow=2
	.BackColor=Rgb(0,255,0)
	.TitleBar=0
	.AddProperty("uu", [trans(pi())])
	.AddProperty("vv", [pi()] )
	.AddObject("text1","textbox")
	.text1 .Left=10
	.text1.Top=10
	.text1.Value="hello world!"
	.AddObject("command1","commandbutton")
	.command1.Caption="click me!"
	.command1.Top=50
	.command1.Left=10

	Local m.myvar
	TEXT to m.myvar noshow
  messagebox(ttoc(dateTime())+"  Hello World !")
	ENDTEXT
	.command1.WriteMethod("click", m.myvar)

	.AddObject("labelx","label")
	With .labelx
		.Caption="Mousedown to move the form-can press ESC to release (or X)"
		.AutoSize=.T.
		.Top=20
		.Left=.Parent.text1.Left+.Parent.text1.Width+20
		.ForeColor=255
	Endwith

	Local m.ym
	TEXT to m.ym noshow
  Lparameters nButton, nShift, nXCoord, nYCoord
		If !Thisform.WindowState=2
			lnHandle = Thisform.HWnd
			param1 = 274
			param2 = 0xF012
			bb=ReleaseCapture()
			bb=SendMessage(lnHandle, param1, param2,0)
		Endi
	ENDTEXT
	.WriteMethod("mousedown",m.ym)

	.AddObject("label1","label")
	With .label1
		.Caption="X"
		.FontSize=14
		.FontBold=.T.
		.BackStyle=0
		.ForeColor=255
		.MousePointer=15
		.Top=5
		.Left=.Parent.Width-20
	Endwith
	.label1.WriteMethod("click","thisform.release")


	TEXT to m.ym noshow
  Declare Integer GetWindowLong In user32;
			INTEGER HWnd, Integer nIndex

		Declare Integer SetWindowLong In user32;
			INTEGER HWnd, Integer nIndex, Integer dwNewLong

		Declare Integer SetLayeredWindowAttributes In user32;
			INTEGER HWnd, Integer crKey,;
			SHORT bAlpha, Integer dwFlags
		Declare Integer ReleaseCapture In WIN32API
			Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	ENDTEXT
	.WriteMethod("load",m.ym)

	.AddObject("olecontrol1","olecontrol","shell.explorer.2")
	With .olecontrol1
		.Left=  10
		.Top=.Parent.command1.Top+30
		.Width=740
		.Height=480
	Endwith
	TEXT to m.ym noshow
  this.silent=.t.
  this.navigate("www.msn.com")
	ENDTEXT
	.olecontrol1.WriteMethod("init",m.ym)
	.WriteMethod("keypress","LPARAMETERS nKeyCode, nShiftAltCtrl"+Chr(13)+"thisform.release")
	.SaveAs("yform")
Endwith

Keyboard '{CTRL+W}'   &&close window
DoEvent
oform=Null
Release oform


Do Form yform  Name yb  Noshow  &&oop
TEXT to m.myvar textmerge noshow
 <<eval(yb.uu)>>   <<type(yb.uu)>>
 <<eval(yb.uu)+"...AZERTY">>

 <<trans(eval(yb.vv),"9.99")>>  <<vartype(yb.vv)>>
 <<trans(eval(yb.vv)+10)>>
ENDTEXT
Messagebox(m.myvar,0+32+4096)
yb.Release
Modi Form yform  &&see controls created with their PEM---run also the form

*issue dele file addbs(sys(2023))+"yform*.*"  &&clean



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


*3*
*scan each control on a form dynamically at runtime, recursively drilling down into container controls.listings
* all controls/class/base class
*can be usefull at design time but run the form and release it.
*form must be a valid and runable one.
*Note this can be done at design time with list objects (see the combo relative item:objects list).

local m.x
m.x=Getfile('scx')
If Empty(m.x) Or !Lower(Justext(m.x))=="scx"
    Return .F.
Endi
Messagebox("Executing form:"+m.x,0+32+4096,'',1200)

Do Form (x)

=ctrlnonrec(_Screen.ActiveForm)       && aselobj(gabase,1))
Inke(1)
_Screen.ActiveForm.Release

Create Cursor ycurs (xbaseclass c(20),xclass c(20),obj c(150))
Appe From txt.txt Sdf
Sele ycurs
Brow Nowait

Browse Name ybrow  Title Trans(Reccount())+" controls on "+m.x  Nowait &&window as oop object

With ybrow
	.DeleteMark=.F.
	.GridLines=0
	.RecordMark=.F.
	.column3.FontBold=.T.
	.Columns(1).DynamicBackColor="RGB(155,128,100)"
	.Columns(2).DynamicBackColor="RGB(255,128,200)"
	.Columns(3).DynamicBackColor="RGB(55,128,80)"
	Locate
Endwith
Erase txt.txt


* ctrlnonrec
*FROM http://www.tek-tips.com/viewthread.cfm?qid=1732707
*Author: Vilhelm-Ion Praisach (thanks Vilhem)
*scan each control on a form, recursively drilling down into container controls.listings all controls/class/base class

Function ctrlnonrec
	Lparameters loStart
	Local laStack[200,2],lnLevel,loObj,lni,lcName,llCont,lnObj
	If Vartype(m.loStart)!="O" Or Isnull(m.loStart) && test for not an object
		Strtofile(Transform(m.loStart)+" is not an object","txt.txt")
		Messagebox(Trans(m.loStart)+"---error",16)
		Return
	Endif
	llCont=.F.
	If Pemstatus(m.loStart,"objects",5) Or Upper(m.loStart.BaseClass)="COLLECTION"
		lnObj=Iif(!Pemstatus(m.loStart,"baseclass",5),m.loStart.Objects.Count,; && _vfp
		Iif(Upper(m.loStart.BaseClass)="COLLECTION",m.loStart.Count,; && collection
		Iif(Upper(m.loStart.BaseClass)="GRID",m.loStart.ColumnCount,; && grid
		m.loStart.Objects.Count)))
		If m.lnObj>0
			llCont=.T.
			Strtofile(Cast("Baseclass" As c(20))+Cast("Class" As c(30))+"Name"+Chr(13)+Chr(10),"txt.txt") && txt file header
		Endif
	Endif
	If m.llCont
		lnLevel=1
		laStack[m.lnLevel,1]=1
		laStack[m.lnLevel,2]=m.loStart
		Do While m.lnLevel>0
			lnObj=Iif(!Pemstatus(m.laStack[m.lnLevel,2],"baseclass",5),m.laStack[m.lnLevel,2].Objects.Count,; && _vfp
			Iif(Upper(m.laStack[m.lnLevel,2].BaseClass)="COLLECTION",m.laStack[m.lnLevel,2].Count,; && collection
			Iif(Upper(m.laStack[m.lnLevel,2].BaseClass)="GRID",m.laStack[m.lnLevel,2].ColumnCount,; && grid
			m.laStack[m.lnLevel,2].Objects.Count)))
			If m.laStack[m.lnLevel,1]<=m.lnObj
				If m.laStack[m.lnLevel,2]=_vfp
					loObj=m.laStack[m.lnLevel,2].Objects(m.laStack[m.lnLevel,1])
				Else
					If Upper(m.laStack[m.lnLevel,2].BaseClass)="COLLECTION"
						loObj=m.laStack[m.lnLevel,2]
						loObj=m.loObj.Item(m.laStack[m.lnLevel,1])
					Else
						loObj=m.laStack[m.lnLevel,2].Objects(m.laStack[m.lnLevel,1])
					Endif
				Endif
				m.llCont=Vartype(loObj)="O" And !Isnull(loObj) && check for nonobjects in collections
				If m.llCont && check for infinite loop in collections
					For lni=1 To m.lnLevel-1
						If m.laStack[m.lnLevel,2]=m.laStack[m.lni,2] && regular objects
							m.llCont=.F.
							Exit
						Endif
						If Pemstatus(m.laStack[m.lnLevel,2],"hwnd",5) And Pemstatus(m.laStack[m.lni,2],"hwnd",5) && forms and _vfp
							If m.laStack[m.lnLevel,2].HWnd=m.laStack[m.lni,2].HWnd
								m.llCont=.F.
								Exit
							Endif
						Endif
					Next
				Endif
				If m.llCont
					lcName=""
					For lni=1 To m.lnLevel
						lcName=m.lcName+m.laStack[m.lni,2].Name+"."
					Next
					lcName=m.lcName+m.loObj.Name
					If Pemstatus(m.loObj,"baseclass",5) && precautions for _vfp
						Strtofile(Cast(m.loObj.BaseClass As c(20))+Cast(m.loObj.Class As c(30))+m.lcName+Chr(13)+Chr(10),"txt.txt",1)
					Else
						Strtofile(Cast("_vfp" As c(20))+Cast("_vfp" As c(30))+m.lcName+Chr(13)+Chr(10),"txt.txt",1)
					Endif
					llCont=.F.
					If Pemstatus(m.loObj,"objects",5) Or Iif(!Pemstatus(m.loObj,"baseclass",5),.F.,Upper(m.loObj.BaseClass)="COLLECTION")
						lnObj=Iif(!Pemstatus(m.loObj,"baseclass",5),m.loObj.Objects.Count,; && _vfp
						Iif(Upper(m.loObj.BaseClass)="COLLECTION",m.loObj.Count,; && collection
						Iif(Upper(m.loObj.BaseClass)="GRID",m.loObj.ColumnCount,; && grid
						m.loObj.Objects.Count)))
						If m.lnObj>0
							llCont=.T.
						Endif
					Endif
					If m.llCont
						lnLevel=m.lnLevel+1
						laStack[m.lnLevel,1]=1
						laStack[m.lnLevel,2]=m.loObj
					Else
						laStack[m.lnLevel,1]=m.laStack[m.lnLevel,1]+1
					Endif
				Else
					laStack[m.lnLevel,1]=m.laStack[m.lnLevel,1]+1
				Endif
			Else
				lnLevel=m.lnLevel-1
				If m.lnLevel>0
					laStack[m.lnLevel,1]=m.laStack[m.lnLevel,1]+1
				Endif
			Endif
		Enddo
	Else
		Strtofile(m.loStart.Name+" has no collection","txt.txt")
	Endif
Endfunc


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


*4*
*create a complet project programmatly (proj+main.prg+form+config.fpw ,compile exe)

Local m.yrep,m.lcdest
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
m.lcdest=m.yrep+"yproject"+Sys(2015)+"\"
Mkdir (m.lcdest)
Cd (lcdest)
Md [forms]
Md [others]
Md [prgs]

Crea Proj myapp.pjx Nowait Save

Local lcFile
TEXT To lcFile Noshow
On Shutdown Quit
Do Form frmMain
Read Events
ENDTEXT
Strtofile(lcFile,"prgs\main.prg")
_vfp.ActiveProject.Files.Add("prgs\main.prg")

TEXT To lcFile Noshow
SCREEN=OFF
RESOURCE=OFF
SAFE=OFF
ALLOWEXTERNAL=ON
ENDTEXT
Strtofile(lcFile,"others\config.fpw")
_vfp.ActiveProject.Files.Add("others\config.fpw")

Local Array laForm[1]
Local loForm
Create Form [forms\frmMain.scx] As Form Nowait
Aselobj(laForm,1)
loForm = laForm[1]
With loForm
    .ShowWindow = 2 && as top level form
	.AutoCenter=.T.
	.BackColor=Rgb(212,208,200)
	.Icon=Home(1)+"graphics\icons\misc\face05.ico"
	.Caption="Main Form"
	.AddObject("image1","image")
	With .image1
		.Anchor=15
		.Width=200
		.Height=200
		.Left=(.Parent.Width-.Width)/2
		.Top=50
		.BackStyle=0
		.Stretch=2
		.Picture=Home(1)+"GRAPHICS\BITMAPS\ASSORTED\BEANY.BMP"
	Endwith
	.WriteMethod("Unload","Clear Events")
Endwith

Declare SHORT GetSystemDefaultLangID In kernel32
&&this is localized VFP versions (depends on language set on PC)
If GetSystemDefaultLangID()=1036
	Activate Window "générateur de formulaires"
Else
	Activate Window "Form Designer"
Endi
Keyboard '{CTRL+S}'  &&save
Keyboard '{CTRL+F4}' &&close
DoEvents
With _vfp.ActiveProject
	.Files.Add("forms\frmMain.scx")
	.Build("myapp.exe",3,.T.,.T.,.T.)
Endwith
_Screen.WindowState=1
Do myapp.Exe



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


*5*
*all vfp objects are simply tables and vfp works with these as well to achieve all its projects.

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
    Top = 0
	Left = 0
	Height = 543
	Width = 930
	Caption = ""
	ShowWindow=2
	AutoCenter=.T.
	BackColor = Rgb(212,208,200)
	Name = "Form1"

	Add Object grid1 As Grid With ;
		Anchor = 15, ;
		Height = 274, ;
		Left = 9, ;
		Top = 2, ;
		Width = 888, ;
		Name = "Grid1"

	Add Object edit1 As EditBox With ;
		Anchor = 15, ;
		Height = 191, ;
		Left = 10, ;
		ReadOnly = .T., ;
		Top = 347, ;
		Width = 887, ;
		Name = "Edit1"

	Add Object LABEL1 As Label With ;
		AutoSize = .T.,;
		FontBold = .T.,;
		FontSize = 20,;
		Anchor = 768,;
		BackStyle = 0,;
		Caption = "?",;
		Height = 35,;
		Left = 905,;
		MousePointer = 15,;
		Top = 0,;
		Width = 19,;
		ForeColor = Rgb(255,0,0),;
		Name = "Label1"

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

	Procedure Init
		Close Data All
		Local lcfile
		lcfile=Getfile('scx')
		If Empty(m.lcfile) Or ! Lower(Justext(m.lcfile))=="scx"
			Return.F.
		Endi
		Thisform.Caption="form:"+m.lcfile+" - Click on any column/text1 to read  values"
		Use (m.lcfile) Alias oo
		Create Cursor ycurs (objname c(30),Parent c(20),BaseClass c(20),Class c(30),  properties m, methods m,ole m)
		Sele oo
		Scan
			xbaseclass=BaseClass
			xclass=Class
			xobjname=objname
			xparent=Parent
			xproperties=properties
			xmethods=methods
			xole=ole
			Sele ycurs
			Appe Blan
			Repl BaseClass With xbaseclass,Class With xclass
			Repl objname With xobjname,Parent With xparent
			Repl properties With xproperties,methods With xmethods
			Repl ole With xole
			Sele (m.lcfile)
		Endscan
		Use In Select(m.lcfile)

		Sele ycurs
		With Thisform.grid1
			.RecordSource="ycurs"
			.DeleteMark=.F.
			.GridLines=0
			.SetAll("fontbold",.T.,"header")
			.SetAll("fontsize",11,"header")
			.column1.Width=150
			.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(215,225,255) , RGB(255,235,220))", "Column")
			For i=1 To .ColumnCount
				Bindevent(.Columns(i).text1,"mouseDown",Thisform,"my")
			Endfor

			Locate
		Endwith
	Endproc

	Procedure LABEL1.Click
		Local m.myvar
		TEXT to m.myvar noshow
A form is simply a visual foxpro table embedding all objects
an their PEM into its fields.
a form can be used as a table with [use getfile('scx')]
Browsing this form makes access to all its PEM reading and writing
(modifying).
click on each field to see in the editbox below what it contains.
		ENDTEXT
		Messagebox(m.myvar,0+32+4096)
	Endproc


	Procedure Destroy
		Close Data All
		Clea Events
	Endproc


Enddefine
*
*-- EndDefine: asup


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


*6*
*Dynamically the vfp9 class browser (_browser)  can edit a form,prg,class in its interface and browse the hierarchy,code,....
*it shows hierarchy objects, properties,mehods,events of each object.
*Note:it works within VFP 6.0 and higher versions

do (_browser) with getfile('scx'),wontop()
do (_browser) with getfile('prg'),wontop()
do (_browser) with getfile('vcx'),wontop()

*wontop() want to say as the top level window


Visual Foxpro and design time working
 
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro 
Please come back with any bug.correct code is usefull to all readers.

To be informed of the latest articles, subscribe:
Comment on this post
M
Nice blog an informative one
Reply
L
I really like this blog
Reply