Medidor (gauge) 100% en VFP 9.0

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.

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

Luis María Guayán