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.
Buenos días,
ResponderBorrarEstoy intentando implementar una función para convertir el formato de imágenes pero me da el siguiente error en una maquinas virtual con Win XP SP3. 1 Gb de RAM
También probé en otras maquinas con Win XP y me muestra el mismo mensaje.
Error: 1733 Mensaje: No se encuentra la definición de clase WIA.IMAGEFILE.
Error: 1733 Mensaje: No se encuentra la definición de clase WIA.IMAGEPROCESS.
las líneas de código que hacen mención del error son:
loImgFile = CREATEOBJECT("WIA.ImageFile")
loImgProcess = CREATEOBJECT("WIA.ImageProcess")
En mi maquina Win 8.1 no tengo ningún problema y se ejecuta correctamente.
Si alguien me puede ayudar voy a estar muy agradecido.
Un pequeño error en esta línea
ResponderBorrarIF EMPTY(tnQuality) OR ;
VARTYPE(tnQuality) <> "N" OR ;
BETWEEN(tnQuality,0,100)
tnQuality = 100
ENDIF
Deberia de Ser
IF EMPTY(tnQuality) OR ;
VARTYPE(tnQuality) <> "N" OR ;
!BETWEEN(tnQuality,0,100)
tnQuality = 100
ENDIF
Todavía un pequeño error en vez de usar OR es Usar AND ya que si mandan un dato numérico pasa. Ya que primero esta el comando empty y no vartype. Ejemplo si mandan numero 10. De tipo numérico pasa no evalua lo demás.
ResponderBorrar