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)
