He estado trabajando en un proyecto en el cual debía almacenar una imagen para emitir un certificado, para lo cual utilice un campo blob, pero algunas de las imágenes llegaban a mediar más de 1Mb y con las limitantes de VFP en cuanto al almacenamiento de datos decidí redimensionar las imágenes según el tamaño al que serán impresas.
Y gracias a PortalFox y sus colaboradores he aquí mi variante para este caso.
Caso de Uso
--Metodo Click() del boton cmdExplorar--
LOCAL lcPict
lcPict = GETPICT('bmp;gif;jpg;tif;png')
IF !EMPTY(lcPict)
lcFile = FileToStr(ResizePicture(lcPict,320,240,100))
REPLACE Certificado.foto WITH lcFile
ENDIF
La funcion requiere de 4 parametros: tcFile -> Archivo de imagen tcWitdth -> Nuevo ancho de imagen tcHeigth -> Nuevo alto de imagen tcQuality -> Calidad para el redimencionamiento (0 - 100)
FUNCTION ResizePicture(tcFile as String, tcWidth as Integer, tcHeight as Integer, tcQuality as Integer)
SET CLASSLIB TO HOME() + "/FFC/_GdiPlus.vcx"
SET COMPATIBLE ON
LOCAL loGraphics as gpGraphics OF HOME() + "/FFC/_GdiPlus.vcx"
LOCAL loImage as gpImage OF HOME() + "/FFC/_GdiPlus.vcx"
LOCAL loBmpOut as gpBitmap OF HOME() + "/FFC/_GdiPlus.vcx"
LOCAL lcNewPic as String
LOCAL lcExt as Character
IF !DIRECTORY(ADDBS(SYS(5) + SYS(2003)) + "Imagenes\temp\",1)
MKDIR (ADDBS(SYS(5) + SYS(2003)) + "Imagenes\temp\")
ENDIF
lcExt = LOWER(JUSTEXT(tcFile))
lcNewPic = ADDBS(SYS(5) + SYS(2003)) + "Imagenes\temp\" + LOWER(JUSTSTEM(tcFile)) + CHR(46) + lcExt
loGraphics = CREATEOBJECT("gpGraphics")
loImage = CREATEOBJECT("gpImage",m.tcFile)
loBmpOut = CREATEOBJECT("gpBitmap",m.tcWidth,m.tcHeight)
loImage.CreateFromFile(m.tcFile)
loGraphics.CreateFromImage(loBmpOut)
loGraphics.DrawImageScaled(loImage,0,0,loBmpOut.ImageWidth,loBmpOut.ImageHeight)
DO CASE
CASE lcExt = "bmp"
loBmpOut.SaveToFile(lcNewPic,"image/bmp","quality=" + ALLT(STR(m.tcQuality)))
CASE (lcExt = "jpg") OR (lcExt = "jpeg")
loBmpOut.SaveToFile(lcNewPic,"image/jpeg","quality=" + ALLT(STR(m.tcQuality)))
CASE lcExt = "gif"
loBmpOut.SaveToFile(lcNewPic,"image/gif","quality=" + ALLT(STR(m.tcQuality)))
CASE (lcExt = "tif") OR (lcExt = "tiff")
loBmpOut.SaveToFile(lcNewPic,"image/tiff","quality=" + ALLT(STR(m.tcQuality)))
CASE lcExt = "png"
loBmpOut.SaveToFile(lcNewPic,"image/png","quality=" + ALLT(STR(m.tcQuality)))
ENDCASE
RETURN lcNewPic
ENDFUNC
Saludos
Hector Urrutia
El Salvador