 Clase con un medidor circular (gauge) que grafica el porcentaje de un procedimiento con un objeto Shape y la nueva propiedad PolyPoint de Visual FoxPro 9.0.
Medidor 100% en VFP 9.0 Por Luis María Guayán, Tucumán, Argentina
El siguiente es el código 100% VFP9 para graficar un medidor circular. En el ejemplo se utiliza la imagen "lmGauge.gif" como fondo del medidor. Puede descargar la imagen, la clase y un formulario de ejemplo haciendo clic en el siguiente enlace: lmGauge.zip (14,9 KB)
Imagen del formulario de ejemplo conteniendo la clase lmGauge
PUBLIC goMiForm
goMiForm = CREATEOBJECT("MiForm")
goMiForm.SHOW(1)
RETURN
DEFINE CLASS MiForm AS FORM
HEIGHT = 250
WIDTH = 350
AUTOCENTER = .T.
CAPTION = "Gauge"
NAME = "MiForm"
ADD OBJECT Gauge1 AS lmGauge WITH ;
TOP = 8, ;
LEFT = 16, ;
WIDTH = 220, ;
NAME = "Gauge1"
ADD OBJECT cmdGraficar AS COMMANDBUTTON WITH ;
TOP = 8, ;
LEFT = 248, ;
HEIGHT = 32, ;
WIDTH = 84, ;
CAPTION = "Graficar", ;
NAME = "cmdGraficar"
ADD OBJECT cmdColor AS COMMANDBUTTON WITH ;
TOP = 48, ;
LEFT = 248, ;
HEIGHT = 32, ;
WIDTH = 84, ;
CAPTION = "Color", ;
NAME = "cmdColor"
PROCEDURE cmdGraficar.CLICK
LOCAL ln
THISFORM.SETALL("Enabled",.F.,"CommandButton")
*-- Simulo un proceso del 0 al 100%
FOR ln = 0 TO 100
THISFORM.Gauge1.Grafica(ln)
INKEY(.001,"MH")
ENDFOR
THISFORM.SETALL("Enabled",.T.,"CommandButton")
ENDPROC
PROCEDURE cmdColor.CLICK
THISFORM.Gauge1.shpGauge.BACKCOLOR = ;
GETCOLOR(THISFORM.Gauge1.shpGauge.BACKCOLOR)
ENDPROC
ENDDEFINE
DEFINE CLASS lmGauge AS CONTAINER
WIDTH = 220
HEIGHT = 220
BACKSTYLE = 0
BORDERWIDTH = 0
NAME = "lmGauge"
ADD OBJECT shpGauge AS SHAPE WITH ;
TOP = 0, ;
LEFT = 0, ;
HEIGHT = 220, ;
WIDTH = 220, ;
BORDERWIDTH = 1, ;
BACKCOLOR = RGB(255,255,255), ;
POLYPOINTS = "This.aPoly", ;
NAME = "shpGauge"
ADD OBJECT lblGauge AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTBOLD = .T., ;
FONTNAME = "Arial", ;
FONTSIZE = 9, ;
ALIGNMENT = 2, ;
BACKSTYLE = 0, ;
CAPTION = "100%", ;
HEIGHT = 20, ;
LEFT = 90, ;
TOP = 140, ;
WIDTH = 32, ;
NAME = "lblGauge"
*-- debe existir el archivo grafico "lmGauge.gif"
ADD OBJECT imgGauge AS IMAGE WITH ;
PICTURE = "lmGauge.gif", ;
STRETCH = 2, ;
BACKSTYLE = 0, ;
HEIGHT = 220, ;
LEFT = 0, ;
TOP = 0, ;
WIDTH = 220, ;
NAME = "imgGauge", ;
VISIBLE = FILE("lmGauge.gif")
PROCEDURE Grafica
LPARAMETERS tnGauge
LOCAL lnGauge, lnAng, lnCos, lnSen
lnAng = 0
lnCos = COS(DTOR(lnAng + 135))
lnSen = SIN(DTOR(lnAng + 135))
THIS.shpGauge.aPoly(2,1) = 50 * lnCos + 50
THIS.shpGauge.aPoly(2,2) = 50 * lnSen + 50
lnGauge = MAX(0,MIN(tnGauge,100)) * 0.1
FOR lnI = 3 TO 30
lnAng = (lnGauge) * (lnI - 3)
lnCos = COS(DTOR(lnAng + 135))
lnSen = SIN(DTOR(lnAng + 135))
THIS.shpGauge.aPoly(lnI,1) = 50 * lnCos + 50
THIS.shpGauge.aPoly(lnI,2) = 50 * lnSen + 50
ENDFOR
THIS.lblGauge.CAPTION = TRANSFORM(tnGauge,"999%")
THIS.shpGauge.REFRESH
ENDPROC
PROCEDURE INIT
THIS.Grafica(0)
ENDPROC
PROCEDURE shpGauge.INIT
LOCAL lnI
THIS.HEIGHT = THIS.PARENT.HEIGHT
THIS.WIDTH = THIS.PARENT.WIDTH
THIS.ADDPROPERTY("aPoly[30,2]")
FOR lnI = 1 TO 30
STORE 50 TO ;
THIS.aPoly[lnI,1], ;
THIS.aPoly[lnI,2]
ENDFOR
ENDPROC
PROCEDURE lblGauge.INIT
THIS.TOP = THIS.PARENT.HEIGHT * .75
THIS.LEFT = (THIS.PARENT.WIDTH / 2) - (THIS.WIDTH / 2)
ENDPROC
PROCEDURE imgGauge.INIT
THIS.HEIGHT = THIS.PARENT.HEIGHT
THIS.WIDTH = THIS.PARENT.WIDTH
THIS.STRETCH = 2
ENDPROC
ENDDEFINE
|
