* 1) Crear una clase custom en una biblioteca VCX
* Por ejemplo, la clase Custom se crea con el nombre "FunSombra"
* dentro de una biblioteca vcx llamada: "MzSombra" (podés utilizar alguna que ya tengas)
* --------------------------------------------
* Contenido de FunSombra
* Agregar a FunSombra tres métodos de usuario
* GetBind()
* AddShape()
* RmvShape()
* ---------------------------------------------------------------
* Una vez creada la biblioteca, el procedimiento es, simplemente,
* pegar la clase Custom "FunSombra" a los formularios en que se
* utilice o a la clase de Base "Form".
* ---------------------------------------------------------------
* ------------------------
* Evento Init de FunSombra
* ------------------------
GetBind(thisform)
* ------------------
* Método GetBind()
* ------------------
* GetBind es un método recursivo que puede aplicarse a cualquier caso
* modificando lo que sea conveniente.
* En otros usos, resulta necesario agregar CASEs para controles
* que aquí no se emplean. Control Grid debe evaluarse por Columns, por
* ejemplo.
* lOmitDef es un parámetro que se utiliza cuando en la llamada
* recursiva se necesita evitar alguna definición. Por ejemplo, crear
* o valorizar alguna propiedad o ejecutar algún método adicional.
* En este ejemplo no es operativo.
* --------------------------------------------------------------------
LPARAMETERS xoObjeto,lOmitDef
LOCAL ocontrol,ocont,objPict,opage
DO case
CASE UPPER(xoObjeto.Baseclass)="FORM"
UNBINDEVENTS(xoObjeto)
FOR EACH oControl IN xoObjeto.Controls
this.GetBind(oControl,.t.)
ENDFOR
CASE UPPER(xoObjeto.Baseclass)="CONTAINER"
UNBINDEVENTS(xoObjeto)
FOR EACH xoObjeto IN xoObjeto.Controls
This.getbind(xoObjeto,.t.)
ENDFOR
CASE UPPER(xoObjeto.Baseclass)="PAGEFRAME"
UNBINDEVENTS(xoObjeto)
FOR EACH OPAGE IN xoObjeto.pages
UNBINDEVENTS(oPage)
FOR EACH objPict IN opage.controls
THIS.GETbind(OBJPICT,.t.)
ENDFOR
ENDFOR
CASE UPPER(xoObjeto.baseclass)="IMAGE"
UNBINDEVENTS(xoObjeto)
CASE INLIST(UPPER(xoObjeto.BaseClass),"TEXTBOX","EDITBOX","COMBOBOX","LIST")
&& Se asegura que los objetos tengan un aspecto similar.
WITH xoObjeto
.specialEffect=1
.BorderColor=RGB(114,136,141)
ENDWITH
UNBINDEVENTS(xoObjeto)
BINDEVENT(xoObjeto,"GotFocus",this,"addshape")
BINDEVENT(xoObjeto,"LostFocus",this,"rmvshape")
ENDCASE
* ------------------
* Método AddShape
* ------------------
* AddShape Method
* Bind GotFocus Event
**********************
LOCAL ntop,nLeft,nWidth,nHeight,lcName,nEvents,xoObjeto,obj
nEvents=AEVENTS(gaEvent,0)
IF nEvents=0
RETURN
ENDIF
xoObjeto=gaEvent[1]
ntop=xoObjeto.top
nLeft=xoObjeto.left
nWidth=xoObjeto.width
nHeight=xoObjeto.Height
lcName="Shape_"+xoObjeto.name
xoObjeto.Parent.newobject(lcName,"Shape")
Obj=xoObjeto.Parent.&lcName
WITH obj
.Top=nTop-2
.Left=nLeft-2
.Width=nWidth+4
.Height=nHeight+4
.BackStyle=0
.BorderColor=RGB(0,64,128)
.Curvature=5
.Visible=.t.
ENDWITH
xoObjeto.zOrder(0)
* -----------------
* Método RmvShape
* -----------------
* RmvShape Method
* Bind Lostfocus Event
LOCAL ntop,nLeft,nWidth,nHeight,lcName,nEvents,xoObjeto
nEvents=AEVENTS(gaEvent,0)
IF nEvents=0
RETURN
ENDIF
xoObjeto=gaEvent[1]
lcName="Shape_"+xoObjeto.name
IF PEMSTATUS(xoObjeto.parent,lcName,5)
xoObjeto.Parent.removeobject(lcName)
ENDIF
