Working on VFP objects dynamically - part2

Published on by Yousfi Benameur


this post continues the previous part1.
http://yousfi.over-blog.com/2016/11/drah-object-on-form-change-properties-dynamically.html
it consists on some vfp codes applying to controls to browse some effects,behaviors,miscellianous...
i will update  along the subject more codes when i see the need to publish them for the vfp programming followers.
if the section might be too long (it becomes also slow to load),then i create another part and so ,"inchallah".

[post 223]


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

*1* define window vfp command in top level form

*!*	original [define window] commmand  creates as child windows of vfp screen.
*!*	this definition  can be translated to any top level form with some defined terms in vfp command line as "in WIndow name"
*!*	the forms (showWindow=0,1,2) have always a window Name, making hosting a defined window possible.
*!*	see the line command  "define window" in code.
*!*	with or without vfp screen visible or no, this embedding is possible as you can try below.
*!* this code builds a top level form, embed a defined window yb,builds another window (modify command prg) in this window
*!* and all are in top level form.the prg is viewed only (not edited).
*!* the vfp screen is made invisible when run the form,its visible when destroyed.

*!* note form 0 (in screen)-1 (in top level form) - 2 (top level form).
*!* define window is some vfp old but it can be replaced easily with forms(0,1).

publi oform
oform=newObject("asup")
oform.show
read events
retu
*
DEFINE CLASS asup AS form
	Top = 0
	Left = 0
	Height = 502
	Width = 786
	ShowWindow = 2
	Caption = "Define Window on top level form [demo]"
	BackColor = RGB(212,210,208)
	Name = "Form1"

	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 2, ;
		Left = 2, ;
		Height = 37, ;
		Width = 157, ;
		FontBold = .T., ;
		FontSize = 11, ;
		Caption = "View any prg file", ;
		MousePointer = 15, ;
		BackColor = RGB(128,255,0), ;
		Name = "Command1"

	PROCEDURE ybuild
		local m.lcfilename
		m.lcfilename = getfile('prg')
		_screen.visible=.f.
		if ! vartype(yb)="O"
		DEFINE WINDOW yb AT 1, 15 SIZE 15, 25 IN WINDOW  (thisform.name)  TITLE "Viewing prg:"+lcfilename  CLOSE FLOAT GROW ZOOM name xx
		endi
		MODIFY COMMAND (m.lcfilename) noedit NOWAIT in WINDOW yb
		with xx
		.left=20
		.top=40
		.width=640
		.height=480
		endwith
		activate window yb
	ENDPROC

	PROCEDURE Destroy
		_screen.visible=.t.
		clea events
	ENDPROC

	PROCEDURE Init
		thisform.ybuild()
	ENDPROC

	PROCEDURE command1.Click
		thisform.ybuild()
	ENDPROC

ENDDEFINE
*
*-- EndDefine: asup


Working on VFP objects dynamically - part2

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

*2*  working with AmouseObj() vfp function

*!*	this code show a demo of AmouseOBj() vfp function.
*!*	the code recurse on all form control and containers and bindevent the mousemove event
*!*	in a method "my".
*!*	AmouseObj() gathers the control name and its hierarchy until the form.name and show the current position of the mouse (nxCoord,nyCoord) in a vfp window.
*!*	i used sys(1272,objname) instead of the 3th array element because its better precision.
*!*	the aMouseOBj() fill an array with 4 elements (control name,paren control name,nxCoord,nyCoord)
*!*	if the mouse is over this object (it returns 0 if no object).
*!*	This is a demo for this usefull natve function.
*!* can see also for information in help sys(1270),sys(1271),sys(1272),AselObj()

publi yform
yform=newObject("yamouseObj")
yform.show
read events
retu
*
DEFINE CLASS yamouseObj AS form
BorderStyle = 0
Height = 388
Width = 772
ShowWindow = 2
AutoCenter = .T.
Caption = "AmouseObj () function illustration"
MaxButton = .F.
BackColor = RGB(212,210,208)
oo = .F.

ADD OBJECT label1 AS label WITH ;
Caption = "Label1", ;
Height = 37, ;
Left = 36, ;
Top = 36, ;
Width = 109, ;
BackColor = RGB(255,255,128), ;
caption="Hello world!",;
Name = "Label1"

ADD OBJECT text1 AS textbox WITH ;
Height = 49, ;
Left = 180, ;
Top = 24, ;
Width = 109, ;
BackColor = RGB(255,210,233), ;
value="Hello world!",;
Name = "Text1"

ADD OBJECT edit1 AS editbox WITH ;
Height = 109, ;
Left = 36, ;
Top = 168, ;
Width = 96, ;
BackColor = RGB(255,255,206), ;
value="Hello world!",;
Name = "Edit1"

ADD OBJECT command1 AS commandbutton WITH ;
Top = 36, ;
Left = 300, ;
Height = 37, ;
Width = 97, ;
Caption = "Command1", ;
BackColor = RGB(128,255,0), ;
caption="Hello world!",;
Name = "Command1"

ADD OBJECT combo1 AS combobox WITH ;
Height = 37, ;
Left = 24, ;
Top = 84, ;
Width = 133, ;
Name = "Combo1"

ADD OBJECT image1 AS image WITH ;
Picture = home(1)+"gallery\media\metal links.bmp", ;
Stretch = 2, ;
Height = 100, ;
Left = 420, ;
Top = 0, ;
Width = 100, ;
Name = "Image1"

ADD OBJECT grid1 AS grid WITH ;
Height = 144, ;
Left = 168, ;
Top = 108, ;
Width = 516, ;
Name = "Grid1"

ADD OBJECT container1 AS ycont  WITH ;
Top = 264, ;
Left = 204, ;
Width = 408, ;
Height = 120, ;
BackColor = RGB(128,255,255), ;
Name = "Container1"

ADD OBJECT pageframe1 AS pageframe WITH ;
ErasePage = .T., ;
PageCount = 4, ;
Top = 300, ;
Left = 0, ;
Width = 192, ;
Height = 77, ;
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"

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

*-- Occurs when the user moves the mouse over an object.
Local cr,Y,z
cr=Chr(13)
Try
lnCnt = Amouseobj(laObj, 1)
If lnCnt > 0
	Y=laObj[1]
	z=Sys(1272,m.y)
	Wait Window ("Object hierarchy="+m.z +cr+"mouse X= "+Trans(laObj[3])+cr+"mouse Y= "+Trans(laObj[4])) Nowait
Endif
Catch To loExc
Throw
Endtry
Retu
ENDPROC

PROCEDURE recurse
	LPARAMETERS toObject
	LOCAL lcBase
	lcBase = UPPER(toObject.BaseClass)
	DO CASE
	CASE INLIST(lcBase, [FORM], [CONTAINER], [PAGE], [COLUMN], [COMMANDGROUP], [OPTIONGROUP])
		LOCAL loControl
		FOR EACH loControl IN toObject.Objects
			IF (loControl != this) AND PEMSTATUS(loControl, [MouseMove], 5)
				BINDEVENT(loControl, [MouseMove], this, [My])
				loControl.mousepointer=15
			ENDIF
			this.recurse(loControl)
		ENDFOR
	CASE lcBase == [PAGEFRAME]
		LOCAL loPage
		FOR EACH loPage IN toObject.Pages
		  loPage.mousepointer=15
			this.recurse(loPage)
		ENDFOR
	CASE lcBase == [GRID]
		LOCAL loColumn
		FOR EACH loColumn IN toObject.Columns
		loColumn.mousepointer=15
			this.recurse(loColumn)
		ENDFOR
  endcase
