21 de mayo de 2012

Colorear las filas de un Grid de acuerdo al valor de un campo

Un práctico ejemplo del turco Cetin Basoz de como colorear con un mismo color las filas de un control Grid de acuerdo al mismo valor de un campo.

En este caso las filas tomarán el mismo color para el mismo valor de identificación de empleado (campo Emp_Id)
loForm = CREATEOBJECT("MiForm")
loForm.SHOW(1)

DEFINE CLASS MiForm AS FORM
  DATASESSION = 2

  ADD OBJECT MiGrid AS GRID WITH ;
    RECORDSOURCE = "Orders",  HEIGHT = 400,  WIDTH = 400, ANCHOR = 15, ;
    READONLY = .T., FONTSIZE = 12, ROWHEIGHT = 24

  PROCEDURE LOAD
    USE (HOME(2) + "Data\Orders")
  ENDPROC

  PROCEDURE INIT
    THIS.MiGrid.SETALL("DynamicBackColor", "(ThisForm.ColorMe(Orders.Emp_Id, .F.))")
    THIS.MiGrid.SETALL("DynamicForeColor", "(ThisForm.ColorMe(Orders.Emp_Id, .T.))")
    THIS.WINDOWSTATE = 2
  ENDPROC

  PROCEDURE ColorMe(tcValue, tlForeColor)
    LOCAL lnBackColor, lnForeColor
    lnBackColor = BITAND(VAL(SYS(2007,m.tcValue,1,1)), 0x00FFFFFF)
    IF NOT m.tlForeColor
      RETURN m.lnBackColor
    ENDIF

    LOCAL lnRed, lnGreen, lnBlue,lnAlpha
    lnRed = BITAND(BITRSHIFT(m.lnBackColor,0), 0xFF)
    lnGreen = BITAND(BITRSHIFT(m.lnBackColor,8), 0xFF)
    lnBlue = BITAND(BITRSHIFT(m.lnBackColor,16), 0xFF)
    lnAlpha = (MAX(m.lnRed,m.lnGreen,m.lnBlue) + MIN(m.lnRed,m.lnGreen,m.lnBlue)) / 2

    RETURN IIF(m.lnAlpha < 0x80, 0xFFFFFF, 0)
  ENDPROC
ENDDEFINE

