*!* Se necesita agregar al formulario
*!* Una propiedad llamada "MyFolder"
*!* Uso opcional, si es necesario buscar
*!* manualmente las carpetas
*!*
*!* Un Método llamado "pickFolder"
*!* Un Método llamado "InsertImage"
*!* <Form.Init>
*!* Esto se puede agregar en el cuadro de propiedades
*!*
*!* ADDPROPERTY(thisform,"MyFolder",FULLPATH(""))*!* </Form.Init>
*!* --------------------------------------------------------------------------
*<Inicia_el_procedimiento>
* Esta llamada se colocará en el punto donde se conozca la carpeta de imágenes.
LOCAL lcFolder
lcFolder="c:\temp\flia002"
thisform.pickfolder(lcFolder)
*</Inicia_el_procedimiento>
*!* <Metodo = "pickFolder" />
LPARAMETERS tcFolder
* tcFolder es una carpeta que contiene imágenes
LOCAL lcFolder,lnFiles,i,;
loResp as Object
* Control de parámetro
* Si no se pasó o es inválido, intenta la búsqueda por
* explorer.
lcFolder=IIF(VARTYPE(tcFolder)="C",tcFolder,"")
IF EMPTY(lcFolder) OR !DIRECTORY(lcFolder)
lcInFolder=EVL(this.myfolder,FULLPATH("")) lcFolder = GETDIR(lcInFolder,"Seleccione Carpeta","Imágenes Familia",48)
ENDIF
IF EMPTY(lcFolder)
RETURN
ENDIF
this.myfolder=lcFolder
*<LimpiaImagesAnteriores>
IF PEMSTATUS(this,"cntImage",5)
this.removeObject("CntImage")ENDIF
*</LimpiaImagesAnteriores>
* Lectura de archivos de la carpeta lcFolder
* En este caso supongo que las imágenes son bmp.
lnFiles=ADIR(gaFiles,ADDBS(lcFolder)+"*.bmp")
IF lnFiles=0
MESSAGEBOX("No hay imágenes en "+lcFolder,0,"Mensaje") RETURN
ENDIF
this.NewObject("cntImage","Container")WITH this.cntImage
.top=200
.left=20
.Width=this.Width- .left * 2
.Height=this.Height - .top - 20
.BackStyle=1
.BackColor=RGB(255,255,255)
.BorderColor= RGB(114,136,141)
ENDWITH
FOR i=1 TO lnfiles
loResp=this.insertimage(ADDBS(lcFolder)+gaFiles[i,1] , this.cntImage)
NEXT
WITH this.cntImage
IF !ISNULL(loResp)
.Height=loResp.Height
.Width=loREsp.Width
ENDIF
.visible=.t.
ENDWITH
*!* </Metodo>
*!* <Metodo = "InsertImage" />
LPARAMETERS tcFileImage , toCont
IF VARTYPE(toCont)#"O"
toCont=thisform
ENDIF
LOCAL lcNewImage,lnOrd , lnWidth ,lntop ,lnMax,;
lnLeft,lnTopeWidth,lnMaxRight,;
loIma as Object , loReturn as Object
loReturn=NEWOBJECT("Empty")lntopeWidth=toCont.Width- 10
lcNewImage="AddImage1"
lnOrd=0
lnMaxRight=0
lntop=1
lnLeft=1
lnWidth=lnLeft
lnMax=0
*<Control_Nombre_posición>
FOR EACH ocontrol IN toCont.Controls
IF oControl.baseclass="Image" AND LEft(oControl.name,LEN("AddImage"))=="AddImage" lcName=oControl.name
lnOrd=VAL(CHRTRAN(lcName,CHRTRAN(lcName,"1234567890",""),""))+1
lcNewImage="AddImage"+TRANSFORM(lnOrd)
lnWidth= lnWidth + oControl.Width
lnMaxRight = MAX(lnMaxRight , lnWidth )
lnMax=MAX(lnMax,oControl.Height)
IF lnWidth > lnTopeWidth
lnTop=lnTop+lnMax
lnWidth=lnLeft
lnMax=0
ENDIF
ENDIF
NEXT
*</Control_Nombre_posición>
toCont.NewObject(lcNewImage,"Image")
IF PEMSTATUS(toCont,lcNewImage,5)
loIma=toCont.&lcNewImage
WITH loIma
.picture=tcFileImage
.Stretch=2
IF lnWidth + .Width > lnTopeWidth
.left = lnLeft
.top = lnTop + lnMax
ELSE
.Left = lnWidth
.top = lntop
ENDIF
.visible=.t.
ENDWITH
ENDIF
IF toCont.baseclass="Container"
ADDPROPERTY(loReturn,"Height",loIma.top + loIma.Height + 1)
ADDPROPERTY(loREturn,"Width", MAX(lnMaxRight , loIma.left + loIma.width + 1))
ENDIF
RETURN IIF(toCont.BaseClass="Container",loREturn,null)
*!* </Metodo>