ENDPROC

PROCEDURE Destroy
clea events
ENDPROC

PROCEDURE Init
with thisform
.showTips=.t.
.recurse(thisform)
endwith
ENDPROC

PROCEDURE grid1.Init
sele  address,city from home(1)+"samples\data\customer" into cursor ycurs
with this
.recordsource="ycurs"
.themes=.f.
.deletemark=.f.
.gridlines=0
.setall("backcolor",0,"header")
.setall("Forecolor",255,"header")
.setall("fontbold",.t.,"header")
.setall("fontsize",12,"header")		
.column1.width=200
.column2.width=320
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(215,205,225)  , RGB(0,255,0))", "Column")
.refresh
endwith
ENDPROC

ADD Object yhelp AS label with ;
FontBold = .T.,;
FontSize = 24,;
BackStyle = 0,;
Caption = "?",;	
Height = 37,;
Left = 732,;
MousePointer = 15,;
Top = 336,;
Width = 25,;
ForeColor = RGB(255,0,0),;
Name = "yhelp"

PROCEDURE yhelp.Click
local m.myvar
text to m.myvar pretext 7 noshow
this code show a demo of AmouseOBj() vfp function.
the code recurse on all form control and containers and bindevent the mousemove event
in a method "my".
AmouseObj() gathers the control name and its hierarchy until the form.name and show the
current position of the mouse (nxCoord,nyCoord) in a vfp window.
i used sys(1272,objname) instead of the 3th array element because its better precision.
the aMouseOBj() fill an array with 4 elements (control name,paren control name,nxCoord,nyCoord)
if the mouse is over this object (it returns 0 if no object).
This is a demo for this usefull natve function.
endtext
messagebox(m.myvar,0+32+1096,'Summary help')
ENDPROC	


ENDDEFINE
*
*-- EndDefine: yamouseObj

*
DEFINE CLASS ycont AS container
Top = 264
Left = 204
Width = 408
Height = 120
BackColor = RGB(128,255,255)
Name = "asup"

ADD OBJECT label1 AS label WITH ;
Caption = "Label1", ;
Height = 25, ;
Left = 12, ;
Top = 7, ;
Width = 85, ;
caption="Hello world!",;
Name = "Label1"

ADD OBJECT command1 AS commandbutton WITH ;
Top = 36, ;
Left = 24, ;
Height = 25, ;
Width = 133, ;
Caption = "Hello World!", ;
Name = "Command1"

ADD OBJECT container2 AS ycont1 WITH ;
Top = 12, ;
Left = 204, ;
Width = 181, ;
Height = 79, ;
BackColor = RGB(255,128,64), ;
Name = "Container2"


ENDDEFINE
*
*-- EndDefine: ycont

DEFINE CLASS ycont1 AS container
Top = 12
Left = 204
Width = 181
Height = 110
BackColor = RGB(255,128,64)
Name = "asup1"

ADD OBJECT command1 AS commandbutton WITH ;
Top = 4, ;
Left = 21, ;
Height = 25, ;
Width = 133, ;
Caption = "Hello World!", ;
Name = "Command1"

ADD OBJECT text1 AS textbox WITH ;
Height = 36, ;
Left = 24, ;
Top = 36, ;
Width = 121, ;
value="Hello world!",;
Name = "Text1"

ENDDEFINE
*-- EndDefine: ycont1


MouseMove on form controls to see the returned informations.

MouseMove on form controls to see the returned informations.

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

*3* created on 28 of february 2017
*!* this is a simple search form  on any table or cursor based on native vfp class
*!* the button "search for" is a part of the class: home(1)"wizards\wizbtns.vcx
*!* can also edit this class with "modi class.." and see codes...other buttons..
*!* here is as standalone the button "search for..in table" available for any table (dbf).
*!*its based on alias() :Returns the table alias of the current or specified work area.



clea all
close data all
Publi oform
oform=Newobject("ySearch")
oform.Show
Read Events
Retu
*
Define Class ysearch As Form
	Height = 341
	Width = 615
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Form1"
	Name = "Form1"

	Add Object command1 As CommandButton With ;
		Top = 300, ;
		Left = 156, ;
		Height = 36, ;
		Width = 216, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Standalone Search form wizard", ;
		MousePointer = 15, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object grid1 As Grid With ;
		Anchor = 15, ;
		Height = 253, ;
		Left = 12, ;
		Top = 24, ;
		Width = 589, ;
		Name = "Grid1"

	Add Object label1 As Label With ;
                Anchor=768,;
		AutoSize = .T., ;
		FontBold = .T., ;
		BackStyle = 0, ;
		Caption = "to reset: click & issue [search+All ]", ;
		Height = 17, ;
		Left = 384, ;
		Top = 312, ;
		Width = 200, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Procedure Init
	Close Data All
	Local m.ytable
	m.ytable=Getfile('dbf')
	If Empty(m.ytable) Or !Lower(Justext(m.ytable))=="dbf"
		Return.F.
	Endi

	Local m.myvar
	TEXT to m.myvar textmerge noshow
		sele * from "<<m.ytable>>" into cursor ycurs
	ENDTEXT
	Execscript(m.myvar)

	Sele ycurs
	With Thisform.grid1
		.RecordSource="ycurs"
		.GridLines=0
		.DeleteMark=.F.
		.FontBold=.T.
		.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(0,180,70), RGB(212,210,208))", "Column")
		Locate
	Endwith
	Thisform.Caption="from table :"+Justfname(m.ytable)
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure command1.Click
	Set Classlib To Home(1)+"wizards\wizbtns.vcx"     AddI
	Local lVisChange,lStateChange,oSearchDlog
	If Empty(Alias())
		Return .F.
	Endif
* Check if SDI Window
	If Thisform.ShowWindow = 2
		If !_vfp.Visible
			_vfp.Visible = .T.
			lVisChange = .T.
		Endif
		If _Screen.WindowState = 1
			_Screen.WindowState = 0
			lStateChange = .T.
		Endif
	Endif
	Try
		oSearchDlog = Create("searchform")
		oSearchDlog.Show()
	Catch
	Endtry
	Thisform.Refresh()

	If m.lVisChange
		_vfp.Visible = .F.
	Endif
	If m.lStateChange
		_Screen.WindowState = 1
	Endif
	If Thisform.ShowWindow = 2
		Activate Window (Thisform.Name)
	Endif
	Release Classlib Home(1)+"wizards\wizbtns.vcx"
	Endproc

Enddefine
*
*-- EndDefine: ysearch



Working on VFP objects dynamically - part2
Working on VFP objects dynamically - part2

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


*4*Created on 26 of february 2017
*This is an  example using DOM syntaxe (as vfp OOP) to traverse document  styles (CSS-CSS3) for any web page.
*vfp can set web styles  programmatly from vfp.
*Important:run vfp9 as administrator  or uncheck ie protected mode in internet options/security tab settings before running code (to avoid some IE errors).

