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)

---