Fuente: Foxite Forum (http://www.foxite.com/forum)

14 de mayo de 2012

Consumir datos de VFP desde .NET de 64 bits utilizando un servidor vinculado

Un enlace a un reciente artículo del blog del profesor Carlos A. Perez que nos muestra como integrar datos de Visual Foxpro (32 bits) en un entorno de IIS de 64 bits a traves de un Servidor Vinculado SQL Server Express (64 bits).

Para leer el artículo "Cómo consumir datos de Visual FoxPro en sistemas .NET de 64 bits utilizando un servidor vinculado" de Carlos Perez haga clic aquí

 
Carlos A. Perez: Nacido en 1965 en Resistencia, Chaco, Argentina. Actualmente es profesor en la Universidad Tecnológica Nacional (Argentina) enseñando cinco materias, cuatro de Ingeniería en Sistemas y una en Ingeniería Electromecánica. Fundador del GIANTIC, grupo de investigación sobre nuevas tecnologías de comunicación. Ganador en 2002 de un Microsoft Research RFP para Argentina. Desde 2004 es Microsoft Most-Valuable Professional. Consultor e instructor de tecnologías .NET. Vocal de la Comisión Directiva del Microsoft Users Group de Argentina. Ex-Presidente del Polo Tecnológico Chaco. Titular de la consultora Logica10 I.A. especializada en desarrollos .NET y de movilidad. Actualmente cursando un doctorado en sistemas de información y computación con la Universidad de Málaga.


10 de mayo de 2012

Desplazarse por imagenes en un formulario

Un par de muy buenos ejemplos prácticos del turco Cetin Basoz de como se puede mostrar y desplazarse por imágenes en un formulario.

Estos dos ejemplos surgieron como respuesta de Cetin a una pregunta en el foro de Foxite.com y me parecieron muy buenos por su simpleza.

Ejemplo UNO

* Author: Cetin Basoz (Turkey)

SET SAFETY OFF
PUBLIC oForm
oForm = CREATEOBJECT("MyForm")
oForm.SHOW()

DEFINE CLASS myForm AS FORM
  HEIGHT = 600
  WIDTH = 800

  ADD OBJECT myGrid AS GRID WITH ;
    HEIGHT = 600, WIDTH = 800, ANCHOR = 15

  PROCEDURE LOAD
    CREATE CURSOR images (imageName c(100), img w)
    LOCAL ix, lcFile, lcDirImg
    
    lcDirImg = "C:\Archivos de programa\Microsoft Visual FoxPro 9\Samples\Data\Graphics"
    
    FOR ix = 1 TO ADIR(laImages, ADDBS(lcDirImg) + "*.*")
      lcFile = ADDBS(lcDirImg) + laImages[m.ix,1]
      INSERT INTO images VALUES (m.lcFile, FILETOSTR(m.lcFile))
    ENDFOR
    LOCATE
  ENDPROC

  PROCEDURE INIT
    THIS.myGrid.ROWHEIGHT = 64
    WITH THIS.myGrid.COLUMNS(2)
      .ADDOBJECT( "myImage", "imageControl" )
      .CURRENTCONTROL = "myImage"
      .SPARSE = .F.
      .myImage.STRETCH = 1
      .myImage.VISIBLE = .T.
      .WIDTH = 64
      .DYNAMICFONTBOLD = "(thisform.SetImage(this.columns(2).myImage, images.img))"
    ENDWITH
  ENDPROC

  PROCEDURE SetImage(toControl, tcBlob)
    toControl.PICTUREVAL = m.tcBlob
  ENDPROC

  PROCEDURE myGrid.BEFOREROWCOLCHANGE(tnIndex)
    THISFORM.LOCKSCREEN = .T.
  ENDPROC

  PROCEDURE myGrid.AFTERROWCOLCHANGE(tnIndex)
    THISFORM.LOCKSCREEN = .F.
  ENDPROC
ENDDEFINE

DEFINE CLASS imagecontrol AS IMAGE
  HEIGHT = 17
  WIDTH = 100
  NAME = "imagecontrol"

  PROCEDURE pictureval_assign
    LPARAMETERS vNewVal
    IF VAL(OS(3)) < 6
      THIS.PICTUREVAL = m.vNewVal
    ELSE
      THIS.PICTURE = ""
      IF EMPTY(THIS.TAG)
        THIS.TAG = FORCEPATH(SYS(2015) + ".pic", SYS(2023))
      ENDIF
      STRTOFILE(m.vNewVal, THIS.TAG)
      THIS.PICTURE = THIS.TAG
    ENDIF
  ENDPROC

  PROCEDURE DESTROY
    THIS.PICTURE = ""
    IF !EMPTY(THIS.TAG)
      TRY
        ERASE (THIS.TAG)
      ENDTRY
    ENDIF
  ENDPROC

ENDDEFINE

Ejemplo DOS

* Author: Cetin Basoz (Turkey)

PUBLIC oForm
oForm = CREATEOBJECT("form1")
oForm.SHOW()

DEFINE CLASS form1 AS FORM
  TOP = 0
  LEFT = 0
  HEIGHT = 480
  WIDTH = 750
  CAPTION = "HTML sample"

  * This is IE control - you'd use webbrowser4 from gallery instead
  * just because it already has some checks, extra pem. ie: wouldn't need readystate part
  * for the sake of keeping code short here I directly use olecontrol itself
  ADD OBJECT htmlviewer AS OLECONTROL WITH ;
    TOP = 0, LEFT = 0, HEIGHT = 400, WIDTH = 750, ;
    OLECLASS = "Shell.Explorer"

  ADD OBJECT text1 AS TEXTBOX WITH ;
    HEIGHT = 25, LEFT = 12, TOP = 432, WIDTH = 60, ;
    NAME = "Text1"

  ADD OBJECT text2 AS TEXTBOX WITH ;
    HEIGHT = 23, LEFT = 84, TOP = 432, WIDTH = 300, ;
    NAME = "Text2"

  ADD OBJECT text3 AS TEXTBOX WITH ;
    HEIGHT = 23, LEFT = 390, TOP = 432, WIDTH = 125, ;
    NAME = "Text3"

  ADD OBJECT text4 AS TEXTBOX WITH ;
    HEIGHT = 23, LEFT = 520, TOP = 432, WIDTH = 125, ;
    NAME = "Text4"

  PROCEDURE INIT
    LOCAL lnImages, lnPerrow, lnCurrent, lcDirImg

    lcDirImg = "C:\Archivos de programa\Microsoft Visual FoxPro 9\Samples\Data\Graphics"

    lnImages = ADIR(arrImages,ADDBS(lcDirImg) + "*.*")
    *You'd use a table let's simulate it
    CREATE CURSOR myImages (ImagePath m,FirstName c(12), LastName c(12))

    FOR ix=1 TO lnImages
      INSERT INTO myImages VALUES ;
        (ADDBS(lcDirImg) + arrImages[m.ix,1],"FirstName"+TRANS(ix),"LastName"+TRANS(m.ix))
    ENDFOR
    *Now we have a test table - create HTML
    lnPerRow = 2 && How many would we show on a line
    lnCurrent = 0 && Do not use recno() thinking it might be ordered on an index

    SET TEXTMERGE ON
    SET TEXTMERGE TO MEMVAR lcHtml NOSHOW
    * Initialize lcHTML
 \
    SELECT myImages
    SCAN
      lnCurrent = lnCurrent+1
      IF (lnCurrent-1)%lnPerRow=0
        IF lnCurrent > 1
 \
        ENDIF
 \
      ENDIF
 \<A href="<< trans(recno())>>_TEXT">
 \ << JustStem(ImagePath)>></A>
 \<A href="<< trans(recno())>>">
 \    <img border="0" height="60" width="80" src="<< trim(chrtran(ImagePath,'\','/'))>>"></A>

    ENDSCAN
 \
 \
    SET TEXTMERGE TO
    SET TEXTMERGE OFF
    *!*     Modify Command (this.HTMLFile) && If you ever wonder created HTML
    WITH THISFORM.htmlviewer
      .Navigate2('about:blank')
      DO WHILE .ReadyState # 4 && Wait for ready state
      ENDDO
      .DOCUMENT.WRITE( m.lcHTML )
    ENDWITH
  ENDPROC

  PROCEDURE htmlviewer.BeforeNavigate2
    *** ActiveX Control Event ***
    LPARAMETERS pdisp, url, FLAGS, targetframename, postdata, headers, CANCEL
    CANCEL = .T.  && do not navigate to anywhere
    WITH THISFORM && with webbrowser4 also this.oHost is the form itself or container
      LOCAL lcRecNo
      lcRecNo = STRTRAN(LOWER(m.url), "about:","")
      .text1.VALUE = m.lcRecNo
      lnRecno = STREXTRACT(m.lcRecNo, "", "_TEXT", 1, 1+2)
      GO VAL(m.lcRecNo) IN "myImages"
      IF (ATC("_TEXT", m.lcRecNo) > 0)
        .text2.VALUE = "TextCLICK" + myImages.ImagePath
      ELSE
        .text2.VALUE = myImages.ImagePath
      ENDIF
      .text3.VALUE = myImages.FirstName
      .text4.VALUE = myImages.LastName
    ENDWITH
  ENDPROC

ENDDEFINE

Fuente: Foxite Forum (http://www.foxite.com/forum)