Visual Foxpro and design time working
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
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
*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.