Working on VFP objects dynamically - part2
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
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.
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
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
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
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
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...
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
*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.