Local m.myvar
TEXT to m.myvar noshow
<div id="odiv">
<h2>This is a div  with an absolute position</h2>
<img src="http://img.over-blog-kiwi.com/100x100-ct/1/43/54/07/20150121/ob_249909_yben.JPG" width='150' height='150'>
<p id="yb1" >With absolute positioning, any element can be placed anywhere on a page. The div below is placed 300px from the left of the page and 350px from the top of the page.
All styles can be done with DOM syntax (even out of javascript ,from visual foxpro codings).
for more info:can search in  https://www.w3schools.com/   (very usefull).
</p>
</div>
<hr>
<div id='yb'></div>
ENDTEXT

Set Safe Off
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ytemp.html"
Strtofile(m.myvar,m.lcdest)

Declare Integer BringWindowToTop In user32 Integer
*Important: run vfp9 as administrator if ie protected mode setting checked (internet options/secutity TAB)
Local apie
apie=Newobject("internetexplorer.application")
With apie
	.Navigate(m.lcdest)
	.Width=Sysmetric(1)
	.Height=Sysmetric(2)
	.Top=0
	.Left=0
	BringWindowToTop(.HWnd)
	.Visible=.T.
	Inke(2)  &&transitionnings
	Local x,Y
	With .Document
		x=.getElementByID("odiv").innerhtml
		Y=.getElementByID("yb")
		With Y
			Y.innerhtml=x
			.Style.Border="thick solid maroon"
			.Style.BorderWidth = "10px 5px 10px 5px"
			.Style.padding="5px"
			.Style.position ="absolute"
			.Style.Left="300px"
			.Style.Width="350px"
			.Style.backgroundcolor="bisque"
			.Style.Color="maroon"
		Endwith
	Endwith
Endwith


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


*5* created on 16 of april 2017
*how to draw a rectangular region with the  left mouse and delimit this region with its coordinates?
*i used this ytechnic to capture rectangular regions in past (see previous posts relative to captures).its was absolutely my pure invention.

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
	Height = 382
	Width = 805
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Delimit a region with mouse "
	ydraw = .F.
	x0 = .F.
	y0 = .F.

	Add Object label1 As Label With ;
		autosize=.T. ,;
		FontSize = 14, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 37, ;
		Left = 36, ;
		Top = 332, ;
		Width = 445, ;
		ForeColor = Rgb(128,0,64), ;
		Name = "Label1"

	Add Object text1 As TextBox With ;
		Height = 37, ;
		Left = 36, ;
		Top = 24, ;
		Width = 181, ;
		Name = "Text1"

	Add Object edit1 As EditBox With ;
		FontBold = .T., ;
		FontSize = 10, ;
		Enabled = .F., ;
		Height = 230, ;
		Left = 420, ;
		ScrollBars = 0, ;
		SpecialEffect = 2, ;
		Top = 60, ;
		Width = 320, ;
		ForeColor = Rgb(255,0,0), ;
		DisabledForeColor = Rgb(255,0,0), ;
		Name = "Edit1"

	Add Object image1 As Image With ;
		Picture = Home(1)+"graphics\bitmaps\assorted\beany.bmp", ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 132, ;
		Left = 120, ;
		Top = 120, ;
		Width = 156, ;
		Name = "Image1"

	Procedure Destroy
	Clea Events
	Endproc

	Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	With Thisform
		.ydraw=.T.
		.x0=nXCoord
		.y0=nYCoord
		.PSet(Thisform.x0,Thisform.y0)
	Endwith
	Endproc

	Procedure MouseMove
	Lparameters nButton, nShift, nXCoord, nYCoord
	If nButton=1 And Thisform.ydraw=.T.
		With Thisform
			.Cls
			.FillColor=Rgb(215,128,107)
			.DrawMode=9
			.FillStyle=0
			.Box(Thisform.x0,Thisform.y0,nXCoord,nYCoord)
		Endwith
	Endi
	Endproc

	Procedure MouseUp
	Lparameters nButton, nShift, nXCoord, nYCoord
	If nButton=1 And Thisform.ydraw=.T.
		With Thisform
			.Cls
			.ydraw=.F.
			.label1.Caption="Rectangular Region delimited :x0="+Trans(Thisform.x0)+"  y0="+Trans(Thisform.y0)+"   x1="+Trans(nXCoord)+"  y1="+Trans(nYCoord)
		Endwith
	Endi
	Endproc

	Procedure edit1.Init
	TEXT to this.value pretext 7 noshow
		MouseDown on any point on the form and drag cursor to  draw a rectangle regionwith left mouse.
		the box draw is semi transparent with native graphics vfp functions
		and properties (as drawmode...)
		this method can delimit a region to capture for ex....
		the 4 corners coordinates are return at the form bottom.
		this effect is obtained by cobination of events mouseDown,mouseMove and mouseup

	ENDTEXT
	Endproc

Enddefine
*
*-- EndDefine: asup


Working on VFP objects dynamically - part2

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


*6*
*!*created on monday 23 of october 2017 for answering a vfp user.
*!*	this is a standard toolbar class using a container class.
*!*	In the container, can position objects as user wants (i used for demo 10 images but can be any control)
*!*	can code any action in the method "my" (recognizing the control clicked).
*!*	the container is large and the docking left or right can be not beautiful.
*!*the toolbar class can insert any vfp control but their coordinates(left,top...) are indicatives only (not applied effectively).can separate objects with separator control(put many if necessary between each 2 controls).with a container class inserted in toolbar class can do a correct positionning of ontrols.

*!*--Begin Code
_Screen.WindowState=1
Set Defa To Justpath(Sys(16,1))
Publi yform
yform = Newobject("yForm")
yform.Show

Local ytoolbar
ytoolbar = Newobject("asup")
ytoolbar.Show()
Read Events
Return

Define Class yform As Form
	ShowWindow = 2
	Width=800
	Height=600
	AutoCenter=.T.
	Caption="you can drag the toolbar and dock it (left),top,(right),bottom or free"
	Name="yform"

	Add Object ylab As Label With;
		anchor=256,;
		left=10,;
		top=10,;
		alignment=0,;
		height=20,;
		fontsize=12,;
		forecolor=255,;
		fontbold=.T.,;
		autosize=.T.,;
		caption="*",;
		name="ylab"

	Procedure Destroy
		Clea Events
	Endproc
Enddefine
*enddefine yform
***************************
Define Class asup As Toolbar
	Caption = "Toolbar1"
	Height = 82
	Left = 0
	Top = 0
	Width = 820
	ShowWindow = 1
	BackColor=Rgb(212,208,210)
	Name = "asup"

	Add Object container1 As ycont With ;
		Top = 3, ;
		Left = 5, ;
		Width = 800, ;
		Height = 76, ;
		borderwidth=0,;
		backstyle=0,;
		Name = "Container1"

	Procedure Init
		This.Dock(0)    &&0,1,2 docking positions   (3,4 not beautiful)
Enddefine
*-- EndDefine: asup

