30 de marzo de 2015

Usando el CTL32 ProgressBar de FoxyPreviewer

Artículo original: Using the CTL32 ProgressBar from FoxyPreviewer
(http://weblogs.foxite.com/vfpimaging/archive/2011/01/21/13664.aspx)
Autor: VFPIMAGING
Traducido por: Luis Maria Guayán


FoxyPreviewer.App es una colección de clases. En su interior hay varias clases, que se pueden acceder directamente usando VFP.

Recientemente he recibido el requerimiento de mostrar como podria utilizar el CTL32 ProgressBar directamente.

!Eso es realmente simple! El comando es NEWOBJECT(), que nos permite acceder a las clases desde un archivo EXE o APP externo.

En primer lugar el autor de esta joya, el CTL32 ProgressBar es Carlos Alloatti. Para obtener la información completa sobre cómo usarlo, por favor vaya directamente al sitio web de CTL32: www.ctl32.com

Uso:

=Dotherm(90, "Caption", "TitleBar") && Muestra la barra de progreso normal con el 90%



=DoTherm(-1, "Caption", "TitleBar") && El valor -1 en el primer parámetro muestra el efecto de marquesina



=DoTherm() && Desactiva la barra de progreso

Guardar el código de abajo como DOTHERM.PRG

* DOTHERM.PRG
* =DoTherm(90, "Texto label", "Titulo")
* =DoTherm(-1, "Teste2", "Titulo") && Continuo
* =DoTherm() && Desactiva

LPARAMETERS tnPercent, tcLabelText, tcTitleText
IF NOT PEMSTATUS(_SCREEN , "oThermForm", 5)
  _SCREEN.ADDPROPERTY("oThermForm", "")
ENDIF
IF EMPTY(tnPercent)
  TRY
    _SCREEN.oThermForm.RELEASE()
  CATCH
  ENDTRY
  _SCREEN.oThermForm = NULL
  RETURN
ENDIF


IF TYPE("_Screen.oThermForm.Therm") <> "O"
  DO CreateTherm
ENDIF
LOCAL loThermForm AS FORM
loThermForm = _SCREEN.oThermForm
IF NOT EMPTY(tcLabelText)
  loThermForm.ThermLabel.CAPTION = tcLabelText
ENDIF
IF NOT EMPTY(tcTitleText)
  loThermForm.CAPTION = tcTitleText
ENDIF
IF tnPercent = -1
  loThermForm.Therm.Marquee = .T.
ELSE
  IF loThermForm.Therm.Marquee = .T.
    loThermForm.Therm.Marquee = .F.
  ENDIF
  loThermForm.Therm.VALUE = tnPercent
ENDIF
loThermForm.VISIBLE = .T.

RETURN


PROCEDURE CreateTherm
  LOCAL loForm AS FORM
  loForm = CREATEOBJECT("FORM")
  _SCREEN.oThermForm = loForm
  LOCAL lnBorder, liThermHeight, liThermWidth, liThermTop, liThermLeft
  lnBorder = 7
  WITH loForm AS FORM
    .SCALEMODE = 3 && Pixels
    .HEIGHT = 48
    .HALFHEIGHTCAPTION = .T.
    .WIDTH = 300
    .AUTOCENTER = .T.
    .BORDERSTYLE = 3 && Fixed dialog
    .CONTROLBOX = .F.
    .CLOSABLE = .F.
    .MAXBUTTON = .F.
    .MINBUTTON = .F.
    .MOVABLE = .F.
    .ALWAYSONTOP = .T.
    .ALLOWOUTPUT = .F.

    .NEWOBJECT("Therm","ctl32_progressbar", "PR_ctl32_progressbar.vcx", LOCFILE("FoxyPreviewer.app"))
    .NEWOBJECT("ThermLabel", "Label")

    .ThermLabel.VISIBLE = .T.
    .ThermLabel.FONTBOLD = .T.
    .ThermLabel.TOP = 4
    .ThermLabel.WIDTH = .WIDTH - (lnBorder * 2)
    .ThermLabel.ALIGNMENT = 2 && Center
    liThermHeight = .HEIGHT - (lnBorder * 2) - .ThermLabel.HEIGHT
    liThermWidth = .WIDTH - (lnBorder * 2)
    .VISIBLE = .T.
  ENDWITH
  liThermTop = lnBorder + 20
  liThermLeft = lnBorder
  WITH loForm.Therm
    .TOP = liThermTop
    .LEFT = liThermLeft
    .HEIGHT = liThermHeight
    .WIDTH = liThermWidth
    .MarqueeSpeed = 30
    .MarqueeAnimationSpeed = 30
    .VISIBLE = .T.
    .CAPTION = ""
  ENDWITH
ENDPROC

25 de marzo de 2015

Como ordenar un Grid haciendo clic en cada columna

Aquí está un sencillo ejemplo funcional de como agregar la característica de ordenamiento en un Grid, haciendo clic en la columna por la cual deseamos ordenar la tabla.

En el ejemplo utilizamos la clase MyGridOrd derivada de Grid. Esta clase la podemos almacenar en una librería de clases visuales VCX.

Las clases que no podemos almacenar en una librería de clases visuales, y la debemos definir programáticamente son las clases MyColumnOrd y MyHeaderOrd, y es allí donde definimos los métodos de ordenamiento con el clic en el Header de cada columna, y la imagen correspondiente para cada Header.

LOCAL loForm AS FORM
USE (HOME(2) + "Northwind\Customers")
loForm = CREATEOBJECT("Form")
loForm.CAPTION = "Ejemplo de grid con orden por columna"
loForm.ADDOBJECT("MyGrid","MyGridOrd")
loForm.MyGrid.Order_Enabled = .T.
loForm.MyGrid.Order_All()
loForm.MyGrid.RECORDSOURCE = "Customers"
loForm.MyGrid.READONLY = .T.
loForm.MyGrid.WIDTH = loForm.WIDTH
loForm.MyGrid.HEIGHT = loForm.HEIGHT
loForm.MyGrid.ANCHOR = 15
loForm.MyGrid.VISIBLE = .T.
loForm.WINDOWSTATE = 2
loForm.MyGrid.AUTOFIT()
loForm.SHOW(1)


DEFINE CLASS MyGridOrd AS GRID
  *-- Puntero actual al objeto Header
  HEADER = .F.
  HEADERHEIGHT = 25
  *-- Habilita el orden de las columnas
  Order_Enabled = .F.
  NAME = "MyGridOrd"
  PROCEDURE Order_Column
    LPARAMETERS toColumn, tcField
    LOCAL tcCaption, tlWordWrap
    DO CASE
      CASE PEMSTATUS(toColumn,"Header1",5)
        tcCaption = toColumn.Header1.CAPTION
        tlWordWrap = toColumn.Header1.WORDWRAP
        toColumn.REMOVEOBJECT('Header1')
      CASE PEMSTATUS(toColumn,"MyHeader",5)
        tcCaption = toColumn.MyHeader.CAPTION
        tlWordWrap = toColumn.MyHeader.WORDWRAP
        toColumn.REMOVEOBJECT('MyHeader')
    ENDCASE
    toColumn.ADDOBJECT('MyHeader', 'MyHeaderOrd', tcField)
    toColumn.MyHeader.CAPTION = tcCaption
    toColumn.MyHeader.WORDWRAP = tlWordWrap
  ENDPROC
  PROCEDURE Order_All
    LOCAL lo, lc
    FOR EACH lo IN THIS.COLUMNS
      *-- No ordena las columnas que tengan algun valor en la propiedad TAG
      IF EMPTY(lo.TAG)
        lc =  SUBSTR(lo.CONTROLSOURCE,AT(".", lo.CONTROLSOURCE) + 1)
        *-- Quita los caracteres especiales del ControlSource
        lc = CHRTRAN(lc, ["'+-/*().,;], [])
        THIS.Order_Column(lo, lc)
      ENDIF
    ENDFOR
  ENDPROC
  PROCEDURE INIT
    DODEFAULT()
    IF THIS.Order_Enabled
      THIS.Order_All()
    ENDIF
  ENDPROC
ENDDEFINE

*------------------------------------------------------
* Clase Column y Header para ordenar las columnas
* de una Grilla con un Click en el Header
*------------------------------------------------------
DEFINE CLASS MyColumnOrd AS COLUMN
  *-- Nada
ENDDEFINE

DEFINE CLASS MyHeaderOrd AS HEADER
  FONTSIZE = 8
  FONTBOLD = .T.
  ALIGNMENT = 2
  nNoReg = 0
  cField = ""
  nOrder = 0
  cFieldType = "U"
  lCyclic = .F. && El orden pasa de ASC > DESC > NO ORDEN > ASC > Etc...
  PROCEDURE INIT(tcField)
    LOCAL  ln1, ln2
    THIS.cField = UPPER(tcField)
    ln1 = AFIELDS(laFields, THIS.PARENT.PARENT.RECORDSOURCE)
    IF ln1 > 0
      ln2 = ASCAN(laFields, THIS.cField, -1, -1, 1, 11)
      IF ln2 > 0
        THIS.cFieldType = laFields(ln2, 2)
      ENDIF
    ENDIF
    IF NOT INLIST(THIS.cFieldType, "U", "G", "M", "W")
      THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      THIS.MOUSEPOINTER = 15 && Mano
    ENDIF
  ENDPROC
  PROCEDURE CLICK
    IF INLIST(THIS.cFieldType, "U", "G", "M", "W")
      *- No se puede ordenar estos tipos de campos
      RETURN
    ENDIF
    THIS.nNoReg = MIN(RECCOUNT(THIS.PARENT.PARENT.RECORDSOURCE), ;
      RECNO(THIS.PARENT.PARENT.RECORDSOURCE))
    IF VARTYPE(THIS.PARENT.PARENT.HEADER) == "O" AND !ISNULL(THIS.PARENT.PARENT.HEADER)
      THIS.PARENT.PARENT.HEADER.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      IF THIS.PARENT.PARENT.HEADER.cField <> THIS.cField
        THIS.PARENT.PARENT.HEADER.nOrder = 0
      ENDIF
    ENDIF
    DO CASE
      CASE THIS.nOrder = 0
        *-- Sin Orden, pasa a ASCending
        IF ATAGINFO(laTag,"",THIS.PARENT.PARENT.RECORDSOURCE) > 0 AND ASCAN(laTag,THIS.cField,-1,-1,1,1) > 0
          *-- Existe el TAG
        ELSE
          LOCAL lcSetSafety
          lcSetSafety = SET("Safety")
          SET SAFETY OFF
          SELECT (THIS.PARENT.PARENT.RECORDSOURCE)
          EXECSCRIPT( "INDEX ON " + THIS.cField + " TO " + THIS.cField + " ADDITIVE")
          SET SAFETY &lcSetSafety
        ENDIF
        EXECSCRIPT("SET ORDER TO " + THIS.cField + " IN " + THIS.PARENT.PARENT.RECORDSOURCE + " ASCENDING")
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\SORTASC.BMP", "BMP")
      CASE THIS.nOrder = 1
        *-- Orden ASC, pasa a DESCending
        IF ATAGINFO(laTag,"",THIS.PARENT.PARENT.RECORDSOURCE) > 0 AND ASCAN(laTag,THIS.cField,-1,-1,1,1) > 0
          *-- Existe el TAG
        ELSE
          LOCAL lcSetSafety
          lcSetSafety = SET("Safety")
          SET SAFETY OFF
          SELECT (THIS.PARENT.PARENT.RECORDSOURCE)
          EXECSCRIPT( "INDEX ON " + tcField + " TO " + THIS.cField + " ADDITIVE")
          SET SAFETY &lcSetSafety
        ENDIF
        EXECSCRIPT("SET ORDER TO " + THIS.cField + " IN " + THIS.PARENT.PARENT.RECORDSOURCE + " DESCENDING")
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\SORTDES.BMP", "BMP")
      CASE THIS.nOrder = 2 AND THIS.lCyclic
        *-- Orden DESC, pasa a Sin Orden
        EXECSCRIPT("SET ORDER TO 0 IN " + THIS.PARENT.PARENT.RECORDSOURCE)
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
    ENDCASE
    THIS.nOrder = MOD(THIS.nOrder + 1, IIF(THIS.lCyclic,3,2))
    THIS.PARENT.PARENT.REFRESH()
    IF THIS.nNoReg > 0
      GO (THIS.nNoReg) IN (THIS.PARENT.PARENT.RECORDSOURCE)
    ENDIF
  ENDPROC
  PROCEDURE RIGHTCLICK
    IF VARTYPE(THIS.PARENT.PARENT.HEADER) <> "O"
      *-- Sin orden
      RETURN
    ENDIF
    *-- Con RightClick (Clic Derecho) quito cualquier orden
    THIS.nNoReg = MIN(RECCOUNT(THIS.PARENT.PARENT.RECORDSOURCE), ;
      RECNO(THIS.PARENT.PARENT.RECORDSOURCE))
    EXECSCRIPT("SET ORDER TO 0 IN " + THIS.PARENT.PARENT.RECORDSOURCE)
    THIS.PARENT.PARENT.HEADER.nOrder = 0
    THIS.PARENT.PARENT.HEADER.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
    THIS.PARENT.PARENT.HEADER = THIS
    THIS.PARENT.PARENT.REFRESH()
    IF THIS.nNoReg > 0
      GO (THIS.nNoReg) IN (THIS.PARENT.PARENT.RECORDSOURCE)
    ENDIF
  ENDPROC
ENDDEFINE
*------------------------------------------------------

La clase MyGridOrd tiene la propiedad Order_Enabled que configurándola en .T. se ordenan todos los campos de la tabla, menos los tipos de campos que no se pueden ordenar (Memo, Blog y General) y tampoco las Columnas que tengan algún valor configurado en la propiedad Tag (Ej: .Column.Tag = "*")

La clase MyHeaderOrd tiene la propiedad lCyclic que configurándola con el valor .T. el orden recicla de ASCendente a DESCendente a SinOrden. En cualquier momento se puede seleccionar "SinOrden" con solo hacer clic derecho en el Heder de la columna.

Luis María Guayán