Redimensionar imagenes

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