9 de diciembre de 2015

Convertir imágenes a distintos tipos de archivo

Una función que permite convertir imágenes a distintos formatos y calidad utilizando WIA (Windows Image Acquisition Automation Layer).

En este ejemplo solo utiliza el filtro de Conversión (Formato y Calidad). Pueden ver mas ejemplos de los distintos usos de filtros en la siguiente página: How to Use Filters.

* Ejemplo:
lcFile = GETPICT()
lcFileJPG = ConvertImageType(lcFile, "JPG", 90)
lcFileBMP = ConvertImageType(lcFile, "BMP")
lcFileGIF = ConvertImageType(lcFile, "GIF")
lcFilePNG = ConvertImageType(lcFile, "PNG")
lcFileTIF = ConvertImageType(lcFile, "TIF")
FUNCTION ConvertImageType(tcFileName, tcImageType, tnQuality)
  IF EMPTY(tcFileName) OR ;
      VARTYPE(tcFileName) <> "C" OR ;
      NOT FILE(tcFileName)
    RETURN .F.
  ENDIF

  IF EMPTY(tcImageType) OR ;
      VARTYPE(tcImageType) <> "C"
    tcImageType = "JPG"
  ENDIF

  IF EMPTY(tnQuality) OR ;
      VARTYPE(tnQuality) <> "N" OR ;
      BETWEEN(tnQuality,0,100)
    tnQuality = 100
  ENDIF

  LOCAL loImgFile, loImgProcess
  loImgFile = CREATEOBJECT("WIA.ImageFile")
  loImgProcess = CREATEOBJECT("WIA.ImageProcess")

  * Cargo la imagen a convertir
  loImgFile.LoadFile(tcFilename)

  * Agrego filtros
  loImgProcess.Filters.ADD(loImgProcess.FilterInfos("Convert").FilterID)

  * Nuevo tipo de archivo
  LOCAL lcFormatId
  DO CASE
    CASE tcImageType = "JPG"
      lcFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "BMP"
      lcFormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "GIF"
      lcFormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "PNG"
      lcFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "TIF"
      lcFormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
    OTHERWISE
      tcImageType = "JPG"
      lcFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
  ENDCASE
  loImgProcess.Filters(1).Properties("FormatID").VALUE = lcFormatId

  * Calidad
  loImgProcess.Filters(1).Properties("Quality").VALUE = tnQuality && Calidad

  * Aplico filtros
  loImgFile  = loImgProcess.APPLY(loImgFile)

  LOCAL lcNewFileName
  lcNewFileName =   FORCEEXT(JUSTSTEM(tcFileName), tcImageType)

  * Que no exista el nombre de archivo
  LOCAL lnCount
  lnCount = 1
  DO WHILE FILE(lcNewFileName)
    lcNewFileName = FORCEEXT(JUSTSTEM(tcFileName) + TRANSFORM(lnCount), tcImageType)
    lnCount = lnCount + 1
  ENDDO

  * Guardo imagen procesada
  loImgFile.SaveFile(lcNewFileName)

  STORE NULL TO loImgFile, loImgProcess
  
  *Retorno el nuevo nombre de archivo convertido
  RETURN lcNewFileName
ENDFUNC

Luis María Guayán

Nota: Un reconocimiento al Blog de Jose Guillermo Ortiz Hernandez del cual tome información que me ayudo en la elaboración de esta función que cubre mis necesidades.

No hay comentarios. :

Publicar un comentario