Define Class ycont  As Container
	Top = 11
	Left = 12
	Width = 780
	Height = 76
	Name = "ycont"

	Add Object image1 As Image With ;
		Height = 60, ;
		Left = 4, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image1"

	Add Object image2 As Image With ;
		Height = 60, ;
		Left = 66, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image2"

	Add Object image3 As Image With ;
		Height = 60, ;
		Left = 127, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image3"

	Add Object image4 As Image With ;
		Height = 60, ;
		Left = 189, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image4"

	Add Object image5 As Image With ;
		Height = 60, ;
		Left = 251, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image5"

	Add Object image6 As Image With ;
		Height = 60, ;
		Left = 312, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image6"

	Add Object image7 As Image With ;
		Height = 60, ;
		Left = 373, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image7"

	Add Object image8 As Image With ;
		Height = 60, ;
		Left = 435, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image8"

	Add Object image9 As Image With ;
		Height = 60, ;
		Left = 496, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image9"

	Add Object image10 As Image With ;
		Height = 60, ;
		Left = 496, ;
		Top = 5, ;
		Width = 56, ;
		Name = "Image10"


	Procedure Init
		Local gnbre,m.delta
		m.delta=10  && this set 10px between objects in container
		gnbre=Adir(gabase,Home(1)+"graphics\bitmaps\tlbr_w95\*.bmp")

		With This
			.SetAll("stretch",2,"image")
			.SetAll("width",64,'image')
			.SetAll("height",64,"image")

			For i=1 To .ControlCount
				If Lower(.Controls(i).Class)=="image"
					.Controls(i).Picture=Home(1)+"graphics\bitmaps\tlbr_w95\"+gabase(i,1)
				Endi
				If i=1
					.Controls(i).Left=5
				Else
					.Controls(i).Left=.Controls(i-1).Left+.Controls(i-1).Width+m.delta
				Endi
				.Controls(i).Top=5
				Bindevent(.Controls(i),"mouseDown",This,"my")
				Bindevent(.Controls(i),"mouseEnter",This,"my1")
				Bindevent(.Controls(i),"mouseLeave",This,"my2")
			Endfor

			.SetAll("mousepointer",15,"image")
		Endwith

	Endproc

	Procedure my()
		Lparameters nButton, nShift, nXCoord, nYCoord
		*--- aevent create an array laEvents
		Aevents( myArray, 0)
		*--- reference the calling object
		loObject = myArray[1]
		Messagebox("Control:  "+loObject.Name+"  clicked."+Chr(13)+"you can add some code to do some custom actions....",0+32)
	Endproc

	Procedure my1()
		Lparameters nButton, nShift, nXCoord, nYCoord
		*--- aevent create an array laEvents
		Aevents( myArray, 0)
		*--- reference the calling object
		loObject = myArray[1]
		With loObject
			.Left=.Left-2
			.Top=.Top-2
		Endwith
		_Screen.ActiveForm.ylab.Caption="actual toolbar control: "+loObject.Name
	Endproc

	Procedure my2()
		Lparameters nButton, nShift, nXCoord, nYCoord
		*--- aevent create an array laEvents
		Aevents( myArray, 0)
		*--- reference the calling object
		loObject = myArray[1]
		With loObject
			.Left=.Left+2
			.Top=.Top+2
		Endwith
		_Screen.ActiveForm.ylab.Caption=""

Enddefine
*
*-- EndDefine: ycont


Working on VFP objects dynamically - part2

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


*7* created on saturday 11 of november 2017
*7 small classes to make some effects on vfp objects az zoom (+-) in editbox,zoom on controls, rotate shapes and labels...with mouse events.

Publi yform
yform=Newobject("yeffects")
yform.Show
Read Events
Retu
*
Define Class yeffects As Form
	Top = 0
	Left = 0
	Height = 490
	Width = 1350
	Caption = "Some special mouse custom effects on vfp objects-MouseEnter/mousdeLeave"
	width0 = .F.
	height0 = .F.
	left0 = .F.
	top0 = .F.
	fs0 = .F.
	curv0 = .F.
	Name = "Form1"

	Add Object edit1 As asup1 With ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Height = 385, ;
		Left = 48, ;
		Margin = 10, ;
		ScrollBars = 0, ;
		Top = 50, ;
		Width = 541, ;
		DisabledBackColor = (Thisform.BackColor), ;
		Name = "Edit1"

	Add Object command1 As asup7 With ;
		Top = 24, ;
		Left = 636, ;
		Height = 49, ;
		Width = 109, ;
		Anchor = 768, ;
		Caption = "Command1", ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object image1 As asup2 With ;
		Anchor = 768, ;
		Picture = "c:\users\user\pictures\taghit01.jpg", ;
		Stretch = 2, ;
		Height = 145, ;
		Left = 684, ;
		Top = 144, ;
		Width = 192, ;
		Name = "Image1"

	Add Object text1 As asup6 With ;
		Value = "Any text here", ;
		Height = 48, ;
		Left = 780, ;
		Top = 24, ;
		Width = 133, ;
		Name = "Text1"

	Add Object label1 As asup4 With ;
		AutoSize = .T., ;
		FontBold = .F., ;
		FontSize = 12, ;
		WordWrap = .T., ;
		BackStyle = 0, ;
		Caption = "This is a label demo for a special effect", ;
		Height = 38, ;
		Left = 974, ;
		Top = 19, ;
		Width = 141, ;
		ForeColor = Rgb(0,0,255), ;
		Name = "Label1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontSize = 11, ;
		BackStyle = 0, ;
		Caption = "Mousewheel (up,down),MouseEnter or MouseLeave the editbox to see zoom effect.", ;
		Height = 19, ;
		Left = 61, ;
		Top = 12, ;
		Width = 534, ;
		Name = "Label2"

	Add Object shape1 As asup3 With ;
		Top = 250, ;
		Left = 1008, ;
		Height = 100, ;
		Width = 100, ;
		BackStyle = 1, ;
		Curvature = 99, ;
		SpecialEffect = 0, ;
		BackColor = Rgb(0,255,0), ;
		Name = "Shape1"

	Add Object shp7 As asup5 With ;
		Top = 26, ;
		Left = 1230, ;
		Height = 84, ;
		Width = 108, ;
		BorderWidth = 3, ;
		FillStyle = 0, ;
		SpecialEffect = 1, ;
		BackColor = Rgb(255,0,0), ;
		FillColor = Rgb(255,0,0), ;
		BorderColor = Rgb(255,255,255), ;
		ZOrderSet = 49, ;
		PolyPoints = "THIS.aPoly", ;
		Name = "shp7"

	Procedure Load
		Declare Integer Sleep In kernel32 Integer
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure edit1.Init
		TEXT to this.value pretext 7 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
		pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
		lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
		sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
		sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
		velit vel ex aliquam, eget convallis ante mollis.
		ENDTEXT
	Endproc

Enddefine
*
*-- EndDefine: yEffects


Define Class asup1 As EditBox
	BackStyle = 0
	BorderStyle = 0
	Height = 385
	Left = 48
	Margin = 10
	ScrollBars = 0
	Top = 50
	Width = 541
	fs0=9
	Name = "Edit1"

	Procedure MouseWheel
		Lparameters nDirection, nShift, nXCoord, nYCoord
		*mouseWheel change fontsize?
		Try
			This.FontSize = This.FontSize + Iif(m.nDirection=120,1,-1)
		Catch
		Endtry
	Endproc

	Procedure Init
		This.fs0=This.FontSize
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize + 6
		Catch
		Endtry
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize =This.fs0
			This.Refresh
		Catch
		Endtry
	Endproc

Enddefine
*
*-- EndDefine: asup1

Define Class asup2 As Image
	Anchor = 768
	Picture = ""
	Stretch = 2
	Height = 145
	Left = 684
	Top = 144
	Width = 192
	Name = "Image1"
	width0=0
	height0=0
	left0=0
	top0=0

	Procedure Init
		This.width0=Thisform.image1.Width
		This.height0=This.Height
		This.left0=This.Left
		This.top0=This.Top
		This.yrequest("http://www.zagygroup.com/web-images/cheap-hotel-dubai-ZAGY-Group-Internet-Marketing.png",This)


	Endproc
	Procedure yrequest
		Lparameters xurl,xobj
		xurl=Allt(xurl)

		Try
			Local loRequest
			m.loRequest = Createobject('MsXml2.XmlHttp')
			m.loRequest.Open("GET",xurl,.F.)
			m.loRequest.Send()
			Local m.oo
			xobj.PictureVal= m.loRequest.ResponseBody
			m.loRequest=Null
		Catch
		Endtry
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord

		Try
			With This

				i=1
				Do While  i<=40
					.Left=.Left+1
					.Top=.Top+1
					.Width=.Width-2
					.Height=.Height-2
					Sleep(5)
					i=i+1
				Enddo

				Sleep(100)
				.Left=Thisform.left0
				.Top=Thisform.top0
				.Width=Thisform.width0
				.Height=Thisform.height0
				.BorderStyle=0
			Endwith

		Catch
		Endtry
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BorderStyle=1
			i=1
			Do While  i<=40
				.Left=.Left-1
				.Top=.Top-1
				.Width=.Width+2
				.Height=.Height+2
				Sleep(5)
				i=i+1
			Enddo
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: asup2

Define Class asup3 As Shape
	Top = 250
	Left = 1008
	Height = 100
	Width = 100
	BackStyle = 1
	Curvature = 99
	SpecialEffect = 0
	BackColor = Rgb(0,255,0)
	curv0=This.Curvature
	Name = "Shape1"

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackColor=255
			i=1
			Do While i<=40
				.Left=.Left-1
				.Top=.Top-1
				.Width=.Width+2
				.Height=.Height+2
				Sleep(5)
				i=i+1
			Enddo
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.BackColor=Rgb(0,255,0)
			i=1
			Do While i<=40
				.Left=.Left+1
				.Top=.Top+1
				.Width=.Width-2
				.Height=.Height-2

				Sleep(5)
				i=i+1
			Enddo
		Endwith
	Endproc
Enddefine
*
*-- EndDefine: asup3

Define Class asup4 As Label
	AutoSize = .T.
	FontBold = .F.
	FontSize = 12
	WordWrap = .T.
	BackStyle = 0
	Caption = "This is a label demo for a special effect"
	Height = 38
	Left = 974
	Top = 19
	Width = 141
	ForeColor = Rgb(0,0,255)
	Name = "Label1"

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize - 5
		Catch
		Endtry
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize + 5
		Catch
		Endtry

		With This
			For i=0 To 350 Step 10
				.Rotation=i
				Sleep(10)
			Endfor
			.Rotation=0
		Endwith
	Endproc
Enddefine
*
*-- EndDefine: asup4

Define Class asup5 As Shape
	Top = 26
	Left = 1230
	Height = 84
	Width = 108
	BorderWidth = 3
	FillStyle = 0
	SpecialEffect = 1
	BackColor = Rgb(255,0,0)
	FillColor = Rgb(255,0,0)
	BorderColor = Rgb(255,255,255)
	ZOrderSet = 49
	Polypoints = "THIS.aPoly"
	curv0=99
	Name = "shp7"

	Procedure Init
		This.AddProperty("aPoly[1,1]")
		Dimension This.aPoly[8,2]

		This.aPoly[1,1]= 5
		This.aPoly[1,2]= 35

		This.aPoly[2,1]= 35
		This.aPoly[2,2]= 5

		This.aPoly[3,1]= 65
		This.aPoly[3,2]= 5

		This.aPoly[4,1]= 95
		This.aPoly[4,2]= 35

		This.aPoly[5,1]= 95
		This.aPoly[5,2]= 65

		This.aPoly[6,1]= 65
		This.aPoly[6,2]= 95

		This.aPoly[7,1]= 35
		This.aPoly[7,2]= 95

		This.aPoly[8,1]= 5
		This.aPoly[8,2]= 65

		Thisform.AddObject("lblStop","Label")
		With Thisform.lblStop
			.Top = This.Top + 25
			.Left = This.Left + 30
			.ForeColor = Rgb(255,255,255)
			.BackStyle = 0
			.Caption = "Stop"
			.AutoSize = .T.
			.FontSize=20
			.Visible = .T.
		Endwith
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Rand(-1)
		With This
			For i=1 To 35
				.Rotation=.Rotation+10
				Thisform.lblStop.Rotation=Thisform.lblStop.Rotation+10
				Sleep(20)
				.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
			Endfor
			.Rotation=0
			Thisform.lblStop.Rotation=0
		Endwith
	Endproc

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		This.Rotation=0
		This.Parent.lblStop.Rotation=0
	Endproc
Enddefine
*
*-- EndDefine: asup5

Define Class asup6 As TextBox

	Value = "Any text here"
	Height = 48
	Left = 780
	Top = 24
	Width = 133
	Name = "Text1"

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize - 5
		Catch
		Endtry
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize + 5
		Catch
		Endtry
	Endproc
Enddefine
*
*-- EndDefine: asup6

Define Class asup7 As CommandButton
	Top = 24
	Left = 636
	Height = 49
	Width = 109
	Anchor = 768
	Caption = "Command1"
	BackColor = Rgb(128,255,0)
	Name = "Command1"

	Procedure MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		Try
			This.FontSize = This.FontSize - 5
		Catch
		Endtry
	Endproc

	Procedure MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord

		Try
			This.FontSize = This.FontSize + 5
		Catch
		Endtry
	Endproc

Enddefine
*
*-- EndDefine: asup7




Working on VFP objects dynamically - part2

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



*8*
*browse window is a vfp child window.it appears only on vfp environmeent screen. it cannot found by the common API Findwindow
*findWindow: (https://msdn.microsoft.com/en-us/library/windows/desktop/ms633499(v=vs.85).aspx)
*FindWindow retrieves a handle to the top-level window whose class name and window name match the specified strings.
*This function does not search child windows and  does not perform a case-sensitive search.

*VFP Browse child  window can be found by the API FindWindowEx (https://msdn.microsoft.com/en-us/library/windows/desktop/ms633500(v=vs.85).aspx)
*i guess that the browse [clause name] makes it as a child window in windows mean and gives it a handle.this is very easy to work with.
*then having a handle,it can be manipulated as any windows window.
*try this demo is for a native normal browse window :
*[posté à UT answering  a foxer]

Do ydeclare

Select company,address From Home(1)+"samples\data\customer" Into Cursor ycurs
Local m.lcAlias
m.lcAlias=Alias()
Browse Nowait   &&the browse here have mandatory ycurs as title

Local hWindow
hWindow=FindWindowEx(_Screen.HWnd,0,Null,m.lcAlias)
Messagebox("hWindow="+Trans(hWindow) ,0+32+4096,'',1300)

*if IsWindow(hWindow)=0  && isWindow wit browse (here a child window not a desktop window .
*messagebox("not found",0+32+4096)
*return .f.
*endi

Messagebox("child window found",0+32+4096,'',1200)
*find the browse title
nBufsize = 2048
cBuffer = Replicate(Chr(0), nBufsize)
nBufsize = GetWindowText(hWindow, @cBuffer, nBufsize)
Messagebox("Title="+ Iif(nBufsize=0, "", Left(cBuffer, nBufsize)),0+32+4096,'',1300)


*find the browe window position
cBuffer = Replicate(Chr(0), 16)
GetWindowRect( hWindow, @cBuffer )
Local x0,y0,x1,y1  &&left browse window point(x0,y0)-right bottom point (c1,y1)
x0= buf2dword( Substr(cBuffer, 1, 4) )
y0 =buf2dword( Substr(cBuffer, 5, 4) )
x1= buf2dword( Substr(cBuffer, 9, 4) )
y1= buf2dword( Substr(cBuffer, 13, 4) )
Messagebox("x="+Trans(x0)+"  y0="+Trans(y0)+"    x1="+Trans(x1)+"   y1="+Trans(y1),0+32+4096,'',1300)

*change the browse window title(caption)
SetWindowText(hWindow,"vfp Browse is a real Windows vfp child window!...."+Ttoc(Datetime())  )


*position browe window anywhere on vfp screen (always as child window)
SetWindowPos(hWindow,0,0,0,800,600,64)
Inke(1)
SetWindowPos(hWindow,0,400,100,800,600, 64)
Inke(1)
SetWindowPos(hWindow,0,0,100,400,500, 64)
Inke(1)
SetWindowPos(hWindow,0,0,0,Sysmetric(1),Sysmetric(2), 64)

Rand(-1)
For i=1 To 20
	SetWindowPos(hWindow,0, 100*Sin(i),200*Cos(i),Sysmetric(1),Sysmetric(2), 64)
	Inkey(0.1)
Endfor
Inke(1)
SetWindowPos(hWindow,0,0,0,800,600,64)

Retu


Function buf2dword(lcBuffer)
	Return Asc(Substr(lcBuffer, 1,1)) + ;
		BitLShift(Asc(Substr(lcBuffer, 2,1)),  8) +;
		BitLShift(Asc(Substr(lcBuffer, 3,1)), 16) +;
		BitLShift(Asc(Substr(lcBuffer, 4,1)), 24)
Endfunc


Procedure ydeclare
	Declare Integer FindWindowEx In user32 Integer, Integer, String ,String
	Declare Integer FindWindow In user32;
		STRING lpClassName, String lpWindowName
	Declare Integer IsWindow In user32 Integer hWindow
	Declare Integer GetWindowRect In user32;
		INTEGER hWindow,;
		STRING @lpRect
	Declare Integer GetWindowText In user32;
		INTEGER HWnd,;
		STRING @lpString,;
		INTEGER cch
	Declare Integer SetWindowText In user32;
		INTEGER HWnd,;
		STRING  lpString
	Declare Integer SetWindowPos In user32;
		INTEGER HWnd,;
		INTEGER hWndInsertAfter,;
		INTEGER x,;
		INTEGER Y,;
		INTEGER cx,;
		INTEGER cy,;
		INTEGER wFlags
Endproc


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


*9* created on 17 of november 2017
*this code shows a special effect on editbox (can be a textbox,image,commandbutton but to adapt the effect).

Publi yform
yform=Newobject("yzoom_editbox")
yform.Show
Read Events
Retu
*
Define Class yzoom_editbox As Form
	BorderStyle = 0
	Height = 484
	Width = 742
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Mouse over the first editbox control."
	MaxButton = .F.
	yval = ""
	Name = "Form1"

	Add Object edit1 As EditBox With ;
		FontBold = .T., ;
		BorderStyle = 0, ;
		Height = 72, ;
		Left = 48, ;
		ScrollBars = 0, ;
		Top = 12, ;
		Width = 289, ;
		backstyle=0,;
		EnableHyperlinks = .T., ;
		Name = "Edit1"

	Add Object edit2 As EditBox With ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Height = 212, ;
		Left = 47, ;
		ScrollBars = 0, ;
		SpecialEffect = 2, ;
		Top = 256, ;
		Width = 636, ;
		ForeColor = Rgb(128,0,64), ;
		Name = "Edit2"

	Procedure Destroy
		Thisform.edit1.EnableHyperlinks=.F.   &&to dont affect the global  _VFP.EditorOptions setting
		Clea Events
	Endproc

	Procedure Init
		Declare Integer Sleep In kernel32 Integer
		This.ShowTips=.T.
	Endproc

	Procedure edit1.MouseLeave
		Lparameters nButton, nShift, nXCoord, nYCoord
		Thisform.RemoveObject("shp")
		With This
			.Width=Thisform.w
			.Height=Thisform.h
			.Value=Substr(Thisform.yval,1,120)+" ...."+Chr(13)+"My Blog: http://yousfi.over-blog.com" +"   Read more..."
			.FontBold=.T.
		Endwith
	Endproc

	Procedure edit1.MouseEnter
		Lparameters nButton, nShift, nXCoord, nYCoord
		With This
			.Width =2.1*Thisform.w
			.Height=2.8*Thisform.h
			.Value=Thisform.yval +   Chr(13)+"My Blog :    http://yousfi.over-blog.com"
		Endwith

		With Thisform
			.AddObject("shp","shape")
			With .shp
				.Left=Thisform.edit1.Left-5
				.Top=Thisform.edit1.Top-5
				.Width=Thisform.edit1.Width+2*5
				.Height=Thisform.edit1.Height+2*5
				.BackColor=Rgb(255,128,64)
				.ZOrder(1)
				.Visible=.T.
			Endwith
		Endwith
	Endproc

	Procedure edit1.Init
		TEXT to thisform.yval pretext 7 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
		pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
		lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
		sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
		sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
		velit vel ex aliquam, eget convallis ante mollis.
		ENDTEXT
		With This
			.FontBold=.T.
			.ScrollBars=0
			.BackColor=.Parent.BackColor
			.EnableHyperlinks=.T.
			.Value=Substr(Thisform.yval,1,120)+" ...."+Chr(13)+"My Blog: http://yousfi.over-blog.com" +"   Read more..."
			Thisform.AddProperty("w",0)
			Thisform.AddProperty("h",0)
			Thisform.w=.Width
			Thisform.h=.Height
		Endwith
	Endproc

	Procedure edit2.Init
		TEXT to this.value pretext  7 noshow
		Setting the global Enable Hyperlinks option in the Options dialog box affects EnableHyperlinks, which you can set at run time using _VFP.EditorOptions.
		If you turn off hyperlinks globally, Visual FoxPro disregards EnableHyperlinks and does not activate hyperlinks.

		As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions setting (whether click or CTRL+Click goes to the link).

		If a form's ShowTips property is set to True (.T.), Visual FoxPro displays a value tip such as "CTRL+Click to follow link" when you move the
		mouse over the hyperlink. If a value is specified for the ToolTipText property, Visual FoxPro displays the ToolTip text when your mouse moves
		over any non-hyperlink portion of the control.(source:FoxHelp)
		ENDTEXT
	Endproc

Enddefine
*
*-- EndDefine: yzoom_editbox


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

*10* created on 18 of december 2017
*build a container class for minimize,maximize/restore and close buttons on any form.the advantage here is we work on Marlette font( no image).
*can disable any of these buttons in class code

Public oform
oform=Newobject("yform")
oform.Show
Read Event

Define Class yform As Form
  Height = 200
  Width = 597
  ShowWindow = 2
  AutoCenter = .T.
  Caption = "ytxt2pdf"
  BackColor=Rgb(212,210,208)
  BorderStyle=1
  ControlBox=.F.
  Name = "Form1"

  Add Object ysystem1 As ysystem With ;
    left=597-65,;
    top=1,;
    name="ysystem1"

  Procedure Init
    This.Resize

  Endproc

  Procedure Resize
    With This.ysystem1
      .Left=.Parent.Width-.Width-2
      .Top=1
    Endwith
  Endproc

  Procedure Destroy
    oform=Null
    Release oform
    Clea Events
  Endproc
Enddefine


Define Class ysystem As Container   &&minimize,maximize/restore,close buttons as fonts.
  Width = 65
  Height = 26
  BackStyle=0
  BorderWidth=0
  Name = "ysystem"

  Add Object label3 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontName = "Marlett", ;
    FontSize = 12, ;
    BackStyle = 0, ;
    Caption = "0", ;
    Height = 21, ;
    Left = 0, ;
    MousePointer = 15, ;
    Top = 0, ;
    Width = 22, ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Label3"

  Add Object label4 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontName = "Marlett", ;
    FontSize = 12, ;
    BackStyle = 0, ;
    Caption = "r", ;
    Height = 21, ;
    Left = 43, ;
    MousePointer = 15, ;
    Top = 5, ;
    Width = 22, ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Label4"

  Add Object label5 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontName = "Marlett", ;
    FontSize = 12, ;
    BackStyle = 0, ;
    Caption = "1", ;
    Height = 21, ;
    Left = 22, ;
    MousePointer = 15, ;
    Top = 5, ;
    Width = 22, ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Label5"

  Procedure label3.Click
    Thisform.WindowState=1
  Endproc

  Procedure label3.MouseLeave
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=255
  Endproc

  Procedure label3.MouseEnter
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=Rgb(0,255,0)
  Endproc

  Procedure label4.Click
    Thisform.Release
  Endproc

  Procedure label4.MouseLeave
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=255
  Endproc

  Procedure label4.MouseEnter
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=Rgb(0,255,0)
  Endproc

  Procedure label5.Init  &&enabled
    This.Enabled=.T.
  Endproc

  Procedure label5.MouseEnter
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=Rgb(0,255,0)
  Endproc

  Procedure label5.MouseLeave
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.ForeColor=255
  Endproc

  Procedure label5.Click
    With Thisform
      .WindowState=Iif(.WindowState=0,2,0)

      If .WindowState=0
        This.Caption="1"
      Else
        This.Caption="2"
      Endi
    Endwith
  Endproc

Enddefine
*
*-- EndDefine: ysystem


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

*11*  created on  friday 30 of december 2017 for an Atoufox user.
*!*Listbox rowSource anomaly
*!*	the listbox item picture property is only valid for rowSourceType = 0 (default), rowSourceType = 1 (values), rowSourcetYpe = 9 (menu)
*!*	this allows you to add icons or custom images (bmp, jpg, png ...) to the left of each item in the list.
*!*	for the others (rowsource = 2,3,4,5,6,7,8,10) even coded the image does not appear in the listbox.
*!*	No help (especially FoxHelp) speaks of this. This is worth mentioning in foxHelp...

PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
read events
RETURN

DEFINE CLASS form1 AS form
	Top = 78
	Left = 204
	Height = 420
	Width = 1163
	Caption = "ListBox control rowsource anomaly."
	Name = "Form1"

	ADD OBJECT list1 AS listbox WITH ;
		Height = 301, ;
		Left = 6, ;
		Top = 36, ;
		Width = 253, ;
		Name = "List1"

	ADD OBJECT list2 AS listbox WITH ;
		Height = 252, ;
		Left = 265, ;
		Top = 36, ;
		Width = 145, ;
		Name = "List2"

	ADD OBJECT list3 AS listbox WITH ;
		Height = 174, ;
		Left = 413, ;
		Top = 36, ;
		Width = 181, ;
		Name = "List3"

	ADD OBJECT edit1 AS editbox WITH ;
		Height = 380, ;
		Left = 868, ;
		Top = 24, ;
		Width = 288, ;
		Name = "Edit1"

	ADD OBJECT list4 AS listbox WITH ;		
		Height = 241, ;
		Left = 598, ;
		Top = 36, ;
		Width = 264, ;
		Name = "List4"

	PROCEDURE Destroy
		clea events
	ENDPROC

	PROCEDURE list1.Init
		sele company from home(1)+"samples\data\customer" into cursor ycurs
		with this
		.rowsource="ycurs.company"
		.rowsourcetype=6   &&fields
		sele ycurs
		for i=1 to .listcount
		.picture[m.i]= home(1)+"graphics\icons\misc\misc15.ico"
		endfor
		.refresh
		endwith
	ENDPROC

	PROCEDURE list2.Init
		local gnbre
		gnbre=adir(gabase0, HOME(4)+"icons\win95\*.ico")
		with this		
		.rowSourcetype=0   &&1
		for i=1 to 10
		.additem("   item"+trans(i))
		.picture[i]=HOME(4)+"icons\win95\"+gabase0(i,1)
		endfor
		endwith
	ENDPROC

	PROCEDURE list3.Init
		local gnbre
		gnbre=adir(gabase1,HOME(4)+"Bitmaps\Tlbr_w95\*.bmp")
		  WITH this
		  local m.xx
		  m.xx=""
		  	DEFINE POPUP ymenu RELATIVE
		 DEFINE BAR 1  of ymenu PROMPT "   item1" COLOR ,RGB(0,128,0,200,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(1,1)
		 DEFINE BAR 2  of ymenu PROMPT "   item2" COLOR ,RGB(0,128,0,100,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(2,1)
		 DEFINE BAR 3  of ymenu PROMPT "   item3" COLOR ,RGB(0,128,0,150,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(3,1)
		 DEFINE BAR 4  of ymenu PROMPT "   item4" COLOR ,RGB(0,128,0,50,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(4,1)
		 DEFINE BAR 5  of ymenu PROMPT "   item5" COLOR ,RGB(0,128,0,120,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(5,1)
		 DEFINE BAR 6  of ymenu PROMPT "   item6" COLOR ,RGB(0,128,0,190,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(6,1)
		 DEFINE BAR 7 of ymenu PROMPT  "   item7" COLOR ,RGB(0,128,0,30,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(7,1)
		 DEFINE BAR 8  of ymenu PROMPT "   item8" COLOR ,RGB(0,128,0,240,200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(8,1)
		 DEFINE BAR 9  of ymenu PROMPT "   item9" COLOR ,RGB(0,128,0,200,205,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(9,1)
		 DEFINE BAR 10 of ymenu PROMPT "   item10"COLOR ,RGB(0,128,0,100,1200,255) 	PICTURE  HOME(4)+"Bitmaps\Tlbr_w95\" +gabase1(10,1)
		   	.RowSourceType=9  &&Pop-up
		  	.RowSource ='ymenu'
		  ENDWITH
	ENDPROC

	PROCEDURE edit1.Init
		with this
		.fontsize=8
		text to .value noshow
		 Listbox  RowSourceType 0-10
		
		0  None. (Default)
		1 Value.
		2 Table alias.
		3 SQL statement.
		4 Query (.qpr) file.
		5  Array.
		6  Fields.
		7  Files.
		8  Field structure of a table.
		9  Pop-up. Included for backward compatibility.
		10  Collection object.

		the listbox item picture property is only valid for rowSourceType = 0 (default), rowSourceType = 1 (values), rowSourcetYpe = 9 (menu)
		this allows you to add icons or custom images (bmp, jpg, png ...) to the left of each item in the list.
		for the others (rowsource = 2,3,4,5,6,7,8,10) even coded the image does not appear in the listbox.
		No help (especially FoxHelp) speaks of this. This is worth mentioning in foxHelp...

		endtext
		.fontbold=.t.
		.readonly=.t.
		.scrollbars=0
		.borderstyle=0
		endwith
	ENDPROC

	PROCEDURE list4.Init
		local gnbre
		gnbre=adir(gabase2, HOME(4)+"icons\win95\*.ico")	
		with this
		.rowSourcetype=5
		.rowSource="gabase2"
		.requery()
		*disp memo like gabase*
		for i=1 to .listcount
		.picture[i]=HOME(4)+"icons\win95\"+gabase2(i,1)
		endfor
		endwith
	ENDPROC

ENDDEFINE
*
*-- EndDefine: form1


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

 
*12* created on saturday 21 of january 2018
*add a menu option to vfp system menu  +ots popup-this is a template how to do.
*can customize the menu option added and adapt to your case.(code to fire and icons beside each bar)

set sysmenu to defa

DEFINE PAD padReports OF _MSYSMENU   PROMPT "\<yMenu"   MESSAGE "Choose action to run"
DEFINE POPUP popReports MARGIN
ON PAD padReports OF _MSYSMENU ACTIVATE POPUP popReports

DEFINE BAR 1 OF popReports   PROMPT "1. System colors"    MESSAGE "Change vfp system colors" picture "D:\________ytest2017\yicons_start\1.ico"
DEFINE BAR 2 OF popReports   PROMPT "2. ycolorConverter"   MESSAGE  "colors converter"       picture "D:\________ytest2017\yicons_start\2.ico"
DEFINE BAR 3 OF popReports   PROMPT "3. yIE editable"      MESSAGE  "IE editable"            picture "D:\________ytest2017\yicons_start\3.ico"
DEFINE BAR 4 OF popReports   PROMPT "4. yClean recursive"   MESSAGE  "yClean recursive"      picture "D:\________ytest2017\yicons_start\4.ico"
DEFINE BAR 5 OF popReports   PROMPT "5. ySearch tool"   MESSAGE  "ySearch tool"              picture "D:\________ytest2017\yicons_start\5.ico"
DEFINE BAR 6 OF popReports   PROMPT "6. Google translate"   MESSAGE  "Google translate"      picture "D:\________ytest2017\yicons_start\6.ico"
DEFINE BAR 7 OF popReports   PROMPT "7. ySnapShot"   MESSAGE  "ySnapShot"                    picture "D:\________ytest2017\yicons_start\7.ico"
DEFINE BAR 8 OF popReports   PROMPT "8. Execute solution.app" MESSAGE "Execute solution.app" picture "D:\________ytest2017\yicons_start\8.ico"
DEFINE BAR 9 OF popReports   PROMPT "9. my Toolbar MRU" MESSAGE "my Toolbar MRU"             picture "D:\________ytest2017\yicons_start\9.ico"
DEFINE BAR 10 OF popReports   PROMPT "10. Restore vfp system menu"   MESSAGE  "Restore vfp system menu" picture "D:\________ytest2017\yicons_start\10.ico"

on selection bar 1 of popReports  do D:\________YTEST2017\YCHANGE_SYSTEM_COLORS\YCHANGE_SYSTEM_COLORS_WINDOW_NEWS2NEWS.PRG
on selection bar 2 of popReports  do D:\___________________yprog2017\ycolors_converter.exe
on selection bar 3 of popReports  do D:\________ytest2017\yQuestions\yeditable_ie.exe
on selection bar 4 of popReports  do D:\________ytest2017\yclean\yclean_recursive.exe
on selection bar 5 of popReports  do D:\_______________________yoverlblog_Posts\____todo\_________wactuel\____ywin32API_declare\yapi_just_needed\Yapi_net_15_12_2014\ysearch_tool.exe
on selection bar 6 of popReports  do D:\_______________________yoverlblog_Posts\yposted\ygoogle_translate\ygoogle_translate.exe
on selection bar 7 of popReports  do D:\________ytest2017\ysnapshot\ysnapshot.exe
on selection bar 8 of popReports  do home(1)+"samples\solution\solution.app"
on selection bar 9 of popReports  do d:\yvfpstart\yvfpstart.prg
on selection bar 10 of popReports  set sysmenu to defa

*can be also on a vfp top level form menu



can put personal tools in the vfp menu board ans access to the easily...

can put personal tools in the vfp menu board ans access to the easily...

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


*13* created on sunday 03 of february 2018
*show /hide all desktop icons automatically (switch hide/show)
*build an exe and pin  it to the taskbar.

DECLARE INTEGER FindWindowEx IN user32;
    INTEGER  hwndParent,;
    INTEGER  hwndChildAfter,;
    STRING @ lpszClass,;
    STRING @ lpszWindow

 DECLARE INTEGER SendMessage IN user32;
    INTEGER hWnd,;
    INTEGER Msg,;
    INTEGER wParam,;
    INTEGER lParam
_screen.windowstate=1

 #define WM_COMMAND 	0x0111	
 hWindow = FindWindowEx(0, 0, "Progman", 0)
 hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", 0)

 SendMessage(hWindow, WM_COMMAND, 0x7402,1)  &&switch automatically the desktop hide/show


Working on VFP objects dynamically - part2

*Important:All Codes above are tested on VFP9SP2 & windows 10 pro.Any usefull feed back is welcome.This enriches the base vfp knowledge for all followers.

To be informed of the latest articles, subscribe:
Comment on this post
P
Awesome blog. The information you are providing is very useful for foxpro developers. Thanks for sharing.
http://techmaticsys.com/foxpro.html
Reply